rpact/0000755000175000017500000000000014165541122011516 5ustar nileshnileshrpact/MD50000644000175000017500000006071314165541122012035 0ustar nileshnilesh996d40c4054302fc1f5e6cbcefb2db4d *DESCRIPTION 44650be5c4c986c77d591285eda71cea *NAMESPACE 745aa6ed44c1b8b1dcd656c6a4897a49 *NEWS.md ae861b4257a225651117d06533462044 *R/RcppExports.R a082f60e2c2119c0714d81fcee35de53 *R/class_analysis_dataset.R ad388ec0861df11efe1b5b3a05a24114 *R/class_analysis_results.R f4d11c1bda7691224b3fa5143e0571c5 *R/class_analysis_stage_results.R 7544b43179c2ca7f53db215628fcfc7f *R/class_core_parameter_set.R b74a7901a75d3b177dcdc98cb3489c3f *R/class_core_plot_settings.R cd03f72abc9fbda0134854cf77f75083 *R/class_design.R fa388809f92bcdc8076f78faa15dd0e4 *R/class_design_plan.R 359e9c6893de60c52ddbd9d4141eca4f *R/class_design_power_and_asn.R 69c75b3b81f8f8db3fb289c951f68126 *R/class_design_set.R 80bfa8bfcfe29a2f0cf38b79de635750 *R/class_event_probabilities.R 9ce951a8b25be919bc40c3eab8f6eea4 *R/class_simulation_results.R 9696a261050cbb797ca0907f13948ee3 *R/class_summary.R f514752e55bfa5ce6cfdc3814f3c952f *R/class_time.R e2760e415107677949ead94766e905b3 *R/data.R eb31df7f36675e1a60f95c752fde7b82 *R/f_analysis_base.R 02d13b2b620d7a0e11eca639523065aa *R/f_analysis_base_means.R 9ac95108e6a5f2edb71d1fc7d24a5e20 *R/f_analysis_base_rates.R 361676730e4cc9987c48616fb2961055 *R/f_analysis_base_survival.R 0e754b93b676f1d36ac8b02524d18d44 *R/f_analysis_enrichment.R c209d163cc69bdb3511261758b1028fc *R/f_analysis_enrichment_means.R a98e59e81c838bb06576381876bb2e92 *R/f_analysis_enrichment_rates.R b282a1c937edbfe84d314877e0bf0e38 *R/f_analysis_enrichment_survival.R bc71c4f8121db6c9f581ffe0aad9cb05 *R/f_analysis_multiarm.R 4b13b79fe049e905b4be83a8197e434d *R/f_analysis_multiarm_means.R 9f34904b2462dcd3e34e51f8d260cba1 *R/f_analysis_multiarm_rates.R 8d35c7494f967661b1f00c48eb8824a9 *R/f_analysis_multiarm_survival.R f78ba195ded0d097399bce24474df2ec *R/f_analysis_utilities.R 413dfd2f698ce9f0b66d9004584efc49 *R/f_core_assertions.R f18f230536ca8f80aa6f0a355666b75c *R/f_core_constants.R ce8e705566f119e475c93ff75ca9cdaf *R/f_core_output_formats.R 5904db5ec4ed576f7f08f4e70f69c1ba *R/f_core_plot.R fb2b94d9abbb8c67ff3aef86e64d462c *R/f_core_utilities.R 07a2868b48832672752eabf06f96cc5d *R/f_design_fisher_combination_test.R 9ac1dcae77080edc78b091c2801d9d12 *R/f_design_group_sequential.R fe2a53d90739435ebac792ad0397fe92 *R/f_design_sample_size_calculator.R 90748a1d03dcbd07d61d91edfb8948dd *R/f_design_utilities.R e459078545952bc983d7703e7d446a7b *R/f_parameter_set_utilities.R 1f4cc50d79300eeb8bab3fb04d8cdadc *R/f_simulation_base_means.R 80f62588f492571028492abda08cfc1b *R/f_simulation_base_rates.R 597a34030d05836c2f7fcbe238a37e79 *R/f_simulation_base_survival.R fbe53603252b83d1a4a027f3ec8e3a53 *R/f_simulation_enrichment.R 4db213fe30bfc85cddd358b5eed8b45f *R/f_simulation_enrichment_means.R e39d178c36b0ba0fad650cbb76156162 *R/f_simulation_enrichment_rates.R 6fa183749cfa05e953ab9976def47511 *R/f_simulation_enrichment_survival.R d4f2504772f7a49f2fa8e426734c6676 *R/f_simulation_multiarm.R 3ee8c67c4d085181541cbeeb6a2dfa18 *R/f_simulation_multiarm_means.R 66f7f1a347b3d152b0dd12b10aa216f4 *R/f_simulation_multiarm_rates.R 261bbef3bace514a718565bada77ad5e *R/f_simulation_multiarm_survival.R e87d52ede205b6e9ad6a55088ca5b4bf *R/f_simulation_utilities.R f7e96e947aafed2e9043714880384358 *R/parameter_descriptions.R 1fda2fbc23938237e82b0e03564c3570 *R/pkgname.R 695e2af311d31a55024a194d19c397e9 *README.md 56c26b375133775e334dd8041bd509c8 *build/partial.rdb ac000c33c2497dcc18e539e504c16b03 *build/vignette.rds 775c8a76d2bdc08f54c3f80cce1f2ed8 *data/dataEnrichmentMeans.RData f80881ceeba40367dcb7ae2ddf7dd047 *data/dataEnrichmentMeansStratified.RData 795004f12c81f02c14989aaa46f0eb9b *data/dataEnrichmentRates.RData a3dc5b392ff079c541f30d6dbc9b8f5e *data/dataEnrichmentRatesStratified.RData 2fad62a6f40cafd5d0eb27870b225bc6 *data/dataEnrichmentSurvival.RData 11a255ffc77c497ebd857a85b8a680a3 *data/dataEnrichmentSurvivalStratified.RData da840207d7269aa16818daf63cfcac56 *data/dataMeans.RData ce5a271516c45fec0b69c8c1ac6d3816 *data/dataMultiArmMeans.RData 5e35f8ec524c1b303dd28ab1112aaf0b *data/dataMultiArmRates.RData e0a88c959a011e46ddc6cb844b92afa9 *data/dataMultiArmSurvival.RData 226331927b315a4e7a127681f74a5290 *data/dataRates.RData 74d21c69ba96201bb1f90182b999c0ab *data/dataSurvival.RData 3fdf35331c87cddde527e749d45be4e7 *data/rawDataTwoArmNormal.RData ea8eab93de05207476b4c5f91642b478 *inst/doc/rpact_getting_started.R ef6e5c8077fb5a807aa45eef313eec61 *inst/doc/rpact_getting_started.Rmd 9ec5227d3b5e9a6ff004470b7ced8004 *inst/doc/rpact_getting_started.html 5a13510f7c31005bd79fa81d18398eb3 *inst/extdata/dataset_means_multi-arm.csv 122a37915d9b2e43c0211fb1c54b9f8a *inst/extdata/dataset_rates.csv af1d8773b64fbf36102bbe6b3ad0a3a5 *inst/extdata/dataset_rates_multi-arm.csv b9e82327e5d3d37b8341576d453e2f5a *inst/extdata/dataset_survival_multi-arm.csv 84fb9399bd4da792bb7757c0f23e9ec7 *inst/extdata/datasets_rates.csv d2ea13b6edd5fe8985bbd0c2171be172 *inst/tests/testthat.R 7a74d08496bafe90ec5707ec91b3cbda *inst/tests/testthat/test-rpact.R 955f39b847dba501eaa1f1351be297e3 *man/AccrualTime.Rd acd0ffcc62b8ab9bcda550a694f982ac *man/AnalysisResults.Rd d6bc7bdc40c9531825c8df781ed66406 *man/AnalysisResultsConditionalDunnett.Rd fec8405e8b2057c40a1616e6f0420e91 *man/AnalysisResultsEnrichment.Rd eee165d4fa2feeaccca49df259fc958a *man/AnalysisResultsEnrichmentInverseNormal.Rd eccc24251e7de2cfd78655d86cd1e7a5 *man/AnalysisResultsFisher.Rd 7a84ae38d43bf862a044cfc48b5e6ac8 *man/AnalysisResultsGroupSequential.Rd 45cf7ef56a53a67c7094244e69102ab2 *man/AnalysisResultsInverseNormal.Rd e41581fea84686a8938262a33a5c681e *man/AnalysisResultsMultiArm.Rd bd801c4d64bd2afc3f0db30cd61069cc *man/AnalysisResultsMultiArmFisher.Rd c3f6339a8909e31b95c00b9c5af66022 *man/AnalysisResultsMultiArmInverseNormal.Rd 9f8a9f670b0fec15c2f51d79e5cfd3d3 *man/AnalysisResultsMultiHypotheses.Rd 68337e00477e42d20aeb260aa128e3fb *man/AnalysisResults_as.data.frame.Rd 40f769d19f780d0a0ade0f06ea845a0c *man/AnalysisResults_names.Rd b8822aa15e99474380ac1de9ce29d03e *man/AnalysisResults_summary.Rd adaf16c7387c8d0efe7d1685deebe33c *man/ClosedCombinationTestResults.Rd 860da3691b745cdece43eec06e1dd73a *man/ConditionalPowerResults.Rd 82492fe9084a26be9a55ebaa71e6525e *man/Dataset.Rd 5b48f46e13d0866ef3f4cf060fb7c1e9 *man/DatasetMeans.Rd 105ad3575d22f657130c33f6f8618ed4 *man/DatasetRates.Rd 4f96ac05c3b0e57e69b0e8850e39b5b4 *man/DatasetSurvival.Rd f559754eac49af06355e34c157daabc4 *man/Dataset_print.Rd 8dc5e3b81fd32e8225c96666e226b170 *man/Dataset_summary.Rd 380be060e977e84c567893abb327951b *man/EventProbabilities.Rd 0e7d382fe366efadbf0330c5de6fb077 *man/FieldSet.Rd a73651e58dc8d0efaed3efcf2aaab4b1 *man/FieldSet_names.Rd 9569a674e94529b7c1faf005485930d7 *man/FieldSet_print.Rd fbf7b20a525964328fa3f21160465c18 *man/FrameSet_as.matrix.Rd 212861d9d45804a290e5e88c32ba849f *man/NumberOfSubjects.Rd 76cd72190ec138b77183f2350163a0b3 *man/ParameterSet.Rd 602c4833f3383b98cc315140dd3cf843 *man/ParameterSet_as.data.frame.Rd 73ed775fef2766736753310ee8280b76 *man/ParameterSet_print.Rd e1dae60324c801996741c15b92d5547a *man/ParameterSet_summary.Rd 530e604b71282d8dd244b0799c768f03 *man/PiecewiseSurvivalTime.Rd 88d38ec4639172382077fe9e39ef97c1 *man/PlotSettings.Rd 27135c635a626a2605c4fa4d0db61038 *man/PowerAndAverageSampleNumberResult.Rd e32ec01eb1efeb1ea567a4b5327f9354 *man/PowerAndAverageSampleNumberResult_as.data.frame.Rd ec0528dbae64c2f0cb6ec0e6c3b26ab4 *man/SimulationResults.Rd fab830fe65eb07ab5bea606a36ef6ac5 *man/SimulationResultsEnrichmentMeans.Rd d7e4d987b43c933de377cb6aa1fa0fd0 *man/SimulationResultsEnrichmentRates.Rd b7787ebcf0429c7ae06bc6c23b8be74c *man/SimulationResultsEnrichmentSurvival.Rd 996cfa4c156928a460dae2049bfb5b3c *man/SimulationResultsMeans.Rd 5dd953413949d8be80020e5cd9cc762c *man/SimulationResultsMultiArmMeans.Rd 4e9c6be1095f1ab3f995d1758f85168c *man/SimulationResultsMultiArmRates.Rd 37776cc76ec5042d1a9c89fa1cab0958 *man/SimulationResultsMultiArmSurvival.Rd 023062c3ebe4c76c33a484977da70bb7 *man/SimulationResultsRates.Rd 3f6eddfb9a79ba9b10aade17155f167b *man/SimulationResultsSurvival.Rd e2dfc2a14d37d9704f815e3b472f8ab1 *man/SimulationResults_names.Rd bb938087c85290bc45251227425de2d1 *man/SimulationResults_print.Rd 4254fa55a185a6ffe85c595e9aa5c8fa *man/StageResults.Rd 1f4b0b413d3432487e5b6b3f2fdce7a3 *man/StageResultsMeans.Rd 9413dba68d6c19cee2f474b83f1bfb35 *man/StageResultsRates.Rd d47320b3c37fc949deba50c95dd178e8 *man/StageResultsSurvival.Rd fceca4625bf2c1571f6b7828aee180a3 *man/StageResults_as.data.frame.Rd 32e7b0cb4d699a38c767f67d67d1609e *man/StageResults_names.Rd 37060ef3405dd944da1c6b1ae9b7b40b *man/SummaryFactory.Rd f0ecba8eb7294dc8b2f001fa4eaf2ec1 *man/TrialDesign.Rd 81755f7c9aa5b37a3571e5a257fe02b4 *man/TrialDesignCharacteristics.Rd d38b0f62e9d04668ec585a5c1c9ca37c *man/TrialDesignCharacteristics_as.data.frame.Rd 8970527c681939fe7d5c29e2244ef644 *man/TrialDesignConditionalDunnett.Rd 29c7640ff81565df694b84b07e99e932 *man/TrialDesignFisher.Rd 6bb146b2651f61b25dfd058935c7123d *man/TrialDesignGroupSequential.Rd 4839c20c1d24146b1844704a5260e487 *man/TrialDesignInverseNormal.Rd 4b33b6a4cc242c88a33a66b769f3bfdb *man/TrialDesignPlan.Rd 53a9ea70e467ef04752fa5c90392f84c *man/TrialDesignPlanMeans.Rd 0e067aa36dcac448e98da30e279139bf *man/TrialDesignPlanRates.Rd b9deb15a97577abaf641c218901ea153 *man/TrialDesignPlanSurvival.Rd b4cdbd29fd88e082440be9ff434c5bf5 *man/TrialDesignPlan_as.data.frame.Rd 797d7edfc85fc76444851784782108b1 *man/TrialDesignSet.Rd 65eef89ed85ef6a64c86d0031e70399b *man/TrialDesignSet_as.data.frame.Rd f05e5f6202abe71e20936d1960ba4417 *man/TrialDesignSet_length.Rd 6c412a9349028276bd0f927539e6c95d *man/TrialDesignSet_names.Rd 1e4f6b03ff979e0c9780f1e5bf7f9ea6 *man/TrialDesign_as.data.frame.Rd 143c9097c728864acd5a2c62104c0f87 *man/Trial_Design_Set_summary.Rd 62df86b888faa7479f01c6e11700017f *man/dataEnrichmentMeans.Rd d1f74b785330560cafd25c5a9ab91e21 *man/dataEnrichmentMeansStratified.Rd ceb408474e657dc082ed87b3f9952c1c *man/dataEnrichmentRates.Rd ab6b2db76a1156a4ce521f30f910ccf1 *man/dataEnrichmentRatesStratified.Rd 3e69a7de0f220db93b185eae162dce08 *man/dataEnrichmentSurvival.Rd 589da08d5f534f25044df38614b1b64b *man/dataEnrichmentSurvivalStratified.Rd a5133a54c9289b26c3f61aed74071d51 *man/dataMeans.Rd 3fdf7c08200d2971ec4880675f09c550 *man/dataMultiArmMeans.Rd 79461a771afc7e2b9194f588776252e4 *man/dataMultiArmRates.Rd 7970347e67ca6fa78b4b36a5180f4f76 *man/dataMultiArmSurvival.Rd 18efeb7fc61ce715d2e0e46322e9efeb *man/dataRates.Rd 52029f469b9f4db4791f85a22af15f38 *man/dataSurvival.Rd 813cffe7d771337a1c44d26d9f5725dc *man/getAccrualTime.Rd 036481bfb7b9ac99af58f7ee7bb9310c *man/getAnalysisResults.Rd d7e902bbd6c19f80f29c0521c3d83f62 *man/getAvailablePlotTypes.Rd 7f0bc0ce670823a9a267a89faab13302 *man/getClosedCombinationTestResults.Rd f3ea7b5ee61dbcb3489549e2b527c580 *man/getClosedConditionalDunnettTestResults.Rd 7b70b3d86aa581b2b493e5e877bbc8e3 *man/getConditionalPower.Rd e97a5c3b2d6cba8e72b7a66c20bc9d2f *man/getConditionalRejectionProbabilities.Rd e4279a5acfc3cb0c34135a83701c69d4 *man/getData.Rd 664ad5759bf79b7b8548150b15d5b387 *man/getDataset.Rd bec99e22b9cccdc7ef3d1ae15a50d50c *man/getDesignCharacteristics.Rd eeac804233bee583b4320bd0feca80c2 *man/getDesignConditionalDunnett.Rd 5c5c0655a76a93e499afe3c07e509df0 *man/getDesignFisher.Rd 68e50296f2f2c42154a6bbb83445ce01 *man/getDesignGroupSequential.Rd d57809cc0ed44eaa79b632c9b03acef4 *man/getDesignInverseNormal.Rd fd6c51f35795464f64d4b7b2334e0552 *man/getDesignSet.Rd fd80465e0923bd64e2357700f890df3e *man/getEventProbabilities.Rd 5e33e0a76a68959dd6a676c7b1aec21d *man/getFinalConfidenceInterval.Rd 29d66ad6fc68389066b3c38e55b0d431 *man/getFinalPValue.Rd 8f49fa9dd4f40d763ed759e0aeb08787 *man/getLambdaStepFunction.Rd d9f1394e76af2926c9e716fcd76b7fef *man/getLogLevel.Rd 9a1e192355fe3ca84114617003ed209d *man/getLongFormat.Rd 8cfb852e2ddf8bd7a21cbb2c26f46be3 *man/getNumberOfSubjects.Rd 088ebc17ae0ce08cd39f55e689208bcc *man/getObjectRCode.Rd 7988871120c8a4d7fe65890118af94da *man/getObservedInformationRates.Rd 51775e6a2db056012416f39343fb3ee1 *man/getOutputFormat.Rd 77b6eaa026bbfd491db60d19b354dd99 *man/getParameterCaption.Rd 426bbf67d42e0cf8524608feed0c657a *man/getParameterName.Rd 70dd36aebf73e66dea18bf7ea5f6b2ef *man/getPiecewiseSurvivalTime.Rd 3e58940c91208a14c44b0ad399d40e07 *man/getPlotSettings.Rd 8113deeb2190a48452184ceff05a2c5f *man/getPowerAndAverageSampleNumber.Rd fbcf202f8b97bdeb99e2384bae9c599d *man/getPowerMeans.Rd b79ca89f9422d194981177d3eba0e6c7 *man/getPowerRates.Rd da1c852331db1449f73426deaf3144c8 *man/getPowerSurvival.Rd 73a54f401a3ff72bf6462cbd07cc8ba4 *man/getRawData.Rd 5dc3683bac0e62e9309680d0249a0e3e *man/getRepeatedConfidenceIntervals.Rd b8720d5e87c70a60ac14e587a0411a7e *man/getRepeatedPValues.Rd dde500e85bb394cc677ea4194d945c4c *man/getSampleSizeMeans.Rd dd53f8e34866cd8676bde61d6eeefee7 *man/getSampleSizeRates.Rd 6a18fed6eafc2ae92b8c8a1c5258a4b5 *man/getSampleSizeSurvival.Rd e3da19f45c6f74616f04472341afa15d *man/getSimulationEnrichmentMeans.Rd 08c0f1018482665e5bab39c22c9c096d *man/getSimulationEnrichmentRates.Rd c78da8c75573cfbdf91fbd63a3a22d73 *man/getSimulationEnrichmentSurvival.Rd 27ab160c9f62a93dc8e805b9495613ac *man/getSimulationMeans.Rd 058f12a5cc5a225cfdfbbf9d8a0f746f *man/getSimulationMultiArmMeans.Rd c12828c35c6382e9b12b33993886264f *man/getSimulationMultiArmRates.Rd 7df10a4c3348557854254da8e9159250 *man/getSimulationMultiArmSurvival.Rd 62ab08aebdb041003f639192560f2d1c *man/getSimulationRates.Rd 0e93e215da616a49b3eeb5cbdba45598 *man/getSimulationSurvival.Rd e0a599a9e110a47de086945f6ae4a3fc *man/getStageResults.Rd 4d26975b26ca8bf4baf8bca26c7e9ac4 *man/getTestActions.Rd 6cd3e3c0be1fb7726ed3486dcd5e1ae0 *man/getWideFormat.Rd d6f2d0fd07d1708e4f8b41579589ac8e *man/kable.ParameterSet.Rd 6c739f907ea2c06340f431ab9df37986 *man/kable.Rd d29bad019de924729c0c6ccebd5fdfcc *man/param_accrualIntensity.Rd bd5cca8ce10525d7a2fb0d9c370efe4c *man/param_accrualIntensityType.Rd 2bc6c91c65251a525504baa78c102806 *man/param_accrualTime.Rd c460295095732d20f3962e72df4b6c4a *man/param_activeArms.Rd 0887aff33175ff6c8c93a2e4c3d8683f *man/param_adaptations.Rd c1284855193ee3926c9bb1f1eba13798 *man/param_allocationRatioPlanned.Rd 0980a16599bc549dd74a4296262032ab *man/param_allocationRatioPlanned_sampleSize.Rd f34eb05683e0c7669b0a81f4d37a467d *man/param_alpha.Rd d2791fd72d80bd449c0ac15771c7b145 *man/param_alternative.Rd 9a2c0b73d5b31c56b39b26daa7b2edb5 *man/param_alternative_simulation.Rd 9ddc9a9a4d8f9ee452643b8cd2268f31 *man/param_beta.Rd addf4452f1b54d6c6347c19390d2da6e *man/param_bindingFutility.Rd d40436590626836268b654c7304dbbac *man/param_calcEventsFunction.Rd 8ff544a318eec7d19b6e6868bc46ceb7 *man/param_calcSubjectsFunction.Rd 8a937447f90d7ad123a41abaf00f928f *man/param_conditionalPower.Rd 33776e8d101b78d8ff8ee409b704a4c0 *man/param_conditionalPowerSimulation.Rd 519f0b586ba9f91a33d6f72f5ede4f6a *man/param_dataInput.Rd aff0e361ce130658bb3d1cfab5f01269 *man/param_design.Rd 949e02efab9f853143ee2346dccc3fdd *man/param_design_with_default.Rd 8b4c367a07696a17f90aa1ecaf8ed368 *man/param_digits.Rd abed3c3d955e328576a1edb04861136c *man/param_directionUpper.Rd 1998f8e96e3e794b8dcb0ff8670e4960 *man/param_dropoutRate1.Rd 872d754626b1957695602c9b9cfee69b *man/param_dropoutRate2.Rd 65d6a5381e8e4b896ae2d38732cb3bee *man/param_dropoutTime.Rd f7918ca6881b438ce46621c847257863 *man/param_effectList.Rd fd5cf7fb8b42ad0671121807725fbd4d *man/param_effectMatrix.Rd 5f7a9797006980cc6df90f18ad42fa62 *man/param_effectMeasure.Rd ae08451aa26a25ab53e63fbe77ec68f3 *man/param_epsilonValue.Rd 256091f212b435e016060db29f75b161 *man/param_eventTime.Rd 706eb4abadf975e327b3d48454d37af5 *man/param_gED50.Rd 985f796ceec0a5516bc3965ff69934eb *man/param_grid.Rd a76a45988a339c142b44d77ead737a91 *man/param_groups.Rd f310a40094f0a2b15afb593f6a624c45 *man/param_hazardRatio.Rd 600624477c436d7cbedf864bb7d7b0dc *man/param_includeAllParameters.Rd 037ea34c1510f73f192b0334d0916f1c *man/param_informationEpsilon.Rd 1f5d943881a59a430ca3930c80305aee *man/param_informationRates.Rd 8de161216654ee722875cb96510a2892 *man/param_intersectionTest_Enrichment.Rd 2d521ffd6c619dab0009318b207e3d17 *man/param_intersectionTest_MultiArm.Rd b01c368fc87cda7a37be25b022e5f71d *man/param_kMax.Rd 07a3f74e3eb2784def5209b8ae40a4de *man/param_kappa.Rd 6a5d1e49a2776d3e43dd642cbc173f54 *man/param_lambda1.Rd ca615f0a922d3be8f1020f45d0012608 *man/param_lambda2.Rd 068c6c8acfde7746a4c832f079614de5 *man/param_legendPosition.Rd d3cd3b0facf2bf0322eac00ee7c30837 *man/param_maxInformation.Rd 14a8ed19886a240273faa6d96c42dd05 *man/param_maxNumberOfEventsPerStage.Rd c41a9d50534f8792f3213dcb9b081215 *man/param_maxNumberOfIterations.Rd 66c96ac2c9d48c7698034798ec59f1cc *man/param_maxNumberOfSubjects.Rd ed1ee5502aa4bdb9ee93e51e23b0744a *man/param_maxNumberOfSubjectsPerStage.Rd 2ab661109c73464bb2d965e3d1be57ef *man/param_maxNumberOfSubjects_survival.Rd 048e2dd6495b98f9536a6d8267018c51 *man/param_median1.Rd 1781f09fad83fc0b5b98cfb63804c0ec *man/param_median2.Rd 8b7258978d3a689b45cd04ed3cdcc5f8 *man/param_minNumberOfEventsPerStage.Rd 0dd43ed51fa979a0f1fef12792c66c6e *man/param_minNumberOfSubjectsPerStage.Rd 53dac4768d241ee5feb1d98352136196 *man/param_nMax.Rd 1d4ed6655fb26c6847253ac15b4ba238 *man/param_nPlanned.Rd 636aab28cf86ef1675f1a430a31817ab *man/param_niceColumnNamesEnabled.Rd f0777c0744bb55fdc1b0582ad0dd6c02 *man/param_normalApproximation.Rd a26e2726a4a8b4f665d7bcbd75000f40 *man/param_palette.Rd fcfa4bd4f885e127a85eb53527357813 *man/param_pi1_rates.Rd fb7fe732fb2103c99c872acfb1df9e24 *man/param_pi1_survival.Rd 98db94073c7904f3af59a52671b37f5c *man/param_pi2_rates.Rd 80ee370eda9051ba80f6af1c89cb6db6 *man/param_pi2_survival.Rd 74af83d40f70675293cf9b4912ffc65f *man/param_piecewiseSurvivalTime.Rd 4502eec3a93e47168928cba446bc0028 *man/param_plannedEvents.Rd 47cb477eea357686d01108090cbb8000 *man/param_plannedSubjects.Rd 3a294d87dedb5ffb4da063c4c8bdae13 *man/param_plotPointsEnabled.Rd f09b67c6835f9993b0ac9144e313cf02 *man/param_plotSettings.Rd ff6d729004d9928988a2829dd0f22698 *man/param_populations.Rd 1cb408cd5c8bdddcdfe74b9cc3c3d712 *man/param_rValue.Rd f53f00dd03f01245cb33d5ac44ec6208 *man/param_seed.Rd d42668b703a20ed5aee995b8179aa454 *man/param_selectArmsFunction.Rd 1149ac27644d7f1939a7ad654c486b03 *man/param_selectPopulationsFunction.Rd 0a6005e58429942f6270b77659db40bd *man/param_showSource.Rd c4ef3703a348ec675b47f8d1372833f7 *man/param_showStatistics.Rd 43d2ee9598580144538116ea07bdf697 *man/param_sided.Rd 51b777fc044628f34943a8ef37678948 *man/param_slope.Rd a185884fd6b87908d9812be4c7196502 *man/param_stDev.Rd 9db5959d8ef55e68daeaf78cb0987ed4 *man/param_stDevH1.Rd 83b11c73cd674c93952a5a791631f258 *man/param_stDevSimulation.Rd 7e03013b17ab5ce9f442971b9040d565 *man/param_stage.Rd 7cc14c00bd6411eb41ae3ee507ce3fc0 *man/param_stageResults.Rd 624afa326891c4413eb241924d955504 *man/param_stratifiedAnalysis.Rd ddcc932e72105bfeb842561100f66367 *man/param_successCriterion.Rd dd4caafcb25884be5c2121f6b674bc41 *man/param_theta.Rd ea787f1d51512959419b96e444c9a75e *man/param_thetaH0.Rd 643eecd37be09a1ff0912c8624d97fa3 *man/param_thetaH1.Rd b358eb4dc5e486dca9a552d985730590 *man/param_three_dots.Rd aada540fffb7372054058aaaa2e042e7 *man/param_three_dots_plot.Rd 8911f6917db77827111d55642e9373d1 *man/param_threshold.Rd a3de4ac32d0dfb7c933f3b36c5ba62e5 *man/param_tolerance.Rd 3c756608b9cfebc14fa8fac404509ffd *man/param_typeOfComputation.Rd 0d0dbeb855ee51d125b06b7cd8ce7f73 *man/param_typeOfDesign.Rd 9f7e715767e40790478849af9472c5f3 *man/param_typeOfSelection.Rd c5319b4c87c47eb0455cfbe8742d4b09 *man/param_typeOfShape.Rd cce6f731eccef1c9527d2b94732e748b *man/param_userAlphaSpending.Rd 42eb264e4cf8a1fc7dfb4ac19c009402 *man/param_varianceOption.Rd fc399a9ce5b6ce7f12dfb1ac578f6e08 *man/plot.AnalysisResults.Rd c19b066f1792a868e8442f4a6bfa8caa *man/plot.Dataset.Rd e8205b145777b0610a2fce515ef31465 *man/plot.EventProbabilities.Rd 5c4e75c851a1219c993536b065e431f9 *man/plot.NumberOfSubjects.Rd 06b00a78db7dbe8034b605d254ab1c74 *man/plot.ParameterSet.Rd 8c61221ce1ef92397d9f39f8f23e52ec *man/plot.SimulationResults.Rd 449f538683033a93815b4213ab5d5ef0 *man/plot.StageResults.Rd 81f822fae762351298f56eed3b081e18 *man/plot.SummaryFactory.Rd 2ebd4ebe02244b63aa03547805c368a8 *man/plot.TrialDesign.Rd 44ee8c3f95001be2ad557ba00a4ebb6f *man/plot.TrialDesignPlan.Rd fa2a0e1e4f1b5a539c7e86c965fc1cde *man/plot.TrialDesignSet.Rd ab2af7bf82d2c8b911a40de24aa3b81e *man/printCitation.Rd 40da53fcf1c4f92d8052a30f6105a624 *man/rawDataTwoArmNormal.Rd 723fd29b3f71d0f4512d59f3f29d02d1 *man/readDataset.Rd ed586eade36a2b1224f079fc27f989cb *man/readDatasets.Rd cb6daa988bdfc5a6088b4c4d65ee5b78 *man/resetLogLevel.Rd 4be3b2a3063fc18f625796b931de094d *man/roxygen/meta.R d3eb0fa6d883ddb8be570150eac5965b *man/rpact.Rd 42ba5e10268ee9b15ba8e5f20d398b11 *man/setLogLevel.Rd f81861ddb401e2a2e47f38077e5f2d62 *man/setOutputFormat.Rd 0d1bc3d5c966ae19ab21249828465491 *man/sub-TrialDesignSet-method.Rd 29c9e9e51ba7e8690102792d2b96ae88 *man/t-FieldSet-method.Rd 8757bf89f698b788a887ec8a84a484cb *man/testPackage.Rd c973244ccbfd8f1ae9fb243a7a8a7f03 *man/utilitiesForPiecewiseExponentialDistribution.Rd ccbb713150f82885307b500a4f3ee84a *man/utilitiesForSurvivalTrials.Rd f616a76a45fca27f8bcbaccd6ca2c390 *man/writeDataset.Rd 0f329272821781fa3cd90b36c5096121 *man/writeDatasets.Rd 1b24709ced1a7210994872999e5efb43 *src/RcppExports.cpp 7ded2e77ef6790cc0463f146974c6998 *src/f_design_group_sequential_probabilities.cpp fefe0261c7f66c4637ef9c7f74f9bfb4 *src/f_simulation_base_survival.cpp f8e7249f8d35fe496d2b7363022b3ed8 *src/f_simulation_enrichment_survival.cpp 6a30fe3ed38cbbc21ec72dc42bdd5c35 *src/f_simulation_survival_utilities.cpp 253cc909964709211dbd176598bcac76 *src/f_simulation_survival_utilities.h 9b188d5b0b543b58a243f74210b2d919 *src/f_utilities.cpp 4c6b8e587851ac88edc5b2fb2855f7ed *src/f_utilities.h d2ea13b6edd5fe8985bbd0c2171be172 *tests/testthat.R 755050ea3f3fac1d414b99dfe0e64f60 *tests/testthat/helper-class_analysis_dataset.R 38084f8705ac72c47dce533869891e19 *tests/testthat/helper-f_analysis_base_means.R d1136eb3b2368de535d4bd4472435653 *tests/testthat/helper-f_analysis_base_rates.R d1136eb3b2368de535d4bd4472435653 *tests/testthat/helper-f_analysis_base_survival.R e6534b972a4bb21058e8868111f55bfb *tests/testthat/helper-f_core_assertions.R 9361dcfb9cb54e6b90099021a688c468 *tests/testthat/helper-f_core_utilities.R 7627b1df05641907f7214ac98b8fb606 *tests/testthat/test-class_analysis_dataset.R dac126711a7bfaf5a2c5f56625fc2f54 *tests/testthat/test-class_summary.R 9a9fc4082fc207728ab16e744d4e1301 *tests/testthat/test-class_time.R aa78db2120fcd43f0d09ed4c33ef684c *tests/testthat/test-f_analysis_base_means.R 52a3d97e82b9d4e25be8727de56a366a *tests/testthat/test-f_analysis_base_rates.R f8f5a2f594c6dd1579c68a8aa8886b9b *tests/testthat/test-f_analysis_base_survival.R 643a007cf89860302aa0330d2195328e *tests/testthat/test-f_analysis_enrichment_means.R 2eea6f1e5c14ee7f7661250fe2ee4f31 *tests/testthat/test-f_analysis_enrichment_rates.R 2ac0a3ed21480de7ecc097d122a02ba2 *tests/testthat/test-f_analysis_enrichment_survival.R 99a0b3985026a2608a3a1a19c60774b9 *tests/testthat/test-f_analysis_input_validation.R 01d99367f1af4c8976812453be9727a8 *tests/testthat/test-f_analysis_multiarm_means.R f61a562b8589a6a83d225d6731b0e678 *tests/testthat/test-f_analysis_multiarm_rates.R 98cde1d066add904bb2ae08a4be20b17 *tests/testthat/test-f_analysis_multiarm_survival.R 5de4df30c046eff308e39a2e8dd27b4e *tests/testthat/test-f_core_assertions.R 54d8434f4ff4619c513437c8dee53d53 *tests/testthat/test-f_core_output_formats.R be944d9a6f1e5517baa29b5168c6a3a9 *tests/testthat/test-f_core_plot.R a3d72e8b4e752547d06441662e3eec66 *tests/testthat/test-f_core_utilities.R 6f5f437aac468631230a971240fc808b *tests/testthat/test-f_design_fisher_combination_test.R 9c4580362f53f4d3bd588a0cb3e1987d *tests/testthat/test-f_design_group_sequential.R 9e5c56b1fa8ec502170467fdbcf98c6e *tests/testthat/test-f_design_power_calculator.R 33ca77b9b2f7dfba14c1bd9f7e50ec52 *tests/testthat/test-f_design_sample_size_calculator.R 22a89f984f5da23237ca79377818aa4a *tests/testthat/test-f_design_utilities.R 979968514ddd5e5d7933d52caca218c8 *tests/testthat/test-f_parameter_set_utilities.R 4db5f0467342b974144cb23de68c764a *tests/testthat/test-f_simulation_base_means.R 8e2df73b8de5a54a4ab92bb01a3c51f4 *tests/testthat/test-f_simulation_base_rates.R 4a55f8eb058920827f731bb0e9a41685 *tests/testthat/test-f_simulation_base_survival.R edcd2b5bbaa25a2ca0796233164fb8fb *tests/testthat/test-f_simulation_enrichment_means.R c4293a9a7d0495b7f68c062280ec3213 *tests/testthat/test-f_simulation_enrichment_rates.R f2abd17d7fbdce6b6ba822b9988e16a0 *tests/testthat/test-f_simulation_enrichment_survival.R 5a5be8fc8e9c7b9ea84ea28df7c97ba7 *tests/testthat/test-f_simulation_multiarm_means.R 13fe0c86e266fbfea5711b07cadfb65b *tests/testthat/test-f_simulation_multiarm_rates.R cb44b7607896c6a797555c62456bdd51 *tests/testthat/test-f_simulation_multiarm_survival.R c3a2e5e2fca98053d476639082db1e90 *tests/testthat/test-generic_functions.R ef6e5c8077fb5a807aa45eef313eec61 *vignettes/rpact_getting_started.Rmd rpact/NEWS.md0000644000175000017500000004245014165527667012643 0ustar nileshnilesh# rpact 3.2.1 * C++ warning "using integer absolute value function 'abs' when argument is of floating point type" under r-devel-linux-x86_64-debian-clang removed * getDataset: support of emmeans result objects as input improved * getAnalysisResults: issue with zero values in the argument 'userAlphaSpending' fixed * Minor improvements # rpact 3.2.0 ## New features * Simulation tools for enrichment design testing means, rates, and hazard ratios: function getSimulationEnrichmentMeans(), getSimulationEnrichmentRates(), getSimulationEnrichmentSimulation() available for simulation of enrichment designs; note that this is a novel implementation, hence experimental * getDesignGroupSequential() / getDesignInverseNormal(): new typeOfDesign = "noEarlyEfficacy" added ## Improvements, issues, and changes * getSimulationSurvival(): bug fixed for accruallIntensity = 0 at some accrual intervals * For observed conditional power, standardized theta not truncated to 0 any more in getSimulationMultiArmMeans(), getSimulationMultiArmRates(), and getSimulationMultiArmSurvival() * Conditional power calculation for analysis rates takes into account differently the null value of condErrorRate * Function testPackage(): a problem with downloading full set of unit tests under Debian/Linux has been fixed * Generic function kable() improved: optional knitr::kable arguments enabled, e.g., format * In print and summary output, "overall" renamed to "cumulative" if means, stDevs, or rate are calculated over stages rather than stage-wise * getDataset: support of emmeans result objects as input improved * Numerical accuracy of qnorm() calculations improved * Analysis enrichment results now support the generic function as.data.frame() * Naming of the stage results parameters in the print output improved * New example data added: "rawDataTwoArmNormal" * Issue in summary fixed: earlyStop and rejectPerStage were no longer displayed * Minor improvements # rpact 3.1.1 * Performance of two-sided Pampallona & Tsiatis design improved * 12 example datasets added * Sample sizes in plots now have the same format as in print output; format can be changed using setOutputFormat() * getDataset supports emmeans result objects as input * Print output of simulation results improved * Added dependency on R >= 3.5.0 because serialized objects in serialize/load version 3 cannot be read in older versions of R * Plot label interface for configuration via the rpact Shiny app implemented * Minor improvements # rpact 3.1.0 ## New features * Analysis tools for enrichment design testing means, rates, and hazard ratios: function getAnalysisResults() generalized for enrichment designs; function getDataset() generalized for entering stratified data; manual extended for enrichment designs * Automatic boundary recalculations during the trial for analysis with alpha spending approach, including under- and over-running: setup via the optional parameters 'maxInformation' and 'informationEpsilon' in function getAnalysisResults() * The new function getObjectRCode (short: rcmd) returns the original R command which produced any rpact result object, including all dependencies * getWideFormat() and getLongFormat() return a dataset object in wide format (unstacked) or long format (narrow, stacked) * Generic function kable() returns the output of an rpact result object formatted in Markdown. * Generic function t() returns the transpose of an rpact result object ## Improvements, issues, and changes * New argument 'plotSettings' added to all plot functions * Summary for design, simulation, and analysis unified and extended * Issue in getDesignFisher fixed: getDesignFisher(method = "noInteraction", kMax = 3) and getDesignFisher(method = "noInteraction") produced different results * 'normalApproximation' default value changed to TRUE for multi-arm analysis of rates * Repeated p-values: in search algorithm, upper bound of significance level corrected when considering binding futility bounds * testPackage: the default call is now running only a small subset of all available unit tests; with the new argument 'connection' the owners of the rpact validation documentation can enter a 'token' and a 'secret' to get full access to all unit tests * Scaling of grid plots improved * Minor improvements # rpact 3.0.4 * Beta-spending function approach with binding futility bounds * Pampallona & Tsiatis design with binding and non-binding futility bounds * Argument 'accrualIntensityType' added to getSampleSizeSurvival, getSimulationSurvival, getNumberOfSubjects, and getEventProbabilities * Specification of Weibull survival times possible through definition of hazard rates or medians in simulation tool * Minor improvements # rpact 3.0.3 * New utility functions getParameterCaption() and getParameterName() implemented * Design parameters added to simulation print output * Generic function as.matrix improved for several result objects * Issue in getAvailablePlotTypes for sample size and power results fixed * Issue for getDesignFisher(kMax = 1) in getSimulationMultiArm...() fixed * getSimulationMultiArmSurvival: correlation of log-rank statistics revised and improved * getSimulationMultiArmMeans: name of the first effectMeasure option "effectDifference" changed to "effectEstimate" * getSimulation[MultiArm][Means/Rates/Survival]: argument 'showStatistics' now works correctly and is consistently FALSE by default for multi-arm and non-multi-arm * getSimulation[MultiArm]Survival: generic function summary() improved * getAnalysisResults: generic function summary() improved * getAccrualTime: improved and new argument 'accrualIntensityType' added * Header text added to design summaries * getSampleSizeSurvival: field 'studyDurationH1' in result object was replaced by 'studyDuration', i.e., 'studyDurationH1' is deprecated and will be removed in future versions * Minor changes in the inline help and manual * Minor improvements # rpact 3.0.2 * getSimulationMultiArmSurvival: plannedEvents redefined as overall events over treatment arms * getStageResults: element overallPooledStDevs added; print output improved * Unit tests improved: test coverage and references to the functional specification optimized * plot type 13 of getSampleSizeSurvival with user defined lambdas with different lengths: issue fixed * Minor improvements # rpact 3.0.1 * Vignette "rpact: Getting Started" included into the package * New summary output option "rpact.summary.width" added * Generic function summary() improved for several result objects * Result output of function testPackage() improved * getSimulationMultiArm[Means/Rates/Survival]: stage index corrected for user defined calcSubjectsFunction or calcEventsFunction * getSimulationMultiArmRates: adjustment for identical simulated rates to account for ties * getSimulationMultiArmSurvival: corrected correlation of test statistics * Output formatting improved * Minor improvements # rpact 3.0.0 ## New features * Simulation tools for multi-arm design testing means, rates, and hazard ratios * Analysis tools for multi-arm design testing means, rates, and hazard ratios * getSimulationRates: exact versions for testing a rate (one-sample case) and equality of rates (two-sample case) * getDataset: multi-arm datasets for means, rates, and survival data * Analysis of fixed designs * Summary for analysis and simulation result objects newly implemented * Summary for most rpact result objects substantially improved and enhanced * getEventProbabilities: plot of result object * getNumberOfSubjects: plot of result object * Visual comparison of two designs: plot(design1, design2) * Functions setOutputFormat and getOutputFormat implemented: definition of user defined output formats * getSimulationMeans: thetaH1 and stDevH1 can be specified for assessment of sample size recalculation (replaces thetaStandardized) * getSimulationSurvival: separate p-values added to the aggregated simulation data for Fisher designs * getSimulationMeans, getSimulationRates: Cumulated number of subjects integrated in getData object * getSimulation[MultiArm][Means/Rates/Survival]: new logical argument 'showStatistics' added * Example datasets (csv files) added to the package * plot type "all": plot all available plots of an object in one step using plot(x, type = "all") * plot type improved: 'type' now can be a vector, e.g., plot(x, type = c(1, 3)) * plot(x, grid = 1): new plot argument 'grid' enables the plotting of 2 or more plots in one graphic ## Improvements, issues, and changes * getAnalysisResults: list output implemented analogous to the output of all other rpact objects * getAnalysisResults: the following stage result arguments were removed from result object because they were redundant: effectSizes, testStatistics, and pValues. Please use the '.stageResults' object to access them, e.g., results\$.stageResults\$effectSizes * getAnalysisResults: the following design arguments were removed from result object because they were redundant: stages, informationRates, criticalValues, futilityBounds, alphaSpent, and stageLevels. Please use the '.design' object to access them, e.g., results\$.design\$informationRates * Optional argument 'stage' removed from functions getConditionalPower, getConditionalRejectionProbabilities, getFinalPValue, getRepeatedPValues, and getTestActions * Function testPackage improved, e.g., results will be displayed now on screen * Help system renewed and approved, e.g., help for corresponding generic functions (e.g., plot) linked where applicable * Function getPiecewiseSurvivalTime improved: pi1 and pi2 will not be calculated any longer for lambda- or median-based definitions; eventTime only required for pi-based definitions * plot(x, showSource = TRUE) improved for all rpact result objects x * Performance of plotting analysis results of Fisher designs improved * getSimulationRates: issue for futility stopping for Fisher's combination test fixed * getSimulationSurvival: issue for expected number of events fixed * getSimulationSurvival: if eventsNotAchieved > 0, rejection/futility rate and analysis time is estimated for valid simulation runs * getSimulationSurvival: output improved for lambda1/median1/hazardRatio with length > 1 * getSampleSizeSurvival: calculation of the maximum number of subjects given the provided argument 'followUpTime' improved * getPiecewiseSurvivalTime: delayed response via list-based piecewiseSurvivalTime definition enabled * getAccrualTime/getSimulationSurvival: issue with the calculation of absolute accrual intensity by given relative accrual intensity fixed * getRawData: issue for multiple pi1 solved * Implementation of the generic function 'names' improved * Test coverage improved: lots of new unit tests added * License information in the DESCRIPTION file corrected: changed from GPL-3 to LGPL-3 * Minor improvements # rpact 2.0.6 * Boundaries on effect scale for testing means now accounts for the unknown variance case * getAnalysisSurvival: calculation of stage wise results not more in getStageResults * getStageResults: the calculation of 'effectSizes' for survival data and thetaH0 != 1 was corrected * getDataset of survival data: issue with the internal storage of log ranks fixed * Sample size plot: issue for kMax = 1 fixed * getSampleSizeSurvival with piecewise survival time: issue with calculation of 'maxNumberOfSubjects' for given 'followUpTime' fixed * Internal Shiny app interface improved * Minor improvements # rpact 2.0.5 * Assumed median survival time: get[SampleSize/Power/Simulation]Survival now support direct input of arguments 'median1' and 'median2' * Output of generic function 'summary' improved * Plot type 5 of getPower[...] and getSimulation[...] objects improved * Output of getSampleSizeSurvival with given maxNumberOfSubjects improved * Output of get[SampleSize/Power]Survival for Kappa != 1 improved * Assert function for minNumberOfSubjectsPerStage corrected for undefined conditionalPower * Two-sided boundaries on effect scale in survival design improved * Error in 'summary' for getDesign[...] fixed * Other minor improvements # rpact 2.0.4 * Incorrect output of function 'summary' fixed for getSampleSize[...] and getPower[...] * as.data.frame: default value of argument 'niceColumnNamesEnabled' changed from TRUE to FALSE # rpact 2.0.3 ## New features * Plot function for Fisher design implemented * Generic function 'summary' implemented for getDesign[...], getSampleSize[...], getPower[...], and getSimulation[...] results: a simple boundary summary will be displayed ## Improvements, issues, and changes * Generic function as.data.frame improved for getDesign[...], getSampleSize[...], getPower[...], and getSimulation[...] results * Ouput of getStageResults() improved * Improvements for Shiny app compatibility and better Shiny app performance * Repeated p-values are no longer calculated for typeOfDesign = "WToptimum" * Piecewise survival time improved for numeric definition: median and pi will not be calculated and displayed any longer * Plot: legend title and tick mark positioning improved; optional arguments xlim and ylim implemented * Sample size/power: usage of argument 'twoSidedPower' optimized * Performance of function rpwexp/getPiecewiseExponentialRandomNumbers improved (special thanks to Marcel Wolbers for his example code) * For group sequential designs a warning will be displayed if information rates from design not according to data information * Format for output of standard deviation optimized # rpact 2.0.2 * Minor corrections in the inline help * Labeling of lower and upper critical values (effect scale) reverted * Simulation for Fisher's combination test corrected * Parameter minNumberOfAdditionalEventsPerStage renamed to minNumberOfEventsPerStage * Parameter maxNumberOfAdditionalEventsPerStage renamed to maxNumberOfEventsPerStage * Parameter minNumberOfAdditionalSubjectsPerStage renamed to minNumberOfSubjectsPerStage * Parameter maxNumberOfAdditionalSubjectsPerStage renamed to maxNumberOfSubjectsPerStage * Output of function getAccrualTime() improved * Validation of arguments maxNumberOfIterations, allocation1, and allocation2 added: check for positive integer * Function getSampleSizeSurvival improved: numeric search for accrualTime if followUpTime is given * Default value improved for analysis tools: if no effect was specified for conditional power calculation, the observed effect is selected * Fixed: function getDataset produced an error if only one log-rank value and one event was defined * Number of subjects per treatment arm are provided in output of simulation survival if allocation ratio != 1 * Function getSimulationSurvival improved: first value of minNumberOfEventsPerStage and maxNumberOfEventsPerStage must be NA or equal to first value of plannedSubjects # rpact 2.0.1 * Function base::isFALSE replaced to guarantee R 3.4.x compatibility * C++ compiler warning on r-devel-linux-x86_64-debian-clang system removed * C++ compiler error on r-patched-solaris-x86 system fixed # rpact 2.0.0 ## New features * Power calculation at given or adapted sample size for means, rates and survival data * Sample size and power calculation for survival trials with piecewise accrual time and intensity * Sample size and power calculation for survival trials with exponential survival time, piecewise exponential survival time and survival times that follow a Weibull distribution * Simulation tool for survival trials; our simulator is very fast because it was implemented with C++. Adaptive event number recalculations based on conditional power can be assessed * Simulation tool for designs with continuous and binary endpoints. Adaptive sample size recalculations based on conditional power can be assessed * Comprehensive and unified tool for performing sample size calculation for fixed sample size design * Enhanced plot functionalities ## Improvements, issues, and changes * Fisher design, analysis of means or rates, conditional rejection probabilities (CRP): calculation issue fixed for stage > 2 * Call of getSampleSize[Means/Rates/Survival] without design argument implemented * For all 'set.seed' calls 'kind' and 'normal.kind' were specified as follows: kind = "Mersenne-Twister", normal.kind = "Inversion" * Minor code optimizations, e.g. 'return()' replaced by 'return(invisible())' if reasonable * Bug in 'readDatasets' fixed: variable names 'group' and 'groups' are now accepted * "Overall reject per stage" and "Overall futility per stage" renamed to "Overall reject" and "Overall futility", respectively (also variable names) * Labels "events.." and "..patients.." consistently changed to "# events.." and "# patients...", respectively * Output format for 'allocationRatioPlanned' specified * Method 'show' of class 'ParameterSet' expanded: R Markdown output features implemented * getSampleSizeSurvival(): argument 'maxNumberOfPatients' was renamed in 'maxNumberOfSubjects' * Result output, inline help and documentation: the word 'patient' was replaced by 'subject' * Variables 'numberOfSubjectsGroup1' and 'numberOfSubjectsGroup2' were renamed to 'numberOfSubjects1' and 'numberOfSubjects1' * Final p-values for two-sided test (group sequential, inverse normal, and Fisher combination test) available * Upper and lower boundaries on effect scale for testing rates in two samples # rpact 1.0.0 * First release of rpact rpact/DESCRIPTION0000644000175000017500000000572314165541122013233 0ustar nileshnileshPackage: rpact Title: Confirmatory Adaptive Clinical Trial Design and Analysis Version: 3.2.1 Date: 2022-01-06 Authors@R: c( person( given = "Gernot", family = "Wassmer", email = "gernot.wassmer@rpact.com", role = c("aut")), person( given = "Friedrich", family = "Pahlke", email = "friedrich.pahlke@rpact.com", role = c("aut", "cre")) ) Description: Design and analysis of confirmatory adaptive clinical trials with continuous, binary, and survival endpoints according to the methods described in the monograph by Wassmer and Brannath (2016) . This includes classical group sequential as well as multi-stage adaptive hypotheses tests that are based on the combination testing principle. License: LGPL-3 Encoding: UTF-8 LazyData: true URL: https://www.rpact.org BugReports: https://www.rpact.com/bugreport Language: en-US Depends: R (>= 3.5.0) Imports: methods, stats, utils, graphics, tools, Rcpp (>= 1.0.0) LinkingTo: Rcpp Suggests: parallel, ggplot2 (>= 2.2.0), testthat (>= 2.0.0), mnormt (>= 1.5-7), knitr (>= 1.19), rmarkdown (>= 1.10) VignetteBuilder: knitr, rmarkdown RoxygenNote: 7.1.2 Collate: 'RcppExports.R' 'f_core_assertions.R' 'f_core_constants.R' 'f_core_utilities.R' 'f_analysis_utilities.R' 'f_parameter_set_utilities.R' 'class_core_parameter_set.R' 'class_core_plot_settings.R' 'f_analysis_base.R' 'class_analysis_dataset.R' 'f_core_plot.R' 'class_design.R' 'class_analysis_stage_results.R' 'class_analysis_results.R' 'class_time.R' 'class_design_set.R' 'f_design_utilities.R' 'class_design_plan.R' 'class_design_power_and_asn.R' 'class_event_probabilities.R' 'f_simulation_utilities.R' 'f_simulation_base_survival.R' 'class_simulation_results.R' 'class_summary.R' 'data.R' 'f_analysis_base_means.R' 'f_analysis_base_rates.R' 'f_analysis_base_survival.R' 'f_analysis_enrichment.R' 'f_analysis_enrichment_means.R' 'f_analysis_enrichment_rates.R' 'f_analysis_enrichment_survival.R' 'f_analysis_multiarm.R' 'f_analysis_multiarm_means.R' 'f_analysis_multiarm_rates.R' 'f_analysis_multiarm_survival.R' 'f_core_output_formats.R' 'f_design_fisher_combination_test.R' 'f_design_group_sequential.R' 'f_design_sample_size_calculator.R' 'f_simulation_base_means.R' 'f_simulation_base_rates.R' 'f_simulation_enrichment.R' 'f_simulation_enrichment_means.R' 'f_simulation_enrichment_rates.R' 'f_simulation_enrichment_survival.R' 'f_simulation_multiarm.R' 'f_simulation_multiarm_means.R' 'f_simulation_multiarm_rates.R' 'f_simulation_multiarm_survival.R' 'parameter_descriptions.R' 'pkgname.R' NeedsCompilation: yes Packaged: 2022-01-06 09:54:07 UTC; fried Author: Gernot Wassmer [aut], Friedrich Pahlke [aut, cre] Maintainer: Friedrich Pahlke Repository: CRAN Date/Publication: 2022-01-06 10:20:02 UTC rpact/README.md0000644000175000017500000000660414165525167013016 0ustar nileshnilesh# rpact Confirmatory Adaptive Clinical Trial Design, Simulation, and Analysis. ## Functional Range - Sample size and power calculation for - means (continuous endpoint) - rates (binary endpoint) - survival trials with - piecewise accrual time and intensity - piecewise exponential survival time - survival times that follow a Weibull distribution - Fixed sample design and designs with interim analysis stages - Simulation tool for means, rates, and survival data - Assessment of adaptive sample size/event number recalculations based on conditional power - Assessment of treatment selection strategies in multi-arm trials - Adaptive analysis of means, rates, and survival data - Adaptive designs and analysis for multi-arm trials - Adaptive analysis and simulation tools for enrichment design testing means, rates, and hazard ratios - Automatic boundary recalculations during the trial for analysis with alpha spending approach, including under- and over-running ## Installation Install the latest CRAN release via ``` r install.packages("rpact") ``` ## Documentation The documentation is hosted at ## Vignettes The vignettes are hosted at ## The rpact user group The *rpact project* has an active user group consisting of decision-makers and users from the pharmaceutical industry and CROs, who meet regularly and, e.g., discuss best practices. We invite you to be part of the *rpact user group*: benefit from know-how, shape open source development in Pharma\! ## Use on corporate computer systems Please [contact](https://www.rpact.com/contact) us to learn how to use `rpact` on FDA/GxP-compliant validated corporate computer systems and how to get a copy of the formal validation documentation that is customized and licensed for exclusive use by your company, e.g., to fulfill regulatory requirements. The validation documentation contains the personal access data for performing the installation qualification with `testPackage()`. > [www.rpact.com/contact](https://www.rpact.com/contact) # About - **rpact** is a comprehensive validated\[1\] R package for clinical research which - enables the design and analysis of confirmatory adaptive group sequential designs - is a powerful sample size calculator - is a free of charge open-source software licensed under [LGPL-3](https://cran.r-project.org/web/licenses/LGPL-3) - particularly, implements the methods described in the recent monograph by [Wassmer and Brannath (2016)](https://doi.org/10.1007%2F978-3-319-32562-0) > For more information please visit > [www.rpact.org](https://www.rpact.org) - **RPACT** is a company which offers - enterprise software development services - technical support for the `rpact` package - consultancy and user training for clinical research using R - validated software solutions and R package development for clinical research > For more information please visit > [www.rpact.com](https://www.rpact.com) 1. The rpact validation documentation is available exclusively for our customers and supporting members. For more information visit [www.rpact.com/services/sla](https://www.rpact.com/services/sla) rpact/man/0000755000175000017500000000000014165536077012306 5ustar nileshnileshrpact/man/param_slope.Rd0000644000175000017500000000063714142514771015075 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_slope} \alias{param_slope} \title{Parameter Description: Slope} \arguments{ \item{slope}{If \code{typeOfShape = "sigmoidEmax"} is selected, \code{"slope"} can be entered to specify the slope of the sigmoid Emax model, default is 1.} } \description{ Parameter Description: Slope } \keyword{internal} rpact/man/getObjectRCode.Rd0000644000175000017500000000415014060405737015410 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_core_utilities.R \name{rcmd} \alias{rcmd} \alias{getObjectRCode} \title{Get Object R Code} \usage{ rcmd( obj, ..., leadingArguments = NULL, includeDefaultParameters = FALSE, stringWrapParagraphWidth = 90, prefix = "", postfix = "", stringWrapPrefix = "", newArgumentValues = list() ) getObjectRCode( obj, ..., leadingArguments = NULL, includeDefaultParameters = FALSE, stringWrapParagraphWidth = 90, prefix = "", postfix = "", stringWrapPrefix = "", newArgumentValues = list() ) } \arguments{ \item{obj}{The result object.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{leadingArguments}{A character vector with arguments that shall be inserted at the beginning of the function command, e.g., \code{design = x}. Be careful with this option because the created R command may no longer be valid if used.} \item{includeDefaultParameters}{If \code{TRUE}, default parameters will be included in all \code{rpact} commands; default is \code{FALSE}.} \item{stringWrapParagraphWidth}{An integer value defining the number of characters after which a line break shall be inserted; set to \code{NULL} to insert no line breaks.} \item{prefix}{A character string that shall be added to the beginning of the R command.} \item{postfix}{A character string that shall be added to the end of the R command.} \item{stringWrapPrefix}{A prefix character string that shall be added to each new line, typically some spaces.} \item{newArgumentValues}{A named list with arguments that shall be renewed in the R command, e.g., \code{newArgumentValues = list(informationRates = c(0.5, 1))}.} } \value{ A \code{\link[base]{character}} value or vector will be returned. } \description{ Returns the R source command of a result object. } \details{ \code{\link{getObjectRCode}} (short: \code{\link{rcmd}}) recreates the R commands that result in the specified object \code{obj}. \code{obj} must be an instance of class \code{ParameterSet}. } rpact/man/TrialDesignPlan_as.data.frame.Rd0000644000175000017500000000235514020357214020266 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_plan.R \name{TrialDesignPlan_as.data.frame} \alias{TrialDesignPlan_as.data.frame} \alias{as.data.frame.TrialDesignPlan} \title{Coerce Trial Design Plan to a Data Frame} \usage{ \method{as.data.frame}{TrialDesignPlan}( x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ... ) } \arguments{ \item{x}{A \code{\link{TrialDesignPlan}} object.} \item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column names will be used; syntactic names (variable names) otherwise (see \code{\link[base]{make.names}}).} \item{includeAllParameters}{Logical. If \code{TRUE}, all available parameters will be included in the data frame; a meaningful parameter selection otherwise, default is \code{FALSE}.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} } \value{ Returns a \code{\link[base]{data.frame}}. } \description{ Returns the \code{\link{TrialDesignPlan}} as data frame. } \details{ Coerces the design plan to a data frame. } \examples{ as.data.frame(getSampleSizeMeans()) } \keyword{internal} rpact/man/dataSurvival.Rd0000644000175000017500000000077014102177375015237 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{dataSurvival} \alias{dataSurvival} \title{One-Arm Dataset of Survival Data} \format{ A \code{\link[base]{data.frame}} object. } \usage{ dataSurvival } \description{ A dataset containing the log-rank statistics, events, and allocation ratios of one group. Use \code{getDataset(dataSurvival)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. } \keyword{datasets} rpact/man/SimulationResultsEnrichmentSurvival.Rd0000644000175000017500000000071414117626572022053 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R \docType{class} \name{SimulationResultsEnrichmentSurvival} \alias{SimulationResultsEnrichmentSurvival} \title{Class for Simulation Results Enrichment Survival} \description{ A class for simulation results survival in enrichment designs. } \details{ Use \code{\link{getSimulationEnrichmentSurvival}} to create an object of this type. } \keyword{internal} rpact/man/Trial_Design_Set_summary.Rd0000644000175000017500000000550414020357214017515 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_set.R \name{Trial_Design_Set_summary} \alias{Trial_Design_Set_summary} \alias{summary.TrialDesignSet} \title{Trial Design Set Summary} \usage{ \method{summary}{TrialDesignSet}(object, ..., type = 1, digits = NA_integer_) } \arguments{ \item{object}{A \code{\link{ParameterSet}} object.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{digits}{Defines how many digits are to be used for numeric values.} } \value{ Returns a \code{\link{SummaryFactory}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object } } \description{ Displays a summary of \code{\link{ParameterSet}} object. } \details{ Summarizes the trial designs. } \section{Summary options}{ The following options can be set globally: \enumerate{ \item \code{rpact.summary.output.size}: one of \code{c("small", "medium", "large")}; defines how many details will be included into the summary; default is \code{"large"}, i.e., all available details are displayed. \item \code{rpact.summary.justify}: one of \code{c("right", "left", "centre")}; shall the values be right-justified (the default), left-justified or centered. \item \code{rpact.summary.width}: defines the maximum number of characters to be used per line (default is \code{83}). \item \code{rpact.summary.intervalFormat}: defines how intervals will be displayed in the summary, default is \code{"[\%s; \%s]"}. \item \code{rpact.summary.digits}: defines how many digits are to be used for numeric values (default is \code{3}). \item \code{rpact.summary.digits.probs}: defines how many digits are to be used for numeric values (default is one more than value of \code{rpact.summary.digits}, i.e., \code{4}). \item \code{rpact.summary.trim.zeroes}: if \code{TRUE} (default) zeroes will always displayed as "0", e.g. "0.000" will become "0". } Example: \code{options("rpact.summary.intervalFormat" = "\%s - \%s")} } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \keyword{internal} rpact/man/kable.Rd0000644000175000017500000000103114142675425013642 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_parameter_set.R \name{kable} \alias{kable} \title{Create tables in Markdown} \usage{ kable(x, ...) } \arguments{ \item{x}{The object that inherits from \code{\link{ParameterSet}}.} \item{...}{Other arguments (see \code{\link[knitr]{kable}}).} } \description{ The \code{kable()} function returns a single table for a single object that inherits from class \code{\link{ParameterSet}}. } \details{ Generic to represent a parameter set in Markdown. } rpact/man/AnalysisResultsMultiHypotheses.Rd0000644000175000017500000000102014020357214021002 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsMultiHypotheses} \alias{AnalysisResultsMultiHypotheses} \title{Basic Class for Analysis Results Multi-Hypotheses} \description{ A basic class for multi-hypotheses analysis results. } \details{ \code{AnalysisResultsMultiHypotheses} is the basic class for \itemize{ \item \code{\link{AnalysisResultsMultiArm}} and \item \code{\link{AnalysisResultsEnrichment}}. } } \keyword{internal} rpact/man/TrialDesignPlanRates.Rd0000644000175000017500000000065614020357214016603 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_plan.R \docType{class} \name{TrialDesignPlanRates} \alias{TrialDesignPlanRates} \title{Trial Design Plan Rates} \description{ Trial design plan for rates. } \details{ This object cannot be created directly; use \code{\link{getSampleSizeRates}} with suitable arguments to create a design plan for a dataset of rates. } \keyword{internal} rpact/man/getSimulationMultiArmMeans.Rd0000644000175000017500000003507714153377720020067 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_simulation_multiarm_means.R \name{getSimulationMultiArmMeans} \alias{getSimulationMultiArmMeans} \title{Get Simulation Multi-Arm Means} \usage{ getSimulationMultiArmMeans( design = NULL, ..., activeArms = 3L, effectMatrix = NULL, typeOfShape = c("linear", "sigmoidEmax", "userDefined"), muMaxVector = seq(0, 1, 0.2), gED50 = NA_real_, slope = 1, intersectionTest = c("Dunnett", "Bonferroni", "Simes", "Sidak", "Hierarchical"), stDev = 1, adaptations = NA, typeOfSelection = c("best", "rBest", "epsilon", "all", "userDefined"), effectMeasure = c("effectEstimate", "testStatistic"), successCriterion = c("all", "atLeastOne"), epsilonValue = NA_real_, rValue = NA_real_, threshold = -Inf, plannedSubjects = NA_integer_, allocationRatioPlanned = NA_real_, minNumberOfSubjectsPerStage = NA_real_, maxNumberOfSubjectsPerStage = NA_real_, conditionalPower = NA_real_, thetaH1 = NA_real_, stDevH1 = NA_real_, maxNumberOfIterations = 1000L, seed = NA_real_, calcSubjectsFunction = NULL, selectArmsFunction = NULL, showStatistics = FALSE ) } \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{activeArms}{The number of active treatment arms to be compared with control, default is \code{3}.} \item{effectMatrix}{Matrix of effect sizes with \code{activeArms} columns and number of rows reflecting the different situations to consider.} \item{typeOfShape}{The shape of the dose-response relationship over the treatment groups. This can be either \code{"linear"}, \code{"sigmoidEmax"}, or \code{"userDefined"}. If \code{"sigmoidEmax"} is selected, \code{"gED50"} and \code{"slope"} has to be entered to specify the ED50 and the slope of the sigmoid Emax model. For \code{"linear"} and \code{"sigmoidEmax"}, \code{"muMaxVector"} specifies the range of effect sizes for the treatment group with highest response. If \code{"userDefined"} is selected, \code{"effectMatrix"} has to be entered.} \item{muMaxVector}{Range of effect sizes for the treatment group with highest response for \code{"linear"} and \code{"sigmoidEmax"} model, default is \code{seq(0, 1, 0.2)}.} \item{gED50}{If \code{typeOfShape = "sigmoidEmax"} is selected, \code{"gED50"} has to be entered to specify the ED50 of the sigmoid Emax model.} \item{slope}{If \code{typeOfShape = "sigmoidEmax"} is selected, \code{"slope"} can be entered to specify the slope of the sigmoid Emax model, default is 1.} \item{intersectionTest}{Defines the multiple test for the intersection hypotheses in the closed system of hypotheses. Five options are available in multi-arm designs: \code{"Dunnett"}, \code{"Bonferroni"}, \code{"Simes"}, \code{"Sidak"}, and \code{"Hierarchical"}, default is \code{"Dunnett"}.} \item{stDev}{The standard deviation under which the data is simulated, default is \code{1}. If \code{meanRatio = TRUE} is specified, \code{stDev} defines the coefficient of variation \code{sigma / mu2}.} \item{adaptations}{A vector of length \code{kMax - 1} indicating whether or not an adaptation takes place at interim k, default is \code{rep(TRUE, kMax - 1)}.} \item{typeOfSelection}{The way the treatment arms or populations are selected at interim. Five options are available: \code{"best"}, \code{"rbest"}, \code{"epsilon"}, \code{"all"}, and \code{"userDefined"}, default is \code{"best"}.\cr For \code{"rbest"} (select the \code{rValue} best treatment arms/populations), the parameter \code{rValue} has to be specified, for \code{"epsilon"} (select treatment arm/population not worse than epsilon compared to the best), the parameter \code{epsilonValue} has to be specified. If \code{"userDefined"} is selected, \code{"selectArmsFunction"} or \code{"selectPopulationsFunction"} has to be specified.} \item{effectMeasure}{Criterion for treatment arm/population selection, either based on test statistic (\code{"testStatistic"}) or effect estimate (difference for means and rates or ratio for survival) (\code{"effectEstimate"}), default is \code{"effectEstimate"}.} \item{successCriterion}{Defines when the study is stopped for efficacy at interim. Two options are available: \code{"all"} stops the trial if the efficacy criterion is fulfilled for all selected treatment arms/populations, \code{"atLeastOne"} stops if at least one of the selected treatment arms/populations is shown to be superior to control at interim, default is \code{"all"}.} \item{epsilonValue}{For \code{typeOfSelection = "epsilon"} (select treatment arm / population not worse than epsilon compared to the best), the parameter \code{epsilonValue} has to be specified.} \item{rValue}{For \code{typeOfSelection = "rbest"} (select the \code{rValue} best treatment arms / populations), the parameter \code{rValue} has to be specified.} \item{threshold}{Selection criterion: treatment arm / population is selected only if \code{effectMeasure} exceeds \code{threshold}, default is \code{-Inf}. \code{threshold} can also be a vector of length \code{activeArms} referring to a separate threshold condition over the treatment arms.} \item{plannedSubjects}{\code{plannedSubjects} is a vector of length \code{kMax} (the number of stages of the design) that determines the number of cumulated (overall) subjects when the interim stages are planned. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs, \code{plannedSubjects} refers to the number of subjects per selected active arm.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} \item{minNumberOfSubjectsPerStage}{When performing a data driven sample size recalculation, the vector \code{minNumberOfSubjectsPerStage} with length kMax determines the minimum number of subjects per stage (i.e., not cumulated), the first element is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs \code{minNumberOfSubjectsPerStage} refers to the minimum number of subjects per selected active arm.} \item{maxNumberOfSubjectsPerStage}{When performing a data driven sample size recalculation, the vector \code{maxNumberOfSubjectsPerStage} with length kMax determines the maximum number of subjects per stage (i.e., not cumulated), the first element is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs \code{maxNumberOfSubjectsPerStage} refers to the maximum number of subjects per selected active arm.} \item{conditionalPower}{If \code{conditionalPower} together with \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (or \code{minNumberOfEventsPerStage} and \code{maxNumberOfEventsPerStage} for survival designs) is specified, a sample size recalculation based on the specified conditional power is performed. It is defined as the power for the subsequent stage given the current data. By default, the conditional power will be calculated under the observed effect size. Optionally, you can also specify \code{thetaH1} and \code{stDevH1} (for simulating means), \code{pi1H1} and \code{pi2H1} (for simulating rates), or \code{thetaH1} (for simulating hazard ratios) as parameters under which it is calculated and the sample size recalculation is performed.} \item{thetaH1}{If specified, the value of the alternative under which the conditional power or sample size recalculation calculation is performed.} \item{stDevH1}{If specified, the value of the standard deviation under which the conditional power or sample size recalculation calculation is performed, default is the value of \code{stDev}.} \item{maxNumberOfIterations}{The number of simulation iterations, default is \code{1000}.} \item{seed}{The seed to reproduce the simulation, default is a random seed.} \item{calcSubjectsFunction}{Optionally, a function can be entered that defines the way of performing the sample size recalculation. By default, sample size recalculation is performed with conditional power with specified \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (see details and examples).} \item{selectArmsFunction}{Optionally, a function can be entered that defines the way of how treatment arms are selected. This function is allowed to depend on \code{effectVector} with length \code{activeArms} and \code{stage} (see examples).} \item{showStatistics}{If \code{TRUE}, summary statistics of the simulated data are displayed for the \code{print} command, otherwise the output is suppressed, default is \code{FALSE}.} } \value{ Returns a \code{\link{SimulationResults}} object. The following generics (R generic functions) are available for this object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.SimulationResults]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the simulated power, stopping and selection probabilities, conditional power, and expected sample size for testing means in a multi-arm treatment groups testing situation. } \details{ At given design the function simulates the power, stopping probabilities, selection probabilities, and expected sample size at given number of subjects, parameter configuration, and treatment arm selection rule in the multi-arm situation. An allocation ratio can be specified referring to the ratio of number of subjects in the active treatment groups as compared to the control group. The definition of \code{thetaH1} and/or \code{stDevH1} makes only sense if \code{kMax} > 1 and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and \code{maxNumberOfSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. \code{calcSubjectsFunction}\cr This function returns the number of subjects at given conditional power and conditional critical value for specified testing situation. The function might depend on the variables \code{stage}, \code{selectedArms}, \code{plannedSubjects}, \code{allocationRatioPlanned}, \code{minNumberOfSubjectsPerStage}, \code{maxNumberOfSubjectsPerStage}, \code{conditionalPower}, \code{conditionalCriticalValue}, \code{overallEffects}, and \code{stDevH1}. The function has to contain the three-dots argument '...' (see examples). } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ \donttest{ # Assess a treatment-arm selection strategy with three active arms, # if the better of the arms is selected for the second stage, and # compare it with the no-selection case. # Assume a linear dose-response relationship maxNumberOfIterations <- 100 designIN <- getDesignInverseNormal(typeOfDesign = "OF", kMax = 2) sim <- getSimulationMultiArmMeans(design = designIN, activeArms = 3, typeOfShape = "linear", muMaxVector = seq(0,0.8,0.2), intersectionTest = "Simes", typeOfSelection = "best", plannedSubjects = c(30,60), maxNumberOfIterations = maxNumberOfIterations) sim0 <- getSimulationMultiArmMeans(design = designIN, activeArms = 3, typeOfShape = "linear", muMaxVector = seq(0,0.8,0.2), intersectionTest = "Simes", typeOfSelection = "all", plannedSubjects = c(30,60), maxNumberOfIterations = maxNumberOfIterations) sim$rejectAtLeastOne sim$expectedNumberOfSubjects sim0$rejectAtLeastOne sim0$expectedNumberOfSubjects # Compare the power of the conditional Dunnett test with the power of the # combination test using Dunnett's intersection tests if no treatment arm # selection takes place. Asseume a linear dose-response relationship. maxNumberOfIterations <- 100 designIN <- getDesignInverseNormal(typeOfDesign = "asUser", userAlphaSpending = c(0, 0.025)) designCD <- getDesignConditionalDunnett(secondStageConditioning = TRUE) index <- 1 for (design in c(designIN, designCD)) { results <- getSimulationMultiArmMeans(design, activeArms = 3, muMaxVector = seq(0, 1, 0.2), typeOfShape = "linear", plannedSubjects = cumsum(rep(20, 2)), intersectionTest = "Dunnett", typeOfSelection = "all", maxNumberOfIterations = maxNumberOfIterations) if (index == 1) { drift <- results$effectMatrix[nrow(results$effectMatrix), ] plot(drift,results$rejectAtLeastOne, type = "l", lty = 1, lwd = 3, col = "black", ylab = "Power") } else { lines(drift,results$rejectAtLeastOne, type = "l", lty = index, lwd = 3, col = "red") } index <- index + 1 } legend("topleft", legend=c("Combination Dunnett", "Conditional Dunnett"), col=c("black", "red"), lty = (1:2), cex = 0.8) # Assess the design characteristics of a user defined selection # strategy in a two-stage design using the inverse normal method # with constant bounds. Stopping for futility due to # de-selection of all treatment arms. designIN <- getDesignInverseNormal(typeOfDesign = "P", kMax = 2) mySelection <- function(effectVector) { selectedArms <- (effectVector >= c(0, 0.1, 0.3)) return(selectedArms) } results <- getSimulationMultiArmMeans(designIN, activeArms = 3, muMaxVector = seq(0, 1, 0.2), typeOfShape = "linear", plannedSubjects = c(30,60), intersectionTest = "Dunnett", typeOfSelection = "userDefined", selectArmsFunction = mySelection, maxNumberOfIterations = 100) options(rpact.summary.output.size = "medium") summary(results) plot(results, type = c(5,3,9), grid = 4) } } rpact/man/param_plotSettings.Rd0000644000175000017500000000060514046535123016442 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_plotSettings} \alias{param_plotSettings} \title{Parameter Description: Plot Settings} \arguments{ \item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link{getPlotSettings}}.} } \description{ Parameter Description: Plot Settings } \keyword{internal} rpact/man/ClosedCombinationTestResults.Rd0000644000175000017500000000103614020357214020373 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \docType{class} \name{ClosedCombinationTestResults} \alias{ClosedCombinationTestResults} \title{Analysis Results Closed Combination Test} \description{ Class for multi-arm analysis results based on a closed combination test. } \details{ This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the multi-arm analysis results of a closed combination test design. } \keyword{internal} rpact/man/param_median1.Rd0000644000175000017500000000055514020357215015261 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_median1} \alias{param_median1} \title{Parameter Description: Median (1)} \arguments{ \item{median1}{The assumed median survival time in the treatment group, there is no default.} } \description{ Parameter Description: Median (1) } \keyword{internal} rpact/man/param_showStatistics.Rd0000644000175000017500000000074014060405737017001 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_showStatistics} \alias{param_showStatistics} \title{Parameter Description: Show Statistics} \arguments{ \item{showStatistics}{If \code{TRUE}, summary statistics of the simulated data are displayed for the \code{print} command, otherwise the output is suppressed, default is \code{FALSE}.} } \description{ Parameter Description: Show Statistics } \keyword{internal} rpact/man/param_directionUpper.Rd0000644000175000017500000000076714020357215016744 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_directionUpper} \alias{param_directionUpper} \title{Parameter Description: Direction Upper} \arguments{ \item{directionUpper}{Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values.} } \description{ Parameter Description: Direction Upper } \keyword{internal} rpact/man/AnalysisResults_names.Rd0000644000175000017500000000130014020357214017077 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \name{AnalysisResults_names} \alias{AnalysisResults_names} \alias{names.AnalysisResults} \title{Names of a Analysis Results Object} \usage{ \method{names}{AnalysisResults}(x) } \arguments{ \item{x}{An \code{\link{AnalysisResults}} object created by \code{\link{getAnalysisResults}}.} } \value{ Returns a \code{\link[base]{character}} vector containing the names of the \code{\link{AnalysisResults}} object. } \description{ Function to get the names of an \code{\link{AnalysisResults}} object. } \details{ Returns the names of an analysis results that can be accessed by the user. } \keyword{internal} rpact/man/param_piecewiseSurvivalTime.Rd0000644000175000017500000000105414020357215020266 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_piecewiseSurvivalTime} \alias{param_piecewiseSurvivalTime} \title{Parameter Description: Piecewise Survival Time} \arguments{ \item{piecewiseSurvivalTime}{A vector that specifies the time intervals for the piecewise definition of the exponential survival time cumulative distribution function \cr (for details see \code{\link{getPiecewiseSurvivalTime}}).} } \description{ Parameter Description: Piecewise Survival Time } \keyword{internal} rpact/man/plot.TrialDesignSet.Rd0000644000175000017500000001121714046535122016421 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_set.R \name{plot.TrialDesignSet} \alias{plot.TrialDesignSet} \title{Trial Design Set Plotting} \usage{ \method{plot}{TrialDesignSet}( x, y, ..., type = 1L, main = NA_character_, xlab = NA_character_, ylab = NA_character_, palette = "Set1", theta = seq(-1, 1, 0.02), nMax = NA_integer_, plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, grid = 1, plotSettings = NULL ) } \arguments{ \item{x}{The trial design set, obtained from \code{\link{getDesignSet}}.} \item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} \item{...}{Optional plot arguments. At the moment \code{xlim} and \code{ylim} are implemented for changing x or y axis limits without dropping data observations.} \item{type}{The plot type (default = \code{1}). The following plot types are available: \itemize{ \item \code{1}: creates a 'Boundaries' plot \item \code{3}: creates a 'Stage Levels' plot \item \code{4}: creates a 'Error Spending' plot \item \code{5}: creates a 'Power and Early Stopping' plot \item \code{6}: creates an 'Average Sample Size and Power / Early Stop' plot \item \code{7}: creates an 'Power' plot \item \code{8}: creates an 'Early Stopping' plot \item \code{9}: creates an 'Average Sample Size' plot \item \code{"all"}: creates all available plots and returns it as a grid plot or list }} \item{main}{The main title.} \item{xlab}{The x-axis label.} \item{ylab}{The y-axis label.} \item{palette}{The palette, default is \code{"Set1"}.} \item{theta}{A vector of standardized effect sizes (theta values), default is a sequence from -1 to 1.} \item{nMax}{The maximum sample size.} \item{plotPointsEnabled}{If \code{TRUE}, additional points will be plotted.} \item{legendPosition}{The position of the legend. By default (\code{NA_integer_}) the algorithm tries to find a suitable position. Choose one of the following values to specify the position manually: \itemize{ \item \code{-1}: no legend will be shown \item \code{NA}: the algorithm tries to find a suitable position \item \code{0}: legend position outside plot \item \code{1}: legend position left top \item \code{2}: legend position left center \item \code{3}: legend position left bottom \item \code{4}: legend position right top \item \code{5}: legend position right center \item \code{6}: legend position right bottom }} \item{showSource}{If \code{TRUE}, the parameter names of the object will be printed which were used to create the plot; that may be, e.g., useful to check the values or to create own plots with the base R \code{plot} function. Alternatively \code{showSource} can be defined as one of the following character values: \itemize{ \item \code{"commands"}: returns a character vector with plot commands \item \code{"axes"}: returns a list with the axes definitions \item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function does not stop if an error occurs) \item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function stops if an error occurs) } Note: no plot object will be returned if \code{showSource} is a character.} \item{grid}{An integer value specifying the output of multiple plots. By default (\code{1}) a list of \code{ggplot} objects will be returned. If a \code{grid} value > 1 was specified, a grid plot will be returned if the number of plots is <= specified \code{grid} value; a list of \code{ggplot} objects will be returned otherwise. If \code{grid = 0} is specified, all plots will be created using \code{\link[base]{print}} command and a list of \code{ggplot} objects will be returned invisible. Note that one of the following packages must be installed to create a grid plot: 'ggpubr', 'gridExtra', or 'cowplot'.} \item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link{getPlotSettings}}.} } \value{ Returns a \code{ggplot2} object. } \description{ Plots a trial design set. } \details{ Generic function to plot a trial design set. Is, e.g., useful to compare different designs or design parameters visual. } \examples{ design <- getDesignInverseNormal(kMax = 3, alpha = 0.025, typeOfDesign = "asKD", gammaA = 2, informationRates = c(0.2, 0.7, 1), typeBetaSpending = "bsOF") # Create a set of designs based on the master design defined above # and varied parameter 'gammaA' designSet <- getDesignSet(design = design, gammaA = 4) if (require(ggplot2)) plot(designSet, type = 1, legendPosition = 6) } rpact/man/param_accrualTime.Rd0000644000175000017500000000065514020357215016175 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_accrualTime} \alias{param_accrualTime} \title{Parameter Description: Accrual Time} \arguments{ \item{accrualTime}{The assumed accrual time intervals for the study, default is \code{c(0, 12)} (for details see \code{\link{getAccrualTime}}).} } \description{ Parameter Description: Accrual Time } \keyword{internal} rpact/man/SummaryFactory.Rd0000644000175000017500000000036114020357214015542 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_summary.R \docType{class} \name{SummaryFactory} \alias{SummaryFactory} \title{Summary Factory} \description{ Basic class for summaries } \keyword{internal} rpact/man/TrialDesignCharacteristics.Rd0000644000175000017500000000115414020357214020017 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R \docType{class} \name{TrialDesignCharacteristics} \alias{TrialDesignCharacteristics} \title{Trial Design Characteristics} \description{ Class for trial design characteristics. } \details{ \code{TrialDesignCharacteristics} contains all fields required to collect the characteristics of a design. This object should not be created directly; use \code{getDesignCharacteristics} with suitable arguments to create it. } \seealso{ \code{\link{getDesignCharacteristics}} for getting the design characteristics. } \keyword{internal} rpact/man/getLongFormat.Rd0000644000175000017500000000143214051425051015324 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_analysis_utilities.R \name{getLongFormat} \alias{getLongFormat} \title{Get Long Format} \usage{ getLongFormat(dataInput) } \value{ A \code{\link[base]{data.frame}} will be returned. } \description{ Returns the specified dataset as a \code{\link[base]{data.frame}} in so-called long format. } \details{ In the long format (narrow, stacked), the data are presented with one column containing all the values and another column listing the context of the value, i.e., the data for the different groups are in one column and the dataset contains an additional "group" column. } \seealso{ \code{\link{getWideFormat}} for returning the dataset as a \code{\link[base]{data.frame}} in wide format. } \keyword{internal} rpact/man/getParameterCaption.Rd0000644000175000017500000000145514020357214016520 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_core_utilities.R \name{getParameterCaption} \alias{getParameterCaption} \title{Get Parameter Caption} \usage{ getParameterCaption(obj, parameterName) } \value{ Returns a \code{\link[base]{character}} of specifying the corresponding caption of a given parameter name. Returns \code{NULL} if the specified \code{parameterName} does not exist. } \description{ Returns the parameter caption for a given object and parameter name. } \details{ This function identifies and returns the caption that will be used in print outputs of an rpact result object. } \examples{ getParameterCaption(getDesignInverseNormal(), "kMax") } \seealso{ \code{\link{getParameterName}} for getting the parameter name for a given caption. } \keyword{internal} rpact/man/param_conditionalPower.Rd0000644000175000017500000000066014020357215017260 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_conditionalPower} \alias{param_conditionalPower} \title{Parameter Description: Conditional Power} \arguments{ \item{conditionalPower}{The conditional power for the subsequent stage under which the sample size recalculation is performed.} } \description{ Parameter Description: Conditional Power } \keyword{internal} rpact/man/param_maxNumberOfSubjects_survival.Rd0000644000175000017500000000104414020357215021616 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_maxNumberOfSubjects_survival} \alias{param_maxNumberOfSubjects_survival} \title{Parameter Description: Maximum Number Of Subjects For Survival Endpoint} \arguments{ \item{maxNumberOfSubjects}{\code{maxNumberOfSubjects > 0} needs to be specified. If accrual time and accrual intensity is specified, this will be calculated.} } \description{ Parameter Description: Maximum Number Of Subjects For Survival Endpoint } \keyword{internal} rpact/man/DatasetSurvival.Rd0000644000175000017500000000152014153377720015707 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R \docType{class} \name{DatasetSurvival} \alias{DatasetSurvival} \title{Dataset of Survival Data} \description{ Class for a dataset of survival data. } \details{ This object cannot be created directly; better use \code{\link{getDataset}} with suitable arguments to create a dataset of survival data. } \section{Fields}{ \describe{ \item{\code{groups}}{The group numbers.} \item{\code{stages}}{The stage numbers.} \item{\code{overallEvents}}{The cumulative events.} \item{\code{overallAllocationRatios}}{The cumulative allocations ratios.} \item{\code{overallLogRanks}}{The overall logrank test statistics.} \item{\code{allocationRatios}}{The allocation ratios.} \item{\code{logRanks}}{The logrank test statistics.} }} \keyword{internal} rpact/man/getPowerRates.Rd0000644000175000017500000001511714153377720015370 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_design_sample_size_calculator.R \name{getPowerRates} \alias{getPowerRates} \title{Get Power Rates} \usage{ getPowerRates( design = NULL, ..., groups = 2L, riskRatio = FALSE, thetaH0 = ifelse(riskRatio, 1, 0), pi1 = seq(0.2, 0.5, 0.1), pi2 = 0.2, directionUpper = NA, maxNumberOfSubjects = NA_real_, allocationRatioPlanned = NA_real_ ) } \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{groups}{The number of treatment groups (1 or 2), default is \code{2}.} \item{riskRatio}{If \code{TRUE}, the power for one-sided testing of H0: \code{pi1 / pi2 = thetaH0} is calculated, default is \code{FALSE}.} \item{thetaH0}{The null hypothesis value, default is \code{0} for the normal and the binary case (testing means and rates, respectively), it is \code{1} for the survival case (testing the hazard ratio).\cr\cr For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. That is, in case of (one-sided) testing of \itemize{ \item \emph{means}: a value \code{!= 0} (or a value \code{!= 1} for testing the mean ratio) can be specified. \item \emph{rates}: a value \code{!= 0} (or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. \item \emph{survival data}: a bound for testing H0: \code{hazard ratio = thetaH0 != 1} can be specified. } For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for defining the null hypothesis H0: \code{pi = thetaH0}.} \item{pi1}{A numeric value or vector that represents the assumed probability in the active treatment group if two treatment groups are considered, or the alternative probability for a one treatment group design, default is \code{seq(0.2, 0.5, 0.1)} (power calculations and simulations) or \code{seq(0.4, 0.6, 0.1)} (sample size calculations).} \item{pi2}{A numeric value that represents the assumed probability in the reference group if two treatment groups are considered, default is \code{0.2}.} \item{directionUpper}{Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values.} \item{maxNumberOfSubjects}{\code{maxNumberOfSubjects > 0} needs to be specified. For two treatment arms, it is the maximum number of subjects for both treatment arms.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} } \value{ Returns a \code{\link{TrialDesignPlan}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.TrialDesignSet]{summary}} to display a summary of the object, \item \code{\link[=plot.TrialDesignPlan]{plot}} to plot the object, \item \code{\link[=as.data.frame.TrialDesignPlan]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the power, stopping probabilities, and expected sample size for testing rates in one or two samples at given sample sizes. } \details{ At given design the function calculates the power, stopping probabilities, and expected sample size, for testing rates for given maximum sample size. The sample sizes over the stages are calculated according to the specified information rate in the design. In a two treatment groups design, additionally, an allocation ratio = n1/n2 can be specified. If a null hypothesis value thetaH0 != 0 for testing the difference of two rates or \code{thetaH0 != 1} for testing the risk ratio is specified, the formulas according to Farrington & Manning (Statistics in Medicine, 1990) are used (only one-sided testing). Critical bounds and stopping for futility bounds are provided at the effect scale (rate, rate difference, or rate ratio, respectively). For the two-sample case, the calculation here is performed at fixed pi2 as given as argument in the function. Note that the power calculation for rates is always based on the normal approximation. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Calculate the power, stopping probabilities, and expected sample size in a # two-armed design at given maximum sample size N = 200 in a three-stage # O'Brien & Fleming design with information rate vector (0.2,0.5,1), # non-binding futility boundaries (0,0), i.e., the study stops for futility # if the p-value exceeds 0.5 at interm, and allocation ratio = 2 for a range # of pi1 values when testing H0: pi1 - pi2 = -0.1: getPowerRates(getDesignGroupSequential(informationRates = c(0.2, 0.5, 1), futilityBounds = c(0, 0)), groups = 2, thetaH0 = -0.1, pi1 = seq(0.3, 0.6, 0.1), directionUpper = FALSE, pi2 = 0.7, allocationRatioPlanned = 2, maxNumberOfSubjects = 200) \donttest{ # Calculate the power, stopping probabilities, and expected sample size in a single # arm design at given maximum sample size N = 60 in a three-stage two-sided # O'Brien & Fleming design with information rate vector (0.2, 0.5,1) # for a range of pi1 values when testing H0: pi = 0.3: getPowerRates(getDesignGroupSequential(informationRates = c(0.2, 0.5,1), sided = 2), groups = 1, thetaH0 = 0.3, pi1 = seq(0.3, 0.5, 0.05), maxNumberOfSubjects = 60) } } \seealso{ Other power functions: \code{\link{getPowerMeans}()}, \code{\link{getPowerSurvival}()} } \concept{power functions} rpact/man/param_threshold.Rd0000644000175000017500000000107014142514771015737 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_threshold} \alias{param_threshold} \title{Parameter Description: Threshold} \arguments{ \item{threshold}{Selection criterion: treatment arm / population is selected only if \code{effectMeasure} exceeds \code{threshold}, default is \code{-Inf}. \code{threshold} can also be a vector of length \code{activeArms} referring to a separate threshold condition over the treatment arms.} } \description{ Parameter Description: Threshold } \keyword{internal} rpact/man/PowerAndAverageSampleNumberResult.Rd0000644000175000017500000000073714020357214021310 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_power_and_asn.R \docType{class} \name{PowerAndAverageSampleNumberResult} \alias{PowerAndAverageSampleNumberResult} \title{Power and Average Sample Number Result} \description{ Class for power and average sample number (ASN) results. } \details{ This object cannot be created directly; use \code{getPowerAndAverageSampleNumber} with suitable arguments to create it. } \keyword{internal} rpact/man/utilitiesForPiecewiseExponentialDistribution.Rd0000644000175000017500000001010214060361011023670 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_design_utilities.R \name{utilitiesForPiecewiseExponentialDistribution} \alias{utilitiesForPiecewiseExponentialDistribution} \alias{getPiecewiseExponentialDistribution} \alias{ppwexp} \alias{getPiecewiseExponentialQuantile} \alias{qpwexp} \alias{getPiecewiseExponentialRandomNumbers} \alias{rpwexp} \title{The Piecewise Exponential Distribution} \usage{ getPiecewiseExponentialDistribution( time, ..., piecewiseSurvivalTime = NA_real_, piecewiseLambda = NA_real_, kappa = 1 ) ppwexp(t, ..., s = NA_real_, lambda = NA_real_, kappa = 1) getPiecewiseExponentialQuantile( quantile, ..., piecewiseSurvivalTime = NA_real_, piecewiseLambda = NA_real_, kappa = 1 ) qpwexp(q, ..., s = NA_real_, lambda = NA_real_, kappa = 1) getPiecewiseExponentialRandomNumbers( n, ..., piecewiseSurvivalTime = NA_real_, piecewiseLambda = NA_real_, kappa = 1 ) rpwexp(n, ..., s = NA_real_, lambda = NA_real_, kappa = 1) } \arguments{ \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{kappa}{A numeric value > 0. A \code{kappa != 1} will be used for the specification of the shape of the Weibull distribution. Default is \code{1}, i.e., the exponential survival distribution is used instead of the Weibull distribution. Note that the Weibull distribution cannot be used for the piecewise definition of the survival time distribution, i.e., only \code{piecewiselambda} (as a single value) and \code{kappa} can be specified. This function is equivalent to \code{pweibull(t, shape = kappa, scale = 1 / lambda)} of the \code{stats} package, i.e., the scale parameter is \code{1 / 'hazard rate'}.\cr For example, \code{getPiecewiseExponentialDistribution(time = 130, piecewiseLambda = 0.01, kappa = 4.2)} and \code{pweibull(q = 130, shape = 4.2, scale = 1 / 0.01)} provide the sample result.} \item{t, time}{Vector of time values.} \item{s, piecewiseSurvivalTime}{Vector of start times defining the "time pieces".} \item{lambda, piecewiseLambda}{Vector of lambda values (hazard rates) corresponding to the start times.} \item{q, quantile}{Vector of quantiles.} \item{n}{Number of observations.} } \value{ A \code{\link[base]{numeric}} value or vector will be returned. } \description{ Distribution function, quantile function and random number generation for the piecewise exponential distribution. } \details{ \code{getPiecewiseExponentialDistribution} (short: \code{ppwexp}), \code{getPiecewiseExponentialQuantile} (short: \code{qpwexp}), and \code{getPiecewiseExponentialRandomNumbers} (short: \code{rpwexp}) provide probabilities, quantiles, and random numbers according to a piecewise exponential or a Weibull distribution. The piecewise definition is performed through a vector of starting times (\code{piecewiseSurvivalTime}) and a vector of hazard rates (\code{piecewiseLambda}). You can also use a list that defines the starting times and piecewise lambdas together and define piecewiseSurvivalTime as this list. The list needs to have the form, e.g., piecewiseSurvivalTime <- list( "0 - <6" = 0.025, "6 - <9" = 0.04, "9 - <15" = 0.015, ">=15" = 0.007) . For the Weibull case, you can also specify a shape parameter kappa in order to calculate probabilities, quantiles, or random numbers. In this case, no piecewise definition is possible, i.e., only piecewiseLambda (as a single value) and kappa need to be specified. } \examples{ # Calculate probabilties for a range of time values for a # piecewise exponential distribution with hazard rates # 0.025, 0.04, 0.015, and 0.007 in the intervals # [0, 6), [6, 9), [9, 15), [15, Inf), respectively, # and re-return the time values: piecewiseSurvivalTime <- list( "0 - <6" = 0.025, "6 - <9" = 0.04, "9 - <15" = 0.015, ">=15" = 0.01) y <- getPiecewiseExponentialDistribution(seq(0, 150, 15), piecewiseSurvivalTime = piecewiseSurvivalTime) getPiecewiseExponentialQuantile(y, piecewiseSurvivalTime = piecewiseSurvivalTime) } rpact/man/param_stDevSimulation.Rd0000644000175000017500000000103414037546443017101 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_stDevSimulation} \alias{param_stDevSimulation} \title{Parameter Description: Standard Deviation for Simulation} \arguments{ \item{stDev}{The standard deviation under which the data is simulated, default is \code{1}. If \code{meanRatio = TRUE} is specified, \code{stDev} defines the coefficient of variation \code{sigma / mu2}.} } \description{ Parameter Description: Standard Deviation for Simulation } \keyword{internal} rpact/man/ParameterSet_as.data.frame.Rd0000644000175000017500000000224314020357214017636 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_parameter_set.R \name{ParameterSet_as.data.frame} \alias{ParameterSet_as.data.frame} \alias{as.data.frame.ParameterSet} \title{Coerce Parameter Set to a Data Frame} \usage{ \method{as.data.frame}{ParameterSet}( x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ... ) } \arguments{ \item{x}{A \code{\link{FieldSet}} object.} \item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column names will be used; syntactic names (variable names) otherwise (see \code{\link[base]{make.names}}).} \item{includeAllParameters}{Logical. If \code{TRUE}, all available parameters will be included in the data frame; a meaningful parameter selection otherwise, default is \code{FALSE}.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} } \value{ Returns a \code{\link[base]{data.frame}}. } \description{ Returns the \code{ParameterSet} as data frame. } \details{ Coerces the parameter set to a data frame. } \keyword{internal} rpact/man/AnalysisResults_as.data.frame.Rd0000644000175000017500000000147414020357214020414 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \name{AnalysisResults_as.data.frame} \alias{AnalysisResults_as.data.frame} \alias{as.data.frame.AnalysisResults} \title{Coerce AnalysisResults to a Data Frame} \usage{ \method{as.data.frame}{AnalysisResults}(x, row.names = NULL, optional = FALSE, ...) } \arguments{ \item{x}{An \code{\link{AnalysisResults}} object created by \code{\link{getAnalysisResults}}.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} } \value{ Returns a \code{\link[base]{data.frame}}. } \description{ Returns the \code{\link{AnalysisResults}} object as data frame. } \details{ Coerces the analysis results to a data frame. } \keyword{internal} rpact/man/StageResults.Rd0000644000175000017500000000166314020357214015210 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R \docType{class} \name{StageResults} \alias{StageResults} \title{Basic Stage Results} \description{ Basic class for stage results. } \details{ \code{StageResults} is the basic class for \code{StageResultsMeans}, \code{StageResultsRates}, and \code{StageResultsSurvival}. } \section{Fields}{ \describe{ \item{\code{testStatistics}}{The stage-wise test statistics.} \item{\code{pValues}}{The stage-wise p-values.} \item{\code{combInverseNormal}}{The inverse normal test.} \item{\code{combFisher}}{The Fisher's combination test.} \item{\code{effectSizes}}{The effect sizes for different designs.} \item{\code{testActions}}{The action drawn from test result.} \item{\code{weightsFisher}}{The weights for Fisher's combination test.} \item{\code{weightsInverseNormal}}{The weights for inverse normal statistic.} }} \keyword{internal} rpact/man/param_typeOfSelection.Rd0000644000175000017500000000166214102177376017070 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_typeOfSelection} \alias{param_typeOfSelection} \title{Parameter Description: Type of Selection} \arguments{ \item{typeOfSelection}{The way the treatment arms or populations are selected at interim. Five options are available: \code{"best"}, \code{"rbest"}, \code{"epsilon"}, \code{"all"}, and \code{"userDefined"}, default is \code{"best"}.\cr For \code{"rbest"} (select the \code{rValue} best treatment arms/populations), the parameter \code{rValue} has to be specified, for \code{"epsilon"} (select treatment arm/population not worse than epsilon compared to the best), the parameter \code{epsilonValue} has to be specified. If \code{"userDefined"} is selected, \code{"selectArmsFunction"} or \code{"selectPopulationsFunction"} has to be specified.} } \description{ Parameter Description: Type of Selection } \keyword{internal} rpact/man/plot.SimulationResults.Rd0000644000175000017500000001202514046535122017244 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R \name{plot.SimulationResults} \alias{plot.SimulationResults} \title{Simulation Results Plotting} \usage{ \method{plot}{SimulationResults}( x, y, ..., main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", theta = seq(-1, 1, 0.01), plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, grid = 1, plotSettings = NULL ) } \arguments{ \item{x}{The simulation results, obtained from \cr \code{\link{getSimulationSurvival}}.} \item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} \item{...}{Optional plot arguments. At the moment \code{xlim} and \code{ylim} are implemented for changing x or y axis limits without dropping data observations.} \item{main}{The main title.} \item{xlab}{The x-axis label.} \item{ylab}{The y-axis label.} \item{type}{The plot type (default = \code{1}). The following plot types are available: \itemize{ \item \code{1}: creates a 'Overall Success' plot (multi-arm only) \item \code{2}: creates a 'Success per Stage' plot (multi-arm only) \item \code{3}: creates a 'Selected Arms per Stage' plot (multi-arm only) \item \code{4}: creates a 'Reject per Stage' or 'Rejected Arms per Stage' plot \item \code{5}: creates a 'Overall Power and Early Stopping' plot \item \code{6}: creates a 'Expected Number of Subjects and Power / Early Stop' or 'Expected Number of Events and Power / Early Stop' plot \item \code{7}: creates an 'Overall Power' plot \item \code{8}: creates an 'Overall Early Stopping' plot \item \code{9}: creates an 'Expected Sample Size' or 'Expected Number of Events' plot \item \code{10}: creates a 'Study Duration' plot (non-multi-arm survival only) \item \code{11}: creates an 'Expected Number of Subjects' plot (non-multi-arm survival only) \item \code{12}: creates an 'Analysis Times' plot (non-multi-arm survival only) \item \code{13}: creates a 'Cumulative Distribution Function' plot (non-multi-arm survival only) \item \code{14}: creates a 'Survival Function' plot (non-multi-arm survival only) \item \code{"all"}: creates all available plots and returns it as a grid plot or list }} \item{palette}{The palette, default is \code{"Set1"}.} \item{theta}{A vector of standardized effect sizes (theta values), default is a sequence from -1 to 1.} \item{plotPointsEnabled}{If \code{TRUE}, additional points will be plotted.} \item{legendPosition}{The position of the legend. By default (\code{NA_integer_}) the algorithm tries to find a suitable position. Choose one of the following values to specify the position manually: \itemize{ \item \code{-1}: no legend will be shown \item \code{NA}: the algorithm tries to find a suitable position \item \code{0}: legend position outside plot \item \code{1}: legend position left top \item \code{2}: legend position left center \item \code{3}: legend position left bottom \item \code{4}: legend position right top \item \code{5}: legend position right center \item \code{6}: legend position right bottom }} \item{showSource}{If \code{TRUE}, the parameter names of the object will be printed which were used to create the plot; that may be, e.g., useful to check the values or to create own plots with the base R \code{plot} function. Alternatively \code{showSource} can be defined as one of the following character values: \itemize{ \item \code{"commands"}: returns a character vector with plot commands \item \code{"axes"}: returns a list with the axes definitions \item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function does not stop if an error occurs) \item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function stops if an error occurs) } Note: no plot object will be returned if \code{showSource} is a character.} \item{grid}{An integer value specifying the output of multiple plots. By default (\code{1}) a list of \code{ggplot} objects will be returned. If a \code{grid} value > 1 was specified, a grid plot will be returned if the number of plots is <= specified \code{grid} value; a list of \code{ggplot} objects will be returned otherwise. If \code{grid = 0} is specified, all plots will be created using \code{\link[base]{print}} command and a list of \code{ggplot} objects will be returned invisible. Note that one of the following packages must be installed to create a grid plot: 'ggpubr', 'gridExtra', or 'cowplot'.} \item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link{getPlotSettings}}.} } \value{ Returns a \code{ggplot2} object. } \description{ Plots simulation results. } \details{ Generic function to plot all kinds of simulation results. } \examples{ \donttest{ results <- getSimulationMeans(alternative = 0:4, stDev = 5, plannedSubjects = 40, maxNumberOfIterations = 1000) plot(results, type = 5) } } rpact/man/param_varianceOption.Rd0000644000175000017500000000136614055410744016732 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_varianceOption} \alias{param_varianceOption} \title{Parameter Description: Variance Option} \arguments{ \item{varianceOption}{Defines the way to calculate the variance in multiple treatment arms (> 2) or population enrichment designs for testing means. For multiple arms, three options are available: \code{"overallPooled"}, \code{"pairwisePooled"}, and \code{"notPooled"}, default is \code{"overallPooled"}. For enrichment designs, the options are: \code{"pooled"}, \code{"pooledFromFull"} (one subset only), and \code{"notPooled"}, default is \code{"pooled"}.} } \description{ Parameter Description: Variance Option } \keyword{internal} rpact/man/StageResults_names.Rd0000644000175000017500000000117514020357214016371 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R \name{StageResults_names} \alias{StageResults_names} \alias{names.StageResults} \title{Names of a Stage Results Object} \usage{ \method{names}{StageResults}(x) } \arguments{ \item{x}{A \code{\link{StageResults}} object.} } \value{ Returns a \code{\link[base]{character}} vector containing the names of the \code{\link{AnalysisResults}} object. } \description{ Function to get the names of a \code{\link{StageResults}} object. } \details{ Returns the names of stage results that can be accessed by the user. } \keyword{internal} rpact/man/StageResultsMeans.Rd0000644000175000017500000000172114020357214016167 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R \docType{class} \name{StageResultsMeans} \alias{StageResultsMeans} \title{Stage Results of Means} \description{ Class for stage results of means. } \details{ This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of means. } \section{Fields}{ \describe{ \item{\code{testStatistics}}{The stage-wise test statistics.} \item{\code{pValues}}{The stage-wise p-values.} \item{\code{combInverseNormal}}{The inverse normal test.} \item{\code{combFisher}}{The Fisher's combination test.} \item{\code{effectSizes}}{The effect sizes for different designs.} \item{\code{testActions}}{The action drawn from test result.} \item{\code{weightsFisher}}{The weights for Fisher's combination test.} \item{\code{weightsInverseNormal}}{The weights for inverse normal statistic.} }} \keyword{internal} rpact/man/param_alternative_simulation.Rd0000644000175000017500000000101014051453422020511 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_alternative_simulation} \alias{param_alternative_simulation} \title{Parameter Description: Alternative for Simulation} \arguments{ \item{alternative}{The alternative hypothesis value for testing means under which the data is simulated. This can be a vector of assumed alternatives, default is \code{seq(0, 1, 0.2)}.} } \description{ Parameter Description: Alternative for Simulation } \keyword{internal} rpact/man/param_stDevH1.Rd0000644000175000017500000000100514020357215015210 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_stDevH1} \alias{param_stDevH1} \title{Parameter Description: Standard Deviation Under Alternative} \arguments{ \item{stDevH1}{If specified, the value of the standard deviation under which the conditional power or sample size recalculation calculation is performed, default is the value of \code{stDev}.} } \description{ Parameter Description: Standard Deviation Under Alternative } \keyword{internal} rpact/man/param_effectMatrix.Rd0000644000175000017500000000065714020357215016367 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_effectMatrix} \alias{param_effectMatrix} \title{Parameter Description: Effect Matrix} \arguments{ \item{effectMatrix}{Matrix of effect sizes with \code{activeArms} columns and number of rows reflecting the different situations to consider.} } \description{ Parameter Description: Effect Matrix } \keyword{internal} rpact/man/param_normalApproximation.Rd0000644000175000017500000000140014020357215017774 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_normalApproximation} \alias{param_normalApproximation} \title{Parameter Description: Normal Approximation} \arguments{ \item{normalApproximation}{The type of computation of the p-values. Default is \code{FALSE} for testing means (i.e., the t test is used) and \code{TRUE} for testing rates and the hazard ratio. For testing rates, if \code{normalApproximation = FALSE} is specified, the binomial test (one sample) or the exact test of Fisher (two samples) is used for calculating the p-values. In the survival setting \code{normalApproximation = FALSE} has no effect.} } \description{ Parameter Description: Normal Approximation } \keyword{internal} rpact/man/getDesignGroupSequential.Rd0000644000175000017500000001657714153377720017571 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_design_group_sequential.R \name{getDesignGroupSequential} \alias{getDesignGroupSequential} \title{Get Design Group Sequential} \usage{ getDesignGroupSequential( ..., kMax = NA_integer_, alpha = NA_real_, beta = NA_real_, sided = 1, informationRates = NA_real_, futilityBounds = NA_real_, typeOfDesign = c("OF", "P", "WT", "PT", "HP", "WToptimum", "asP", "asOF", "asKD", "asHSD", "asUser", "noEarlyEfficacy"), deltaWT = NA_real_, deltaPT1 = NA_real_, deltaPT0 = NA_real_, optimizationCriterion = c("ASNH1", "ASNIFH1", "ASNsum"), gammaA = NA_real_, typeBetaSpending = c("none", "bsP", "bsOF", "bsKD", "bsHSD", "bsUser"), userAlphaSpending = NA_real_, userBetaSpending = NA_real_, gammaB = NA_real_, bindingFutility = NA, constantBoundsHP = 3, twoSidedPower = NA, tolerance = 1e-08 ) } \arguments{ \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{kMax}{The maximum number of stages \code{K}. \code{K = 1, 2, 3, ...} (default is \code{3}). The maximum selectable \code{kMax} is \code{20} for group sequential or inverse normal and \code{6} for Fisher combination test designs.} \item{alpha}{The significance level alpha, default is \code{0.025}.} \item{beta}{Type II error rate, necessary for providing sample size calculations \cr (e.g., \code{\link{getSampleSizeMeans}}), beta spending function designs, or optimum designs, default is \code{0.20}.} \item{sided}{Is the alternative one-sided (\code{1}) or two-sided (\code{2}), default is \code{1}.} \item{informationRates}{The information rates (that must be fixed prior to the trial), default is \code{(1:kMax) / kMax}.} \item{futilityBounds}{The futility bounds, defined on the test statistic z scale (numeric vector of length \code{kMax - 1}).} \item{typeOfDesign}{The type of design. Type of design is one of the following: O'Brien & Fleming (\code{"OF"}), Pocock (\code{"P"}), Wang & Tsiatis Delta class (\code{"WT"}), Pampallona & Tsiatis (\code{"PT"}), Haybittle & Peto ("HP"), Optimum design within Wang & Tsiatis class (\code{"WToptimum"}), O'Brien & Fleming type alpha spending (\code{"asOF"}), Pocock type alpha spending (\code{"asP"}), Kim & DeMets alpha spending (\code{"asKD"}), Hwang, Shi & DeCani alpha spending (\code{"asHSD"}), user defined alpha spending (\code{"asUser"}), no early efficacy stop (\code{"noEarlyEfficacy"}), default is \code{"OF"}.} \item{deltaWT}{Delta for Wang & Tsiatis Delta class.} \item{deltaPT1}{Delta1 for Pampallona & Tsiatis class rejecting H0 boundaries.} \item{deltaPT0}{Delta0 for Pampallona & Tsiatis class rejecting H1 boundaries.} \item{optimizationCriterion}{Optimization criterion for optimum design within Wang & Tsiatis class (\code{"ASNH1"}, \code{"ASNIFH1"}, \code{"ASNsum"}), default is \code{"ASNH1"}, see details.} \item{gammaA}{Parameter for alpha spending function.} \item{typeBetaSpending}{Type of beta spending. Type of of beta spending is one of the following: O'Brien & Fleming type beta spending, Pocock type beta spending, Kim & DeMets beta spending, Hwang, Shi & DeCani beta spending, user defined beta spending (\code{"bsOF"}, \code{"bsP"}, \code{"bsKD"}, \code{"bsHSD"}, \code{"bsUser"}, default is \code{"none"}).} \item{userAlphaSpending}{The user defined alpha spending. Numeric vector of length \code{kMax} containing the cumulative alpha-spending (Type I error rate) up to each interim stage: \code{0 <= alpha_1 <= ... <= alpha_K <= alpha}.} \item{userBetaSpending}{The user defined beta spending. Vector of length \code{kMax} containing the cumulative beta-spending up to each interim stage.} \item{gammaB}{Parameter for beta spending function.} \item{bindingFutility}{If \code{bindingFutility = TRUE} is specified the calculation of the critical values is affected by the futility bounds and the futility threshold is binding in the sense that the study must be stopped if the futility condition was reached (default is \code{FALSE}).} \item{constantBoundsHP}{The constant bounds up to stage \code{kMax - 1} for the Haybittle & Peto design (default is \code{3}).} \item{twoSidedPower}{For two-sided testing, if \code{twoSidedPower = TRUE} is specified the sample size calculation is performed by considering both tails of the distribution. Default is \code{FALSE}, i.e., it is assumed that one tail probability is equal to 0 or the power should be directed to one part.} \item{tolerance}{The numerical tolerance, default is \code{1e-08}.} } \value{ Returns a \code{\link{TrialDesign}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.TrialDesign]{plot}} to plot the object, \item \code{\link[=as.data.frame.TrialDesign]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Provides adjusted boundaries and defines a group sequential design. } \details{ Depending on \code{typeOfDesign} some parameters are specified, others not. For example, only if \code{typeOfDesign} \code{"asHSD"} is selected, \code{gammaA} needs to be specified. If an alpha spending approach was specified (\code{"asOF"}, \code{"asP"}, \code{"asKD"}, \code{"asHSD"}, or \code{"asUser"}) additionally a beta spending function can be specified to produce futility bounds. For optimum designs, \code{"ASNH1"} minimizes the expected sample size under H1, \code{"ASNIFH1"} minimizes the sum of the maximum sample and the expected sample size under H1, and \code{"ASNsum"} minimizes the sum of the maximum sample size, the expected sample size under a value midway H0 and H1, and the expected sample size under H1. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Calculate two-sided critical values for a four-stage # Wang & Tsiatis design with Delta = 0.25 at level alpha = 0.05 getDesignGroupSequential(kMax = 4, sided = 2, typeOfDesign = "WT", deltaWT = 0.25) # Calculate the Pocock type alpha spending critical values if the second # interim analysis was performed after 70\% of the maximum information was observed getDesignGroupSequential(informationRates = c(0.4, 0.7), typeOfDesign = "asP") } \seealso{ \code{\link{getDesignSet}} for creating a set of designs to compare different designs. Other design functions: \code{\link{getDesignCharacteristics}()}, \code{\link{getDesignConditionalDunnett}()}, \code{\link{getDesignFisher}()}, \code{\link{getDesignInverseNormal}()}, \code{\link{getPowerAndAverageSampleNumber}()} } \concept{design functions} rpact/man/param_accrualIntensity.Rd0000644000175000017500000000070714020357215017263 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_accrualIntensity} \alias{param_accrualIntensity} \title{Parameter Description: Accrual Intensity} \arguments{ \item{accrualIntensity}{A vector of accrual intensities, default is the relative intensity \code{0.1} (for details see \code{\link{getAccrualTime}}).} } \description{ Parameter Description: Accrual Intensity } \keyword{internal} rpact/man/getClosedCombinationTestResults.Rd0000644000175000017500000000606414055361410021102 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_analysis_multiarm.R \name{getClosedCombinationTestResults} \alias{getClosedCombinationTestResults} \title{Get Closed Combination Test Results} \usage{ getClosedCombinationTestResults(stageResults) } \arguments{ \item{stageResults}{The results at given stage, obtained from \code{\link{getStageResults}}.} } \value{ Returns a \code{\link{ClosedCombinationTestResults}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.ParameterSet]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Calculates and returns the results from the closed combination test in multi-arm and population enrichment designs. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ \donttest{ # In a four-stage combination test design with O'Brien & Fleming boundaries # at the first stage the second treatment arm was dropped. With the Bonferroni # intersection test, the results of a closed adaptive test procedure are # obtained as follows with the given data (treatment arm 4 refers to the # reference group: data <- getDataset( n1 = c(22, 23), n2 = c(21, NA), n3 = c(20, 25), n4 = c(25, 27), means1 = c(1.63, 1.51), means2 = c(1.4, NA), means3 = c(0.91, 0.95), means4 = c(0.83, 0.75), stds1 = c(1.2, 1.4), stds2 = c(1.3, NA), stds3 = c(1.1, 1.14), stds4 = c(1.02, 1.18)) design <- getDesignInverseNormal(kMax = 4) stageResults <- getStageResults(design, dataInput = data, intersectionTest = "Bonferroni") getClosedCombinationTestResults(stageResults) } } \seealso{ Other analysis functions: \code{\link{getAnalysisResults}()}, \code{\link{getClosedConditionalDunnettTestResults}()}, \code{\link{getConditionalPower}()}, \code{\link{getConditionalRejectionProbabilities}()}, \code{\link{getFinalConfidenceInterval}()}, \code{\link{getFinalPValue}()}, \code{\link{getRepeatedConfidenceIntervals}()}, \code{\link{getRepeatedPValues}()}, \code{\link{getStageResults}()}, \code{\link{getTestActions}()} } \concept{analysis functions} rpact/man/dataRates.Rd0000644000175000017500000000071114102177375014475 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{dataRates} \alias{dataRates} \title{One-Arm Dataset of Rates} \format{ A \code{\link[base]{data.frame}} object. } \usage{ dataRates } \description{ A dataset containing the sample sizes and events of one group. Use \code{getDataset(dataRates)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. } \keyword{datasets} rpact/man/param_effectMeasure.Rd0000644000175000017500000000105614102177376016527 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_effectMeasure} \alias{param_effectMeasure} \title{Parameter Description: Effect Measure} \arguments{ \item{effectMeasure}{Criterion for treatment arm/population selection, either based on test statistic (\code{"testStatistic"}) or effect estimate (difference for means and rates or ratio for survival) (\code{"effectEstimate"}), default is \code{"effectEstimate"}.} } \description{ Parameter Description: Effect Measure } \keyword{internal} rpact/man/NumberOfSubjects.Rd0000644000175000017500000000060314020357214015774 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_event_probabilities.R \docType{class} \name{NumberOfSubjects} \alias{NumberOfSubjects} \title{Number Of Subjects} \description{ Class for the definition of number of subjects results. } \details{ \code{NumberOfSubjects} is a class for the definition of number of subjects results. } \keyword{internal} rpact/man/printCitation.Rd0000644000175000017500000000110214020357214015376 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_core_utilities.R \name{printCitation} \alias{printCitation} \title{Print Citation} \usage{ printCitation(inclusiveR = TRUE) } \arguments{ \item{inclusiveR}{If \code{TRUE} (default) the information on how to cite the base R system in publications will be added.} } \description{ How to cite \code{rpact} and \code{R} in publications. } \details{ This function shows how to cite \code{rpact} and \code{R} (\code{inclusiveR = TRUE}) in publications. } \examples{ printCitation() } \keyword{internal} rpact/man/param_beta.Rd0000644000175000017500000000071214020357215014651 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_beta} \alias{param_beta} \title{Parameter Description: Beta} \arguments{ \item{beta}{Type II error rate, necessary for providing sample size calculations \cr (e.g., \code{\link{getSampleSizeMeans}}), beta spending function designs, or optimum designs, default is \code{0.20}.} } \description{ Parameter Description: Beta } \keyword{internal} rpact/man/param_populations.Rd0000644000175000017500000000057014153377720016327 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_populations} \alias{param_populations} \title{Parameter Description: Populations} \arguments{ \item{populations}{The number of populations in a two-sample comparison, default is \code{3}.} } \description{ Parameter Description: Populations } \keyword{internal} rpact/man/getConditionalPower.Rd0000644000175000017500000001153014153377720016550 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_analysis_base.R \name{getConditionalPower} \alias{getConditionalPower} \title{Get Conditional Power} \usage{ getConditionalPower(stageResults, ..., nPlanned, allocationRatioPlanned = 1) } \arguments{ \item{stageResults}{The results at given stage, obtained from \code{\link{getStageResults}}.} \item{...}{Further (optional) arguments to be passed: \describe{ \item{\code{thetaH1} and \code{assumedStDevs} or \code{piTreatments}, \code{piControl}}{The assumed effect size or assumed rates to calculate the conditional power in multi-arm trials or enrichment designs. For survival designs, \code{thetaH1} refers to the hazard ratio. You can specify a value or a vector with elements referring to the treatment arms or the sub-populations, respectively. For testing means, an assumed standard deviation can be specified, default is \code{1}.} \item{\code{iterations}}{Iterations for simulating the power for Fisher's combination test. If the power for more than one remaining stages is to be determined for Fisher's combination test, it is estimated via simulation with specified \cr \code{iterations}, the default value is \code{10000}.} \item{\code{seed}}{Seed for simulating the power for Fisher's combination test. See above, default is a random seed.} }} \item{nPlanned}{The additional (i.e., "new" and not cumulative) sample size planned for each of the subsequent stages. The argument must be a vector with length equal to the number of remaining stages and contain the combined sample size from both treatment groups if two groups are considered. For survival outcomes, it should contain the planned number of additional events. For multi-arm designs, it is the per-comparison (combined) sample size. For enrichment designs, it is the (combined) sample size for the considered sub-population.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} } \value{ Returns a \code{\link{ConditionalPowerResults}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.ParameterSet]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Calculates and returns the conditional power. } \details{ The conditional power is calculated only if the effect size and the sample size is specified. For Fisher's combination test, the conditional power for more than one remaining stages is estimated via simulation. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ \donttest{ design <- getDesignInverseNormal(kMax = 2) data1 <- getDataset( n = c(20, 30), means = c(50, 51), stDevs = c(130, 140) ) data2 <- getDataset( n1 = c(22, 13, 22, 13), n2 = c(22, 11, 22, 11), means1 = c(1, 1.1, 1, 1), means2 = c(1.4, 1.5, 1, 2.5), stds1 = c(1, 2, 2, 1.3), stds2 = c(1, 2, 2, 1.3)) stageResults <- getStageResults( getDesignGroupSequential(kMax = 4), dataInput = data2, stage = 2, directionUpper = FALSE) getConditionalPower(stageResults, thetaH1 = -0.4, nPlanned = c(64, 64), assumedStDev = 1.5, allocationRatioPlanned = 3) } } \seealso{ \code{\link{plot.StageResults}} or \code{\link{plot.AnalysisResults}} for plotting the conditional power. Other analysis functions: \code{\link{getAnalysisResults}()}, \code{\link{getClosedCombinationTestResults}()}, \code{\link{getClosedConditionalDunnettTestResults}()}, \code{\link{getConditionalRejectionProbabilities}()}, \code{\link{getFinalConfidenceInterval}()}, \code{\link{getFinalPValue}()}, \code{\link{getRepeatedConfidenceIntervals}()}, \code{\link{getRepeatedPValues}()}, \code{\link{getStageResults}()}, \code{\link{getTestActions}()} } \concept{analysis functions} rpact/man/ConditionalPowerResults.Rd0000644000175000017500000000074214020357214017422 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \docType{class} \name{ConditionalPowerResults} \alias{ConditionalPowerResults} \title{Conditional Power Results} \description{ Class for conditional power calculations } \details{ This object cannot be created directly; use \code{\link{getConditionalPower}} with suitable arguments to create the results of a group sequential or a combination test design. } \keyword{internal} rpact/man/SimulationResultsMeans.Rd0000644000175000017500000000057614020357214017257 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R \docType{class} \name{SimulationResultsMeans} \alias{SimulationResultsMeans} \title{Class for Simulation Results Means} \description{ A class for simulation results means. } \details{ Use \code{\link{getSimulationMeans}} to create an object of this type. } \keyword{internal} rpact/man/StageResultsRates.Rd0000644000175000017500000000172114020357214016202 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R \docType{class} \name{StageResultsRates} \alias{StageResultsRates} \title{Stage Results of Rates} \description{ Class for stage results of rates. } \details{ This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of rates. } \section{Fields}{ \describe{ \item{\code{testStatistics}}{The stage-wise test statistics.} \item{\code{pValues}}{The stage-wise p-values.} \item{\code{combInverseNormal}}{The inverse normal test.} \item{\code{combFisher}}{The Fisher's combination test.} \item{\code{effectSizes}}{The effect sizes for different designs.} \item{\code{testActions}}{The action drawn from test result.} \item{\code{weightsFisher}}{The weights for Fisher's combination test.} \item{\code{weightsInverseNormal}}{The weights for inverse normal statistic.} }} \keyword{internal} rpact/man/param_hazardRatio.Rd0000644000175000017500000000077214020357215016214 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_hazardRatio} \alias{param_hazardRatio} \title{Parameter Description: Hazard Ratio} \arguments{ \item{hazardRatio}{The vector of hazard ratios under consideration. If the event or hazard rates in both treatment groups are defined, the hazard ratio needs not to be specified as it is calculated, there is no default.} } \description{ Parameter Description: Hazard Ratio } \keyword{internal} rpact/man/param_maxInformation.Rd0000644000175000017500000000060114046514247016736 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_maxInformation} \alias{param_maxInformation} \title{Parameter Description: Maximum Information} \arguments{ \item{maxInformation}{Positive integer value specifying the maximum information.} } \description{ Parameter Description: Maximum Information } \keyword{internal} rpact/man/param_maxNumberOfEventsPerStage.Rd0000644000175000017500000000115314020357215021001 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_maxNumberOfEventsPerStage} \alias{param_maxNumberOfEventsPerStage} \title{Parameter Description: Max Number Of Events Per Stage} \arguments{ \item{maxNumberOfEventsPerStage}{When performing a data driven sample size recalculation, the vector \code{maxNumberOfEventsPerStage} with length kMax determines the maximum number of events per stage (i.e., not cumulated), the first element is not taken into account.} } \description{ Parameter Description: Max Number Of Events Per Stage } \keyword{internal} rpact/man/setLogLevel.Rd0000644000175000017500000000215114042736407015012 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_core_utilities.R \name{setLogLevel} \alias{setLogLevel} \title{Set Log Level} \usage{ setLogLevel( logLevel = c("PROGRESS", "ERROR", "WARN", "INFO", "DEBUG", "TRACE", "DISABLED") ) } \arguments{ \item{logLevel}{The new log level to set. Can be one of "PROGRESS", "ERROR", "WARN", "INFO", "DEBUG", "TRACE", "DISABLED". Default is "PROGRESS".} } \description{ Sets the \code{rpact} log level. } \details{ This function sets the log level of the \code{rpact} internal log message system. By default only calculation progress messages will be shown on the output console, particularly \code{\link{getAnalysisResults}} shows this kind of messages. The output of these messages can be disabled by setting the log level to \code{"DISABLED"}. } \examples{ \dontrun{ # show debug messages setLogLevel("DEBUG") # disable all log messages setLogLevel("DISABLED") } } \seealso{ \itemize{ \item \code{\link{getLogLevel}} for getting the current log level, \item \code{\link{resetLogLevel}} for resetting the log level to default. } } \keyword{internal} rpact/man/param_maxNumberOfSubjects.Rd0000644000175000017500000000075714020357215017675 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_maxNumberOfSubjects} \alias{param_maxNumberOfSubjects} \title{Parameter Description: Maximum Number Of Subjects} \arguments{ \item{maxNumberOfSubjects}{\code{maxNumberOfSubjects > 0} needs to be specified. For two treatment arms, it is the maximum number of subjects for both treatment arms.} } \description{ Parameter Description: Maximum Number Of Subjects } \keyword{internal} rpact/man/StageResultsSurvival.Rd0000644000175000017500000000175414020357214016745 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R \docType{class} \name{StageResultsSurvival} \alias{StageResultsSurvival} \title{Stage Results of Survival Data} \description{ Class for stage results survival data. } \details{ This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of survival data. } \section{Fields}{ \describe{ \item{\code{testStatistics}}{The stage-wise test statistics.} \item{\code{pValues}}{The stage-wise p-values.} \item{\code{combInverseNormal}}{The inverse normal test.} \item{\code{combFisher}}{The Fisher's combination test.} \item{\code{effectSizes}}{The effect sizes for different designs.} \item{\code{testActions}}{The action drawn from test result.} \item{\code{weightsFisher}}{The weights for Fisher's combination test.} \item{\code{weightsInverseNormal}}{The weights for inverse normal statistic.} }} \keyword{internal} rpact/man/PlotSettings.Rd0000644000175000017500000000321314020357214015213 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_plot_settings.R \docType{class} \name{PlotSettings} \alias{PlotSettings} \title{Plot Settings} \description{ Class for plot settings. } \details{ Collects typical plot settings in an object. } \section{Fields}{ \describe{ \item{\code{lineSize}}{The line size.} \item{\code{pointSize}}{The point size.} \item{\code{pointColor}}{The point color, e.g., "red" or "blue".} \item{\code{mainTitleFontSize}}{The main tile font size.} \item{\code{axesTextFontSize}}{The text font size.} \item{\code{legendFontSize}}{The legend font size.} \item{\code{scalingFactor}}{The scaling factor.} }} \section{Methods}{ \describe{ \item{\code{adjustLegendFontSize(adjustingValue)}}{Adjusts the legend font size, e.g., run \cr \code{adjustLegendFontSize(-2)} # makes the font size 2 points smaller} \item{\code{enlargeAxisTicks(p)}}{Enlarges the axis ticks} \item{\code{expandAxesRange(p, x = NA_real_, y = NA_real_)}}{Expands the axes range} \item{\code{hideGridLines(p)}}{Hides the grid lines} \item{\code{setAxesAppearance(p)}}{Sets the font size and face of the axes titles and texts} \item{\code{setColorPalette(p, palette, mode = c("colour", "fill", "all"))}}{Sets the color palette} \item{\code{setLegendBorder(p)}}{Sets the legend border} \item{\code{setMainTitle(p, mainTitle, subtitle = NA_character_)}}{Sets the main title} \item{\code{setMarginAroundPlot(p, margin = 0.2)}}{Sets the margin around the plot, e.g., run \cr \code{setMarginAroundPlot(p, .2)} or \cr \code{setMarginAroundPlot(p, c(.1, .2, .1, .2)}} \item{\code{setTheme(p)}}{Sets the theme} }} \keyword{internal} rpact/man/ParameterSet_print.Rd0000644000175000017500000000156114020357214016370 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_parameter_set.R \name{ParameterSet_print} \alias{ParameterSet_print} \alias{print.ParameterSet} \title{Print Parameter Set Values} \usage{ \method{print}{ParameterSet}(x, ..., markdown = FALSE) } \arguments{ \item{x}{The \code{\link{ParameterSet}} object to print.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{markdown}{If \code{TRUE}, the object \code{x} will be printed using markdown syntax; normal representation will be used otherwise (default is \code{FALSE})} } \description{ \code{print} prints its \code{ParameterSet} argument and returns it invisibly (via \code{invisible(x)}). } \details{ Prints the parameters and results of a parameter set. } \keyword{internal} rpact/man/getOutputFormat.Rd0000644000175000017500000000542614020357214015735 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_core_output_formats.R \name{getOutputFormat} \alias{getOutputFormat} \title{Get Output Format} \usage{ getOutputFormat( parameterName = NA_character_, ..., file = NA_character_, default = FALSE, fields = TRUE ) } \arguments{ \item{parameterName}{The name of the parameter whose output format shall be returned. Leave the default \code{NA_character_} if the output format of all parameters shall be returned.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{file}{An optional file name where to write the output formats (see Details for more information).} \item{default}{If \code{TRUE} the default output format of the specified parameter(s) will be returned, default is \code{FALSE}.} \item{fields}{If \code{TRUE} the names of all affected object fields will be displayed, default is \code{TRUE}.} } \value{ A named list of output formats. } \description{ With this function the format of the standard outputs of all \code{rpact} objects can be shown and written to a file. } \details{ Output formats can be written to a text file by specifying a \code{file}. See \code{\link{setOutputFormat}}() to learn how to read a formerly saved file. Note that the \code{parameterName} must not match exactly, e.g., for p-values the following parameter names will be recognized amongst others: \enumerate{ \item \code{p value} \item \code{p.values} \item \code{p-value} \item \code{pValue} \item \code{rpact.output.format.p.value} } } \examples{ # show output format of p values getOutputFormat("p.value") \donttest{ # set new p value output format setOutputFormat("p.value", digits = 5, nsmall = 5) # show sample sizes as smallest integers not less than the not rounded values setOutputFormat("sample size", digits = 0, nsmall = 0, roundFunction = "ceiling") getSampleSizeMeans() # show sample sizes as smallest integers not greater than the not rounded values setOutputFormat("sample size", digits = 0, nsmall = 0, roundFunction = "floor") getSampleSizeMeans() # set new sample size output format without round function setOutputFormat("sample size", digits = 2, nsmall = 2) getSampleSizeMeans() # reset sample size output format to default setOutputFormat("sample size") getSampleSizeMeans() getOutputFormat("sample size") # write current output format definitions to file getOutputFormat(file = "rpact_options.txt") # write default output format definitions to file getOutputFormat(file = "rpact_options.txt", default = TRUE) # load and set output format definitions from file setOutputFormat(file = "rpact_options.txt") } } \seealso{ Other output formats: \code{\link{setOutputFormat}()} } \concept{output formats} rpact/man/param_dropoutRate2.Rd0000644000175000017500000000057714020357215016341 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_dropoutRate2} \alias{param_dropoutRate2} \title{Parameter Description: Dropout Rate (2)} \arguments{ \item{dropoutRate2}{The assumed drop-out rate in the control group, default is \code{0}.} } \description{ Parameter Description: Dropout Rate (2) } \keyword{internal} rpact/man/param_conditionalPowerSimulation.Rd0000644000175000017500000000212014020357215021316 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_conditionalPowerSimulation} \alias{param_conditionalPowerSimulation} \title{Parameter Description: Conditional Power} \arguments{ \item{conditionalPower}{If \code{conditionalPower} together with \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (or \code{minNumberOfEventsPerStage} and \code{maxNumberOfEventsPerStage} for survival designs) is specified, a sample size recalculation based on the specified conditional power is performed. It is defined as the power for the subsequent stage given the current data. By default, the conditional power will be calculated under the observed effect size. Optionally, you can also specify \code{thetaH1} and \code{stDevH1} (for simulating means), \code{pi1H1} and \code{pi2H1} (for simulating rates), or \code{thetaH1} (for simulating hazard ratios) as parameters under which it is calculated and the sample size recalculation is performed.} } \description{ Parameter Description: Conditional Power } \keyword{internal} rpact/man/param_includeAllParameters.Rd0000644000175000017500000000077314020357215020045 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_includeAllParameters} \alias{param_includeAllParameters} \title{Parameter Description: Include All Parameters} \arguments{ \item{includeAllParameters}{Logical. If \code{TRUE}, all available parameters will be included in the data frame; a meaningful parameter selection otherwise, default is \code{FALSE}.} } \description{ Parameter Description: Include All Parameters } \keyword{internal} rpact/man/testPackage.Rd0000644000175000017500000000351014046544741015022 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_core_utilities.R \name{testPackage} \alias{testPackage} \title{Test Package} \usage{ testPackage( outDir = ".", ..., completeUnitTestSetEnabled = TRUE, types = "tests", connection = list(token = NULL, secret = NULL) ) } \arguments{ \item{outDir}{The output directory where all test results shall be saved. By default the current working directory is used.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{completeUnitTestSetEnabled}{If \code{TRUE} (default) all existing unit tests will be executed; a subset of all unit tests will be used otherwise.} \item{types}{The type(s) of tests to be done. Can be one or more of \code{c("tests", "examples", "vignettes")}, default is "tests" only.} \item{connection}{A \code{list} where owners of the rpact validation documentation can enter a \code{token} and a \code{secret} to get full access to all unit tests, e.g., to fulfill regulatory requirements (see \href{https://www.rpact.com}{www.rpact.com} for more information).} } \value{ The value of \code{completeUnitTestSetEnabled} will be returned invisible. } \description{ This function allows the installed package \code{rpact} to be tested. } \details{ This function creates the subdirectory \code{rpact-tests} in the specified output directory and copies all unit test files of the package to this newly created directory. Then the function runs all tests (or a subset of all tests if \code{completeUnitTestSetEnabled} is \code{FALSE}) using \code{\link[tools]{testInstalledPackage}}. The test results will be saved to the text file \code{testthat.Rout} that can be found in the subdirectory \code{rpact-tests}. } \examples{ \dontrun{ testPackage() } } rpact/man/getDesignFisher.Rd0000644000175000017500000001074414153377720015650 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_design_fisher_combination_test.R \name{getDesignFisher} \alias{getDesignFisher} \title{Get Design Fisher} \usage{ getDesignFisher( ..., kMax = NA_integer_, alpha = NA_real_, method = c("equalAlpha", "fullAlpha", "noInteraction", "userDefinedAlpha"), userAlphaSpending = NA_real_, alpha0Vec = NA_real_, informationRates = NA_real_, sided = 1, bindingFutility = NA, tolerance = 1e-14, iterations = 0L, seed = NA_real_ ) } \arguments{ \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{kMax}{The maximum number of stages \code{K}. \code{K = 1, 2, 3, ...} (default is \code{3}). The maximum selectable \code{kMax} is \code{20} for group sequential or inverse normal and \code{6} for Fisher combination test designs.} \item{alpha}{The significance level alpha, default is \code{0.025}.} \item{method}{\code{"equalAlpha"}, \code{"fullAlpha"}, \code{"noInteraction"}, or \code{"userDefinedAlpha"}, default is \code{"equalAlpha"} (for details, see Wassmer, 1999).} \item{userAlphaSpending}{The user defined alpha spending. Numeric vector of length \code{kMax} containing the cumulative alpha-spending (Type I error rate) up to each interim stage: \code{0 <= alpha_1 <= ... <= alpha_K <= alpha}.} \item{alpha0Vec}{Stopping for futility bounds for stage-wise p-values.} \item{informationRates}{The information rates (that must be fixed prior to the trial), default is \code{(1:kMax) / kMax}.} \item{sided}{Is the alternative one-sided (\code{1}) or two-sided (\code{2}), default is \code{1}.} \item{bindingFutility}{If \code{bindingFutility = TRUE} is specified the calculation of the critical values is affected by the futility bounds (default is \code{TRUE}).} \item{tolerance}{The numerical tolerance, default is \code{1e-14}.} \item{iterations}{The number of simulation iterations, e.g., \code{getDesignFisher(iterations = 100000)} checks the validity of the critical values for the design. The default value of \code{iterations} is 0, i.e., no simulation will be executed.} \item{seed}{Seed for simulating the power for Fisher's combination test. See above, default is a random seed.} } \value{ Returns a \code{\link{TrialDesign}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.TrialDesign]{plot}} to plot the object, \item \code{\link[=as.data.frame.TrialDesign]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Performs Fisher's combination test and returns critical values for this design. } \details{ \code{getDesignFisher} calculates the critical values and stage levels for Fisher's combination test as described in Bauer (1989), Bauer and Koehne (1994), Bauer and Roehmel (1995), and Wassmer (1999) for equally and unequally sized stages. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Calculate critical values for a two-stage Fisher's combination test # with full level alpha = 0.05 at the final stage and stopping for # futility bound alpha0 = 0.50, as described in Bauer and Koehne (1994). getDesignFisher(kMax = 2, method = "fullAlpha", alpha = 0.05, alpha0Vec = 0.50) } \seealso{ \code{\link{getDesignSet}} for creating a set of designs to compare. Other design functions: \code{\link{getDesignCharacteristics}()}, \code{\link{getDesignConditionalDunnett}()}, \code{\link{getDesignGroupSequential}()}, \code{\link{getDesignInverseNormal}()}, \code{\link{getPowerAndAverageSampleNumber}()} } \concept{design functions} rpact/man/dataMultiArmRates.Rd0000644000175000017500000000075614102177375016161 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{dataMultiArmRates} \alias{dataMultiArmRates} \title{Multi-Arm Dataset of Rates} \format{ A \code{\link[base]{data.frame}} object. } \usage{ dataMultiArmRates } \description{ A dataset containing the sample sizes and events of three groups. Use \code{getDataset(dataMultiArmRates)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. } \keyword{datasets} rpact/man/param_thetaH0.Rd0000644000175000017500000000213114020357215015230 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_thetaH0} \alias{param_thetaH0} \title{Parameter Description: Theta H0} \arguments{ \item{thetaH0}{The null hypothesis value, default is \code{0} for the normal and the binary case (testing means and rates, respectively), it is \code{1} for the survival case (testing the hazard ratio).\cr\cr For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. That is, in case of (one-sided) testing of \itemize{ \item \emph{means}: a value \code{!= 0} (or a value \code{!= 1} for testing the mean ratio) can be specified. \item \emph{rates}: a value \code{!= 0} (or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. \item \emph{survival data}: a bound for testing H0: \code{hazard ratio = thetaH0 != 1} can be specified. } For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for defining the null hypothesis H0: \code{pi = thetaH0}.} } \description{ Parameter Description: Theta H0 } \keyword{internal} rpact/man/param_niceColumnNamesEnabled.Rd0000644000175000017500000000077614020357215020303 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_niceColumnNamesEnabled} \alias{param_niceColumnNamesEnabled} \title{Parameter Description: Nice Column Names Enabled} \arguments{ \item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column names will be used; syntactic names (variable names) otherwise (see \code{\link[base]{make.names}}).} } \description{ Parameter Description: Nice Column Names Enabled } \keyword{internal} rpact/man/param_three_dots_plot.Rd0000644000175000017500000000075514020357215017143 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_three_dots_plot} \alias{param_three_dots_plot} \title{Parameter Description: "..." (optional plot arguments)} \arguments{ \item{...}{Optional plot arguments. At the moment \code{xlim} and \code{ylim} are implemented for changing x or y axis limits without dropping data observations.} } \description{ Parameter Description: "..." (optional plot arguments) } \keyword{internal} rpact/man/AnalysisResultsFisher.Rd0000644000175000017500000000076214020357214017070 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsFisher} \alias{AnalysisResultsFisher} \title{Analysis Results Fisher} \description{ Class for analysis results based on a Fisher combination test design. } \details{ This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the analysis results of a Fisher combination test design. } \keyword{internal} rpact/man/param_digits.Rd0000644000175000017500000000051714020357215015224 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_digits} \alias{param_digits} \title{Parameter Description: Digits} \arguments{ \item{digits}{Defines how many digits are to be used for numeric values.} } \description{ Parameter Description: Digits } \keyword{internal} rpact/man/getSimulationMultiArmRates.Rd0000644000175000017500000003131114153377720020065 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_simulation_multiarm_rates.R \name{getSimulationMultiArmRates} \alias{getSimulationMultiArmRates} \title{Get Simulation Multi-Arm Rates} \usage{ getSimulationMultiArmRates( design = NULL, ..., activeArms = 3L, effectMatrix = NULL, typeOfShape = c("linear", "sigmoidEmax", "userDefined"), piMaxVector = seq(0.2, 0.5, 0.1), piControl = 0.2, gED50 = NA_real_, slope = 1, intersectionTest = c("Dunnett", "Bonferroni", "Simes", "Sidak", "Hierarchical"), directionUpper = TRUE, adaptations = NA, typeOfSelection = c("best", "rBest", "epsilon", "all", "userDefined"), effectMeasure = c("effectEstimate", "testStatistic"), successCriterion = c("all", "atLeastOne"), epsilonValue = NA_real_, rValue = NA_real_, threshold = -Inf, plannedSubjects = NA_real_, allocationRatioPlanned = NA_real_, minNumberOfSubjectsPerStage = NA_real_, maxNumberOfSubjectsPerStage = NA_real_, conditionalPower = NA_real_, piH1 = NA_real_, piControlH1 = NA_real_, maxNumberOfIterations = 1000L, seed = NA_real_, calcSubjectsFunction = NULL, selectArmsFunction = NULL, showStatistics = FALSE ) } \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{activeArms}{The number of active treatment arms to be compared with control, default is \code{3}.} \item{effectMatrix}{Matrix of effect sizes with \code{activeArms} columns and number of rows reflecting the different situations to consider.} \item{typeOfShape}{The shape of the dose-response relationship over the treatment groups. This can be either \code{"linear"}, \code{"sigmoidEmax"}, or \code{"userDefined"}. If \code{"sigmoidEmax"} is selected, \code{"gED50"} and \code{"slope"} has to be entered to specify the ED50 and the slope of the sigmoid Emax model. For \code{"linear"} and \code{"sigmoidEmax"}, \code{"muMaxVector"} specifies the range of effect sizes for the treatment group with highest response. If \code{"userDefined"} is selected, \code{"effectMatrix"} has to be entered.} \item{piMaxVector}{Range of assumed probabilities for the treatment group with highest response for \code{"linear"} and \code{"sigmoidEmax"} model, default is \code{seq(0, 1, 0.2)}.} \item{piControl}{If specified, the assumed probability in the control arm for simulation and under which the sample size recalculation is performed.} \item{gED50}{If \code{typeOfShape = "sigmoidEmax"} is selected, \code{"gED50"} has to be entered to specify the ED50 of the sigmoid Emax model.} \item{slope}{If \code{typeOfShape = "sigmoidEmax"} is selected, \code{"slope"} can be entered to specify the slope of the sigmoid Emax model, default is 1.} \item{intersectionTest}{Defines the multiple test for the intersection hypotheses in the closed system of hypotheses. Five options are available in multi-arm designs: \code{"Dunnett"}, \code{"Bonferroni"}, \code{"Simes"}, \code{"Sidak"}, and \code{"Hierarchical"}, default is \code{"Dunnett"}.} \item{directionUpper}{Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values.} \item{adaptations}{A vector of length \code{kMax - 1} indicating whether or not an adaptation takes place at interim k, default is \code{rep(TRUE, kMax - 1)}.} \item{typeOfSelection}{The way the treatment arms or populations are selected at interim. Five options are available: \code{"best"}, \code{"rbest"}, \code{"epsilon"}, \code{"all"}, and \code{"userDefined"}, default is \code{"best"}.\cr For \code{"rbest"} (select the \code{rValue} best treatment arms/populations), the parameter \code{rValue} has to be specified, for \code{"epsilon"} (select treatment arm/population not worse than epsilon compared to the best), the parameter \code{epsilonValue} has to be specified. If \code{"userDefined"} is selected, \code{"selectArmsFunction"} or \code{"selectPopulationsFunction"} has to be specified.} \item{effectMeasure}{Criterion for treatment arm/population selection, either based on test statistic (\code{"testStatistic"}) or effect estimate (difference for means and rates or ratio for survival) (\code{"effectEstimate"}), default is \code{"effectEstimate"}.} \item{successCriterion}{Defines when the study is stopped for efficacy at interim. Two options are available: \code{"all"} stops the trial if the efficacy criterion is fulfilled for all selected treatment arms/populations, \code{"atLeastOne"} stops if at least one of the selected treatment arms/populations is shown to be superior to control at interim, default is \code{"all"}.} \item{epsilonValue}{For \code{typeOfSelection = "epsilon"} (select treatment arm / population not worse than epsilon compared to the best), the parameter \code{epsilonValue} has to be specified.} \item{rValue}{For \code{typeOfSelection = "rbest"} (select the \code{rValue} best treatment arms / populations), the parameter \code{rValue} has to be specified.} \item{threshold}{Selection criterion: treatment arm / population is selected only if \code{effectMeasure} exceeds \code{threshold}, default is \code{-Inf}. \code{threshold} can also be a vector of length \code{activeArms} referring to a separate threshold condition over the treatment arms.} \item{plannedSubjects}{\code{plannedSubjects} is a vector of length \code{kMax} (the number of stages of the design) that determines the number of cumulated (overall) subjects when the interim stages are planned. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs, \code{plannedSubjects} refers to the number of subjects per selected active arm.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} \item{minNumberOfSubjectsPerStage}{When performing a data driven sample size recalculation, the vector \code{minNumberOfSubjectsPerStage} with length kMax determines the minimum number of subjects per stage (i.e., not cumulated), the first element is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs \code{minNumberOfSubjectsPerStage} refers to the minimum number of subjects per selected active arm.} \item{maxNumberOfSubjectsPerStage}{When performing a data driven sample size recalculation, the vector \code{maxNumberOfSubjectsPerStage} with length kMax determines the maximum number of subjects per stage (i.e., not cumulated), the first element is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs \code{maxNumberOfSubjectsPerStage} refers to the maximum number of subjects per selected active arm.} \item{conditionalPower}{If \code{conditionalPower} together with \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (or \code{minNumberOfEventsPerStage} and \code{maxNumberOfEventsPerStage} for survival designs) is specified, a sample size recalculation based on the specified conditional power is performed. It is defined as the power for the subsequent stage given the current data. By default, the conditional power will be calculated under the observed effect size. Optionally, you can also specify \code{thetaH1} and \code{stDevH1} (for simulating means), \code{pi1H1} and \code{pi2H1} (for simulating rates), or \code{thetaH1} (for simulating hazard ratios) as parameters under which it is calculated and the sample size recalculation is performed.} \item{piH1}{If specified, the assumed probability in the active treatment arm(s) under which the sample size recalculation is performed.} \item{piControlH1}{If specified, the assumed probability in the reference group (if different from \code{piControl}) for which the conditional power was calculated.} \item{maxNumberOfIterations}{The number of simulation iterations, default is \code{1000}.} \item{seed}{The seed to reproduce the simulation, default is a random seed.} \item{calcSubjectsFunction}{Optionally, a function can be entered that defines the way of performing the sample size recalculation. By default, sample size recalculation is performed with conditional power with specified \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (see details and examples).} \item{selectArmsFunction}{Optionally, a function can be entered that defines the way of how treatment arms are selected. This function is allowed to depend on \code{effectVector} with length \code{activeArms} and \code{stage} (see examples).} \item{showStatistics}{If \code{TRUE}, summary statistics of the simulated data are displayed for the \code{print} command, otherwise the output is suppressed, default is \code{FALSE}.} } \value{ Returns a \code{\link{SimulationResults}} object. The following generics (R generic functions) are available for this object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.SimulationResults]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the simulated power, stopping and selection probabilities, conditional power, and expected sample size for testing rates in a multi-arm treatment groups testing situation. } \details{ At given design the function simulates the power, stopping probabilities, selection probabilities, and expected sample size at given number of subjects, parameter configuration, and treatment arm selection rule in the multi-arm situation. An allocation ratio can be specified referring to the ratio of number of subjects in the active treatment groups as compared to the control group. The definition of \code{pi1H1} and/or \code{piControl} makes only sense if \code{kMax} > 1 and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and \code{maxNumberOfSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. \code{calcSubjectsFunction}\cr This function returns the number of subjects at given conditional power and conditional critical value for specified testing situation. The function might depend on the variables \code{stage}, \code{selectedArms}, \code{directionUpper}, \code{plannedSubjects}, \code{allocationRatioPlanned}, \code{minNumberOfSubjectsPerStage}, \code{maxNumberOfSubjectsPerStage}, \code{conditionalPower}, \code{conditionalCriticalValue}, \code{overallRates}, \code{overallRatesControl}, \code{piH1}, and \code{piControlH1}. The function has to contain the three-dots argument '...' (see examples). } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ \donttest{ # Simulate the power of the combination test with two interim stages and # O'Brien & Fleming boundaries using Dunnett's intersection tests if the # best treatment arm is selected at first interim. Selection only take # place if a non-negative treatment effect is observed (threshold = 0); # 20 subjects per stage and treatment arm, simulation is performed for # four parameter configurations. maxNumberOfIterations <- 50 designIN <- getDesignInverseNormal(typeOfDesign = "OF") effectMatrix <- matrix(c(0.2,0.2,0.2, 0.4,0.4,0.4, 0.4,0.5,0.5, 0.4,0.5,0.6), byrow = TRUE, nrow = 4, ncol = 3) x <- getSimulationMultiArmRates(design = designIN, typeOfShape = "userDefined", effectMatrix = effectMatrix , piControl = 0.2, typeOfSelection = "best", threshold = 0, intersectionTest = "Dunnett", plannedSubjects = c(20, 40, 60), maxNumberOfIterations = maxNumberOfIterations) summary(x) } } rpact/man/getNumberOfSubjects.Rd0000644000175000017500000000653714153377720016523 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_design_sample_size_calculator.R \name{getNumberOfSubjects} \alias{getNumberOfSubjects} \title{Get Number Of Subjects} \usage{ getNumberOfSubjects( time, ..., accrualTime = c(0L, 12L), accrualIntensity = 0.1, accrualIntensityType = c("auto", "absolute", "relative"), maxNumberOfSubjects = NA_real_ ) } \arguments{ \item{time}{A numeric vector with time values.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{accrualTime}{The assumed accrual time intervals for the study, default is \code{c(0, 12)} (for details see \code{\link{getAccrualTime}}).} \item{accrualIntensity}{A vector of accrual intensities, default is the relative intensity \code{0.1} (for details see \code{\link{getAccrualTime}}).} \item{accrualIntensityType}{A character value specifying the accrual intensity input type. Must be one of \code{"auto"}, \code{"absolute"}, or \code{"relative"}; default is \code{"auto"}, i.e., if all values are < 1 the type is \code{"relative"}, otherwise it is \code{"absolute"}.} \item{maxNumberOfSubjects}{If \code{maxNumberOfSubjects > 0} is specified, the end of accrual at specified \code{accrualIntensity} for the specified number of subjects is determined or \code{accrualIntensity} is calculated at fixed end of accrual.} } \value{ Returns a \code{\link{NumberOfSubjects}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.NumberOfSubjects]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the number of recruited subjects at given time vector. } \details{ Calculate number of subjects over time range at given accrual time vector and accrual intensity. Intensity can either be defined in absolute or relative terms (for the latter, \code{maxNumberOfSubjects} needs to be defined)\cr The function is used by \code{\link{getSampleSizeSurvival}}. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ getNumberOfSubjects(time = seq(10, 70, 10), accrualTime = c(0, 20, 60), accrualIntensity = c(5, 20)) getNumberOfSubjects(time = seq(10, 70, 10), accrualTime = c(0, 20, 60), accrualIntensity = c(0.1, 0.4), maxNumberOfSubjects = 900) } \seealso{ \code{\link{AccrualTime}} for defining the accrual time. } rpact/man/param_kappa.Rd0000644000175000017500000000206114060361011015022 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_kappa} \alias{param_kappa} \title{Parameter Description: Kappa} \arguments{ \item{kappa}{A numeric value > 0. A \code{kappa != 1} will be used for the specification of the shape of the Weibull distribution. Default is \code{1}, i.e., the exponential survival distribution is used instead of the Weibull distribution. Note that the Weibull distribution cannot be used for the piecewise definition of the survival time distribution, i.e., only \code{piecewiselambda} (as a single value) and \code{kappa} can be specified. This function is equivalent to \code{pweibull(t, shape = kappa, scale = 1 / lambda)} of the \code{stats} package, i.e., the scale parameter is \code{1 / 'hazard rate'}.\cr For example, \code{getPiecewiseExponentialDistribution(time = 130, piecewiseLambda = 0.01, kappa = 4.2)} and \code{pweibull(q = 130, shape = 4.2, scale = 1 / 0.01)} provide the sample result.} } \description{ Parameter Description: Kappa } \keyword{internal} rpact/man/getFinalPValue.Rd0000644000175000017500000000300014153377720015427 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_analysis_base.R \name{getFinalPValue} \alias{getFinalPValue} \title{Get Final P Value} \usage{ getFinalPValue(stageResults, ...) } \arguments{ \item{stageResults}{The results at given stage, obtained from \code{\link{getStageResults}}.} \item{...}{Only available for backward compatibility.} } \value{ Returns a \code{\link[base]{list}} containing \itemize{ \item \code{finalStage}, \item \code{pFinal}. } } \description{ Returns the final p-value for given stage results. } \details{ The calculation of the final p-value is based on the stage-wise ordering of the sample space. This enables the calculation for both the non-adaptive and the adaptive case. For Fisher's combination test, it is available for \code{kMax = 2} only. } \examples{ \donttest{ design <- getDesignInverseNormal(kMax = 2) data <- getDataset( n = c( 20, 30), means = c( 50, 51), stDevs = c(130, 140) ) getFinalPValue(getStageResults(design, dataInput = data)) } } \seealso{ Other analysis functions: \code{\link{getAnalysisResults}()}, \code{\link{getClosedCombinationTestResults}()}, \code{\link{getClosedConditionalDunnettTestResults}()}, \code{\link{getConditionalPower}()}, \code{\link{getConditionalRejectionProbabilities}()}, \code{\link{getFinalConfidenceInterval}()}, \code{\link{getRepeatedConfidenceIntervals}()}, \code{\link{getRepeatedPValues}()}, \code{\link{getStageResults}()}, \code{\link{getTestActions}()} } \concept{analysis functions} rpact/man/getRawData.Rd0000644000175000017500000000474214020357214014607 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R \name{getRawData} \alias{getRawData} \title{Get Simulation Raw Data for Survival} \usage{ getRawData(x, aggregate = FALSE) } \arguments{ \item{x}{An \code{\link{SimulationResults}} object created by \code{\link{getSimulationSurvival}}.} \item{aggregate}{Logical. If \code{TRUE} the raw data will be aggregated similar to the result of \code{\link{getData}}, default is \code{FALSE}.} } \value{ Returns a \code{\link[base]{data.frame}}. } \description{ Returns the raw survival data which was generated for simulation. } \details{ This function works only if \code{\link{getSimulationSurvival}} was called with a \cr \code{maxNumberOfRawDatasetsPerStage} > 0 (default is \code{0}). This function can be used to get the simulated raw data from a simulation results object obtained by \code{\link{getSimulationSurvival}}. Note that \code{\link{getSimulationSurvival}} must called before with \code{maxNumberOfRawDatasetsPerStage} > 0. The data frame contains the following columns: \enumerate{ \item \code{iterationNumber}: The number of the simulation iteration. \item \code{stopStage}: The stage of stopping. \item \code{subjectId}: The subject id (increasing number 1, 2, 3, ...) \item \code{accrualTime}: The accrual time, i.e., the time when the subject entered the trial. \item \code{treatmentGroup}: The treatment group number (1 or 2). \item \code{survivalTime}: The survival time of the subject. \item \code{dropoutTime}: The dropout time of the subject (may be \code{NA}). \item \code{observationTime}: The specific observation time. \item \code{timeUnderObservation}: The time under observation is defined as follows:\cr if (event == TRUE) {\cr timeUnderObservation <- survivalTime;\cr } else if (dropoutEvent == TRUE) {\cr timeUnderObservation <- dropoutTime;\cr } else {\cr timeUnderObservation <- observationTime - accrualTime;\cr } \item \code{event}: \code{TRUE} if an event occurred; \code{FALSE} otherwise. \item \code{dropoutEvent}: \code{TRUE} if an dropout event occurred; \code{FALSE} otherwise. } } \examples{ \donttest{ results <- getSimulationSurvival(pi1 = seq(0.3,0.6,0.1), pi2 = 0.3, eventTime = 12, accrualTime = 24, plannedEvents = 40, maxNumberOfSubjects = 200, maxNumberOfIterations = 50, maxNumberOfRawDatasetsPerStage = 5) rawData <- getRawData(results) head(rawData) dim(rawData) } } rpact/man/TrialDesignSet_length.Rd0000644000175000017500000000140314020357214016775 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_set.R \name{TrialDesignSet_length} \alias{TrialDesignSet_length} \alias{length.TrialDesignSet} \title{Length of Trial Design Set} \usage{ \method{length}{TrialDesignSet}(x) } \arguments{ \item{x}{A \code{\link{TrialDesignSet}} object.} } \value{ Returns a non-negative \code{\link[base]{integer}} of length 1 representing the number of design in the \code{TrialDesignSet}. } \description{ Returns the number of designs in a \code{TrialDesignSet}. } \details{ Is helpful for iteration over all designs in a design set with "[index]"-syntax. } \examples{ designSet <- getDesignSet(design = getDesignGroupSequential(), alpha = c(0.01, 0.05)) length(designSet) } \keyword{internal} rpact/man/TrialDesign_as.data.frame.Rd0000644000175000017500000000237214020357214017452 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R \name{TrialDesign_as.data.frame} \alias{TrialDesign_as.data.frame} \alias{as.data.frame.TrialDesign} \title{Coerce TrialDesign to a Data Frame} \usage{ \method{as.data.frame}{TrialDesign}( x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ... ) } \arguments{ \item{x}{A \code{\link{TrialDesign}} object.} \item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column names will be used; syntactic names (variable names) otherwise (see \code{\link[base]{make.names}}).} \item{includeAllParameters}{Logical. If \code{TRUE}, all available parameters will be included in the data frame; a meaningful parameter selection otherwise, default is \code{FALSE}.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} } \value{ Returns a \code{\link[base]{data.frame}}. } \description{ Returns the \code{TrialDesign} as data frame. } \details{ Each element of the \code{\link{TrialDesign}} is converted to a column in the data frame. } \examples{ as.data.frame(getDesignGroupSequential()) } \keyword{internal} rpact/man/TrialDesignPlanSurvival.Rd0000644000175000017500000000071214020357214017331 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_plan.R \docType{class} \name{TrialDesignPlanSurvival} \alias{TrialDesignPlanSurvival} \title{Trial Design Plan Survival} \description{ Trial design plan for survival data. } \details{ This object cannot be created directly; use \code{\link{getSampleSizeSurvival}} with suitable arguments to create a design plan for a dataset of survival data. } \keyword{internal} rpact/man/param_seed.Rd0000644000175000017500000000051214020357215014654 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_seed} \alias{param_seed} \title{Parameter Description: Seed} \arguments{ \item{seed}{The seed to reproduce the simulation, default is a random seed.} } \description{ Parameter Description: Seed } \keyword{internal} rpact/man/param_design_with_default.Rd0000644000175000017500000000111314020357215017742 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_design_with_default} \alias{param_design_with_default} \title{Parameter Description: Design with Default} \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} } \description{ Parameter Description: Design with Default } \keyword{internal} rpact/man/SimulationResults_print.Rd0000644000175000017500000000167014026041554017506 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R \name{SimulationResults_print} \alias{SimulationResults_print} \alias{print.SimulationResults} \title{Print Simulation Results} \usage{ \method{print}{SimulationResults}(x, ..., showStatistics = FALSE, markdown = FALSE) } \arguments{ \item{x}{The \code{\link{SimulationResults}} object to print.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{markdown}{If \code{TRUE}, the object \code{x} will be printed using markdown syntax; normal representation will be used otherwise (default is \code{FALSE})} } \description{ \code{print} prints its \code{SimulationResults} argument and returns it invisibly (via \code{invisible(x)}). } \details{ Prints the parameters and results of an \code{SimulationResults} object. } \keyword{internal} rpact/man/getDesignConditionalDunnett.Rd0000644000175000017500000000563314060361010020214 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R \name{getDesignConditionalDunnett} \alias{getDesignConditionalDunnett} \title{Get Design Conditional Dunnett Test} \usage{ getDesignConditionalDunnett( alpha = 0.025, informationAtInterim = 0.5, secondStageConditioning = TRUE ) } \arguments{ \item{alpha}{The significance level alpha, default is \code{0.025}.} \item{informationAtInterim}{The information to be expected at interim, default is \code{informationAtInterim = 0.5}.} \item{secondStageConditioning}{The way the second stage p-values are calculated within the closed system of hypotheses. If \code{secondStageConditioning = FALSE} is specified, the unconditional adjusted p-values are used, otherwise conditional adjusted p-values are calculated, default is \code{secondStageConditioning = TRUE} (for details, see Koenig et al., 2008).} } \value{ Returns a \code{\link{TrialDesign}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.TrialDesign]{plot}} to plot the object, \item \code{\link[=as.data.frame.TrialDesign]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Defines the design to perform an analysis with the conditional Dunnett test. } \details{ For performing the conditional Dunnett test the design must be defined through this function. You can define the information fraction and the way of how to compute the second stage p-values only in the design definition, and not in the analysis call.\cr See \code{\link{getClosedConditionalDunnettTestResults}} for an example and Koenig et al. (2008) and Wassmer & Brannath (2016), chapter 11 for details of the test procedure. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \seealso{ Other design functions: \code{\link{getDesignCharacteristics}()}, \code{\link{getDesignFisher}()}, \code{\link{getDesignGroupSequential}()}, \code{\link{getDesignInverseNormal}()}, \code{\link{getPowerAndAverageSampleNumber}()} } \concept{design functions} rpact/man/TrialDesignFisher.Rd0000644000175000017500000000077614020357214016135 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R \docType{class} \name{TrialDesignFisher} \alias{TrialDesignFisher} \title{Fisher Design} \description{ Trial design for Fisher's combination test. } \details{ This object should not be created directly; use \code{\link{getDesignFisher}} with suitable arguments to create a Fisher combination test design. } \seealso{ \code{\link{getDesignFisher}} for creating a Fisher combination test design. } \keyword{internal} rpact/man/getDesignSet.Rd0000644000175000017500000000613514060361011015141 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_set.R \name{getDesignSet} \alias{getDesignSet} \title{Get Design Set} \usage{ getDesignSet(...) } \arguments{ \item{...}{\code{designs} or \code{design} and one or more design parameters, e.g., \code{deltaWT = c(0.1, 0.3, 0.4)}. \itemize{ \item \code{design} The master design (optional, you need to specify an additional parameter that shall be varied). \item \code{designs} The designs to compare (optional, you need to specify the variable \code{variedParameters}). }} } \value{ Returns a \code{\link{TrialDesignSet}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.TrialDesignSet]{names}} to obtain the field names, \item \code{\link[=length.TrialDesignSet]{length}} to obtain the number of design, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.TrialDesignSet]{summary}} to display a summary of the object, \item \code{\link[=plot.TrialDesignSet]{plot}} to plot the object, \item \code{\link[=as.data.frame.TrialDesignSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Creates a trial design set object and returns it. } \details{ Specify a master design and one or more design parameters or a list of designs. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Example 1 design <- getDesignGroupSequential(alpha = 0.05, kMax = 6, sided = 2, typeOfDesign = "WT", deltaWT = 0.1) designSet <- getDesignSet() designSet$add(design = design, deltaWT = c(0.3, 0.4)) \donttest{ if (require(ggplot2)) plot(designSet, type = 1) } # Example 2 (shorter script) design <- getDesignGroupSequential(alpha = 0.05, kMax = 6, sided = 2, typeOfDesign = "WT", deltaWT = 0.1) designSet <- getDesignSet(design = design, deltaWT = c(0.3, 0.4)) \donttest{ if (require(ggplot2)) plot(designSet, type = 1) } # Example 3 (use of designs instead of design) d1 <- getDesignGroupSequential(alpha = 0.05, kMax = 2, sided = 1, beta = 0.2, typeOfDesign = "asHSD", gammaA = 0.5, typeBetaSpending = "bsHSD", gammaB = 0.5) d2 <- getDesignGroupSequential(alpha = 0.05, kMax = 4, sided = 1, beta = 0.2, typeOfDesign = "asP", typeBetaSpending = "bsP") designSet <- getDesignSet (designs = c(d1, d2), variedParameters = c("typeOfDesign", "kMax")) \donttest{ if (require(ggplot2)) plot(designSet, type = 8, nMax = 20) } } rpact/man/resetLogLevel.Rd0000644000175000017500000000116314020357214015332 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_core_utilities.R \name{resetLogLevel} \alias{resetLogLevel} \title{Reset Log Level} \usage{ resetLogLevel() } \description{ Resets the \code{rpact} log level. } \details{ This function resets the log level of the \code{rpact} internal log message system to the default value \code{"PROGRESS"}. } \examples{ \dontrun{ # reset log level to default value resetLogLevel() } } \seealso{ \itemize{ \item \code{\link{getLogLevel}} for getting the current log level, \item \code{\link{setLogLevel}} for setting the log level. } } \keyword{internal} rpact/man/getSimulationEnrichmentMeans.Rd0000644000175000017500000003151414153377720020421 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_simulation_enrichment_means.R \name{getSimulationEnrichmentMeans} \alias{getSimulationEnrichmentMeans} \title{Get Simulation Enrichment Means} \usage{ getSimulationEnrichmentMeans( design = NULL, ..., populations = NA_integer_, effectList = NULL, intersectionTest = c("Simes", "SpiessensDebois", "Bonferroni", "Sidak"), stratifiedAnalysis = TRUE, adaptations = NA, typeOfSelection = c("best", "rBest", "epsilon", "all", "userDefined"), effectMeasure = c("effectEstimate", "testStatistic"), successCriterion = c("all", "atLeastOne"), epsilonValue = NA_real_, rValue = NA_real_, threshold = -Inf, plannedSubjects = NA_integer_, allocationRatioPlanned = NA_real_, minNumberOfSubjectsPerStage = NA_real_, maxNumberOfSubjectsPerStage = NA_real_, conditionalPower = NA_real_, thetaH1 = NA_real_, stDevH1 = NA_real_, maxNumberOfIterations = 1000L, seed = NA_real_, calcSubjectsFunction = NULL, selectPopulationsFunction = NULL, showStatistics = FALSE ) } \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{populations}{The number of populations in a two-sample comparison, default is \code{3}.} \item{effectList}{List of effect sizes with columns and number of rows reflecting the different situations to consider (see examples).} \item{intersectionTest}{Defines the multiple test for the intersection hypotheses in the closed system of hypotheses. Four options are available in enrichment designs: \code{"SpiessensDebois"}, \code{"Bonferroni"}, \code{"Simes"}, and \code{"Sidak"}, default is \code{"Simes"}.} \item{stratifiedAnalysis}{For enrichment designs, typically a stratified analysis should be chosen. For testing rates, also a non-stratified analysis based on overall data can be performed. For survival data, only a stratified analysis is possible (see Brannath et al., 2009), default is \code{TRUE}.} \item{adaptations}{A vector of length \code{kMax - 1} indicating whether or not an adaptation takes place at interim k, default is \code{rep(TRUE, kMax - 1)}.} \item{typeOfSelection}{The way the treatment arms or populations are selected at interim. Five options are available: \code{"best"}, \code{"rbest"}, \code{"epsilon"}, \code{"all"}, and \code{"userDefined"}, default is \code{"best"}.\cr For \code{"rbest"} (select the \code{rValue} best treatment arms/populations), the parameter \code{rValue} has to be specified, for \code{"epsilon"} (select treatment arm/population not worse than epsilon compared to the best), the parameter \code{epsilonValue} has to be specified. If \code{"userDefined"} is selected, \code{"selectArmsFunction"} or \code{"selectPopulationsFunction"} has to be specified.} \item{effectMeasure}{Criterion for treatment arm/population selection, either based on test statistic (\code{"testStatistic"}) or effect estimate (difference for means and rates or ratio for survival) (\code{"effectEstimate"}), default is \code{"effectEstimate"}.} \item{successCriterion}{Defines when the study is stopped for efficacy at interim. Two options are available: \code{"all"} stops the trial if the efficacy criterion is fulfilled for all selected treatment arms/populations, \code{"atLeastOne"} stops if at least one of the selected treatment arms/populations is shown to be superior to control at interim, default is \code{"all"}.} \item{epsilonValue}{For \code{typeOfSelection = "epsilon"} (select treatment arm / population not worse than epsilon compared to the best), the parameter \code{epsilonValue} has to be specified.} \item{rValue}{For \code{typeOfSelection = "rbest"} (select the \code{rValue} best treatment arms / populations), the parameter \code{rValue} has to be specified.} \item{threshold}{Selection criterion: treatment arm / population is selected only if \code{effectMeasure} exceeds \code{threshold}, default is \code{-Inf}. \code{threshold} can also be a vector of length \code{activeArms} referring to a separate threshold condition over the treatment arms.} \item{plannedSubjects}{\code{plannedSubjects} is a vector of length \code{kMax} (the number of stages of the design) that determines the number of cumulated (overall) subjects when the interim stages are planned. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs, \code{plannedSubjects} refers to the number of subjects per selected active arm.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} \item{minNumberOfSubjectsPerStage}{When performing a data driven sample size recalculation, the vector \code{minNumberOfSubjectsPerStage} with length kMax determines the minimum number of subjects per stage (i.e., not cumulated), the first element is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs \code{minNumberOfSubjectsPerStage} refers to the minimum number of subjects per selected active arm.} \item{maxNumberOfSubjectsPerStage}{When performing a data driven sample size recalculation, the vector \code{maxNumberOfSubjectsPerStage} with length kMax determines the maximum number of subjects per stage (i.e., not cumulated), the first element is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs \code{maxNumberOfSubjectsPerStage} refers to the maximum number of subjects per selected active arm.} \item{conditionalPower}{If \code{conditionalPower} together with \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (or \code{minNumberOfEventsPerStage} and \code{maxNumberOfEventsPerStage} for survival designs) is specified, a sample size recalculation based on the specified conditional power is performed. It is defined as the power for the subsequent stage given the current data. By default, the conditional power will be calculated under the observed effect size. Optionally, you can also specify \code{thetaH1} and \code{stDevH1} (for simulating means), \code{pi1H1} and \code{pi2H1} (for simulating rates), or \code{thetaH1} (for simulating hazard ratios) as parameters under which it is calculated and the sample size recalculation is performed.} \item{thetaH1}{If specified, the value of the alternative under which the conditional power or sample size recalculation calculation is performed.} \item{stDevH1}{If specified, the value of the standard deviation under which the conditional power or sample size recalculation calculation is performed, default is the value of \code{stDev}.} \item{maxNumberOfIterations}{The number of simulation iterations, default is \code{1000}.} \item{seed}{The seed to reproduce the simulation, default is a random seed.} \item{calcSubjectsFunction}{Optionally, a function can be entered that defines the way of performing the sample size recalculation. By default, sample size recalculation is performed with conditional power with specified \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (see details and examples).} \item{selectPopulationsFunction}{Optionally, a function can be entered that defines the way of how populations are selected. This function is allowed to depend on \code{effectVector} with length \code{populations} and \code{stage} (see examples).} \item{showStatistics}{If \code{TRUE}, summary statistics of the simulated data are displayed for the \code{print} command, otherwise the output is suppressed, default is \code{FALSE}.} } \value{ Returns a \code{\link{SimulationResults}} object. The following generics (R generic functions) are available for this object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.SimulationResults]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the simulated power, stopping and selection probabilities, conditional power, and expected sample size or testing means in an enrichment design testing situation. } \details{ At given design the function simulates the power, stopping probabilities, selection probabilities, and expected sample size at given number of subjects, parameter configuration, and population selection rule in the enrichment situation. An allocation ratio can be specified referring to the ratio of number of subjects in the active treatment groups as compared to the control group. The definition of \code{thetaH1} and/or \code{stDevH1} makes only sense if \code{kMax} > 1 and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and \code{maxNumberOfSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. \code{calcSubjectsFunction}\cr This function returns the number of subjects at given conditional power and conditional critical value for specified testing situation. The function might depend on the variables \code{stage}, \code{selectedPopulations}, \code{plannedSubjects}, \code{allocationRatioPlanned}, \code{minNumberOfSubjectsPerStage}, \code{maxNumberOfSubjectsPerStage}, \code{conditionalPower}, \code{conditionalCriticalValue}, \code{overallEffects}, and \code{stDevH1}. The function has to contain the three-dots argument '...' (see examples). } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ \donttest{ # Assess a population selection strategy with one subset population. # If the subset is better than the full population, then the subset # is selected for the second stage, otherwise the full. Print and plot # design characteristics. # Define design ds <- getDesignInverseNormal(kMax = 2) # Define subgroups and their prevalences subGroups <- c("S", "R") # fixed names! prevalences <- c(0.2, 0.8) # Define effect matrix and variability effectR <- 0.2 m <- c() for (effectS in seq(0, 0.5, 0.25)){ m <- c(m, effectS, effectR) } effects <- matrix(m, byrow = TRUE, ncol = 2) stDev <- c(0.4, 0.8) # Define effect list el <- list(subGroups=subGroups, prevalences=prevalences, stDevs = stDev, effects = effects) # Perform simulation simResultsPE <- getSimulationEnrichmentMeans(design = ds, effectList = el, plannedSubjects = c(50, 100), maxNumberOfIterations = 100) print(simResultsPE) # Assess the design characteristics of a user defined selection # strategy in a two-stage design with no interim efficacy stop # using the inverse normal method for combining the stages. # Only the second interim is used for a selecting of a study # population. There is a small probability for stopping the trial # at the first interim. # Define design ds <- getDesignInverseNormal(typeOfDesign = "asOF", kMax = 3) # Define selection function mySelection <- function(effectVector, stage) { selectedPopulations <- rep(TRUE, 3) if (stage == 2){ selectedPopulations <- (effectVector >= c(1, 2, 3)) } return(selectedPopulations) } # Define subgroups and their prevalences subGroups <- c("S1", "S12", "S2", "R") # fixed names! prevalences <- c(0.2, 0.3, 0.4, 0.1) effectR <- 1.5 effectS12 = 5 m <- c() for (effectS1 in seq(0, 5, 1)){ for (effectS2 in seq(0, 5, 1)){ m <- c(m, effectS1, effectS12, effectS2, effectR) } } effects <- matrix(m, byrow = TRUE, ncol = 4) stDev <- 10 # Define effect list el <- list(subGroups=subGroups, prevalences=prevalences, stDevs = stDev, effects = effects) # Perform simulation simResultsPE <- getSimulationEnrichmentMeans(design = ds, effectList = el, typeOfSelection = "userDefined", selectPopulationsFunction = mySelection, intersectionTest = "Simes", plannedSubjects = c(50, 100, 150), maxNumberOfIterations = 100) print(simResultsPE) plot(simResultsPE, type = 3) } } rpact/man/getRepeatedPValues.Rd0000644000175000017500000000463214153377720016326 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_analysis_base.R \name{getRepeatedPValues} \alias{getRepeatedPValues} \title{Get Repeated P Values} \usage{ getRepeatedPValues(stageResults, ..., tolerance = 1e-06) } \arguments{ \item{stageResults}{The results at given stage, obtained from \code{\link{getStageResults}}.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{tolerance}{The numerical tolerance, default is \code{1e-06}.} } \value{ Returns a \code{\link[base]{numeric}} vector of length \code{kMax} or in case of multi-arm stage results a \code{\link[base]{matrix}} (each column represents a stage, each row a comparison) containing the repeated p values. } \description{ Calculates the repeated p-values for a given test results. } \details{ The repeated p-value at a given stage of the trial is defined as the smallest significance level under which at given test design the test results obtain rejection of the null hypothesis. It can be calculated at each stage of the trial and can thus be used as a monitoring tool. The repeated p-values are provided up to the specified stage. In multi-arm trials, the repeated p-values are defined separately for each treatment comparison within the closed testing procedure. } \section{Note on the dependency of \code{mnormt}}{ If \code{intersectionTest = "Dunnett"} or \code{intersectionTest = "SpiessensDebois"}, or the design is a conditional Dunnett design and the dataset is a multi-arm or enrichment dataset, \code{rpact} uses the R package \href{https://cran.r-project.org/package=mnormt}{mnormt} to calculate the analysis results. } \examples{ \donttest{ design <- getDesignInverseNormal(kMax = 2) data <- getDataset( n = c( 20, 30), means = c( 50, 51), stDevs = c(130, 140) ) getRepeatedPValues(getStageResults(design, dataInput = data)) } } \seealso{ Other analysis functions: \code{\link{getAnalysisResults}()}, \code{\link{getClosedCombinationTestResults}()}, \code{\link{getClosedConditionalDunnettTestResults}()}, \code{\link{getConditionalPower}()}, \code{\link{getConditionalRejectionProbabilities}()}, \code{\link{getFinalConfidenceInterval}()}, \code{\link{getFinalPValue}()}, \code{\link{getRepeatedConfidenceIntervals}()}, \code{\link{getStageResults}()}, \code{\link{getTestActions}()} } \concept{analysis functions} rpact/man/param_pi1_rates.Rd0000644000175000017500000000117314020357215015627 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_pi1_rates} \alias{param_pi1_rates} \title{Parameter Description: Pi (1) for Rates} \arguments{ \item{pi1}{A numeric value or vector that represents the assumed probability in the active treatment group if two treatment groups are considered, or the alternative probability for a one treatment group design, default is \code{seq(0.2, 0.5, 0.1)} (power calculations and simulations) or \code{seq(0.4, 0.6, 0.1)} (sample size calculations).} } \description{ Parameter Description: Pi (1) for Rates } \keyword{internal} rpact/man/param_minNumberOfEventsPerStage.Rd0000644000175000017500000000115414020357215021000 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_minNumberOfEventsPerStage} \alias{param_minNumberOfEventsPerStage} \title{Parameter Description: Min Number Of Events Per Stage} \arguments{ \item{minNumberOfEventsPerStage}{When performing a data driven sample size recalculation, the vector \code{minNumberOfEventsPerStage} with length kMax determines the minimum number of events per stage (i.e., not cumulated), the first element is not taken into account.} } \description{ Parameter Description: Min Number Of Events Per Stage } \keyword{internal} rpact/man/dataMeans.Rd0000644000175000017500000000073614102177375014471 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{dataMeans} \alias{dataMeans} \title{One-Arm Dataset of Means} \format{ A \code{\link[base]{data.frame}} object. } \usage{ dataMeans } \description{ A dataset containing the sample sizes, means, and standard deviations of one group. Use \code{getDataset(dataMeans)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. } \keyword{datasets} rpact/man/getParameterName.Rd0000644000175000017500000000152714020357214016003 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_core_utilities.R \name{getParameterName} \alias{getParameterName} \title{Get Parameter Name} \usage{ getParameterName(obj, parameterCaption) } \value{ Returns a \code{\link[base]{character}} of specifying the corresponding name of a given parameter caption. Returns \code{NULL} if the specified \code{parameterCaption} does not exist. } \description{ Returns the parameter name for a given object and parameter caption. } \details{ This function identifies and returns the parameter name for a given caption that will be used in print outputs of an rpact result object. } \examples{ getParameterName(getDesignInverseNormal(), "Maximum number of stages") } \seealso{ \code{\link{getParameterCaption}} for getting the parameter caption for a given name. } \keyword{internal} rpact/man/param_grid.Rd0000644000175000017500000000167314020357215014672 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_grid} \alias{param_grid} \title{Parameter Description: Grid (Output Specification Of Multiple Plots)} \arguments{ \item{grid}{An integer value specifying the output of multiple plots. By default (\code{1}) a list of \code{ggplot} objects will be returned. If a \code{grid} value > 1 was specified, a grid plot will be returned if the number of plots is <= specified \code{grid} value; a list of \code{ggplot} objects will be returned otherwise. If \code{grid = 0} is specified, all plots will be created using \code{\link[base]{print}} command and a list of \code{ggplot} objects will be returned invisible. Note that one of the following packages must be installed to create a grid plot: 'ggpubr', 'gridExtra', or 'cowplot'.} } \description{ Parameter Description: Grid (Output Specification Of Multiple Plots) } \keyword{internal} rpact/man/TrialDesign.Rd0000644000175000017500000000070614020357214014765 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R \docType{class} \name{TrialDesign} \alias{TrialDesign} \title{Basic Trial Design} \description{ Basic class for trial designs. } \details{ \code{TrialDesign} is the basic class for \itemize{ \item \code{\link{TrialDesignFisher}}, \item \code{\link{TrialDesignGroupSequential}}, and \item \code{\link{TrialDesignInverseNormal}}. } } \keyword{internal} rpact/man/param_typeOfShape.Rd0000644000175000017500000000151414020357215016166 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_typeOfShape} \alias{param_typeOfShape} \title{Parameter Description: Type Of Shape} \arguments{ \item{typeOfShape}{The shape of the dose-response relationship over the treatment groups. This can be either \code{"linear"}, \code{"sigmoidEmax"}, or \code{"userDefined"}. If \code{"sigmoidEmax"} is selected, \code{"gED50"} and \code{"slope"} has to be entered to specify the ED50 and the slope of the sigmoid Emax model. For \code{"linear"} and \code{"sigmoidEmax"}, \code{"muMaxVector"} specifies the range of effect sizes for the treatment group with highest response. If \code{"userDefined"} is selected, \code{"effectMatrix"} has to be entered.} } \description{ Parameter Description: Type Of Shape } \keyword{internal} rpact/man/param_sided.Rd0000644000175000017500000000054514020357215015032 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_sided} \alias{param_sided} \title{Parameter Description: Sided} \arguments{ \item{sided}{Is the alternative one-sided (\code{1}) or two-sided (\code{2}), default is \code{1}.} } \description{ Parameter Description: Sided } \keyword{internal} rpact/man/getEventProbabilities.Rd0000644000175000017500000001336614153377720017073 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_design_sample_size_calculator.R \name{getEventProbabilities} \alias{getEventProbabilities} \title{Get Event Probabilities} \usage{ getEventProbabilities( time, ..., accrualTime = c(0L, 12L), accrualIntensity = 0.1, accrualIntensityType = c("auto", "absolute", "relative"), kappa = 1, piecewiseSurvivalTime = NA_real_, lambda2 = NA_real_, lambda1 = NA_real_, allocationRatioPlanned = 1, hazardRatio = NA_real_, dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12L, maxNumberOfSubjects = NA_real_ ) } \arguments{ \item{time}{A numeric vector with time values.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{accrualTime}{The assumed accrual time intervals for the study, default is \code{c(0, 12)} (for details see \code{\link{getAccrualTime}}).} \item{accrualIntensity}{A vector of accrual intensities, default is the relative intensity \code{0.1} (for details see \code{\link{getAccrualTime}}).} \item{accrualIntensityType}{A character value specifying the accrual intensity input type. Must be one of \code{"auto"}, \code{"absolute"}, or \code{"relative"}; default is \code{"auto"}, i.e., if all values are < 1 the type is \code{"relative"}, otherwise it is \code{"absolute"}.} \item{kappa}{A numeric value > 0. A \code{kappa != 1} will be used for the specification of the shape of the Weibull distribution. Default is \code{1}, i.e., the exponential survival distribution is used instead of the Weibull distribution. Note that the Weibull distribution cannot be used for the piecewise definition of the survival time distribution, i.e., only \code{piecewiselambda} (as a single value) and \code{kappa} can be specified. This function is equivalent to \code{pweibull(t, shape = kappa, scale = 1 / lambda)} of the \code{stats} package, i.e., the scale parameter is \code{1 / 'hazard rate'}.\cr For example, \code{getPiecewiseExponentialDistribution(time = 130, piecewiseLambda = 0.01, kappa = 4.2)} and \code{pweibull(q = 130, shape = 4.2, scale = 1 / 0.01)} provide the sample result.} \item{piecewiseSurvivalTime}{A vector that specifies the time intervals for the piecewise definition of the exponential survival time cumulative distribution function \cr (for details see \code{\link{getPiecewiseSurvivalTime}}).} \item{lambda2}{The assumed hazard rate in the reference group, there is no default. \code{lambda2} can also be used to define piecewise exponentially distributed survival times (see details).} \item{lambda1}{The assumed hazard rate in the treatment group, there is no default. \code{lambda1} can also be used to define piecewise exponentially distributed survival times (see details).} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. If \code{allocationRatioPlanned = 0} is entered, the optimal allocation ratio yielding the smallest overall sample size is determined.} \item{hazardRatio}{The vector of hazard ratios under consideration. If the event or hazard rates in both treatment groups are defined, the hazard ratio needs not to be specified as it is calculated, there is no default.} \item{dropoutRate1}{The assumed drop-out rate in the treatment group, default is \code{0}.} \item{dropoutRate2}{The assumed drop-out rate in the control group, default is \code{0}.} \item{dropoutTime}{The assumed time for drop-out rates in the control and the treatment group, default is \code{12}.} \item{maxNumberOfSubjects}{If \code{maxNumberOfSubjects > 0} is specified, the end of accrual at specified \code{accrualIntensity} for the specified number of subjects is determined or \code{accrualIntensity} is calculated at fixed end of accrual.} } \value{ Returns a \code{\link{EventProbabilities}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.EventProbabilities]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the event probabilities for specified parameters at given time vector. } \details{ The function computes the overall event probabilities in a two treatment groups design. For details of the parameters see \code{\link{getSampleSizeSurvival}}. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Calculate event probabilities for staggered subjects' entry, piecewisely defined # survival time and hazards, and plot it. timeVector <- seq(0, 100, 1) y <- getEventProbabilities(timeVector, accrualTime = c(0, 20, 60), accrualIntensity = c(5, 20), piecewiseSurvivalTime = c(0, 20, 80), lambda2 = c(0.02, 0.06, 0.1), hazardRatio = 2 ) \donttest{ plot(timeVector, y$overallEventProbabilities, type = 'l') } } rpact/man/getSampleSizeMeans.Rd0000644000175000017500000001321214153377720016327 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_design_sample_size_calculator.R \name{getSampleSizeMeans} \alias{getSampleSizeMeans} \title{Get Sample Size Means} \usage{ getSampleSizeMeans( design = NULL, ..., groups = 2, normalApproximation = FALSE, meanRatio = FALSE, thetaH0 = ifelse(meanRatio, 1, 0), alternative = seq(0.2, 1, 0.2), stDev = 1, allocationRatioPlanned = NA_real_ ) } \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{groups}{The number of treatment groups (1 or 2), default is \code{2}.} \item{normalApproximation}{The type of computation of the p-values. If \code{TRUE}, the variance is assumed to be known, default is \code{FALSE}, i.e., the calculations are performed with the t distribution.} \item{meanRatio}{If \code{TRUE}, the sample size for one-sided testing of H0: \code{mu1 / mu2 = thetaH0} is calculated, default is \code{FALSE}.} \item{thetaH0}{The null hypothesis value, default is \code{0} for the normal and the binary case (testing means and rates, respectively), it is \code{1} for the survival case (testing the hazard ratio).\cr\cr For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. That is, in case of (one-sided) testing of \itemize{ \item \emph{means}: a value \code{!= 0} (or a value \code{!= 1} for testing the mean ratio) can be specified. \item \emph{rates}: a value \code{!= 0} (or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. \item \emph{survival data}: a bound for testing H0: \code{hazard ratio = thetaH0 != 1} can be specified. } For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for defining the null hypothesis H0: \code{pi = thetaH0}.} \item{alternative}{The alternative hypothesis value for testing means. This can be a vector of assumed alternatives, default is \code{seq(0, 1, 0.2)} (power calculations) or \code{seq(0.2, 1, 0.2)} (sample size calculations).} \item{stDev}{The standard deviation under which the sample size or power calculation is performed, default is \code{1}. If \code{meanRatio = TRUE} is specified, \code{stDev} defines the coefficient of variation \code{sigma / mu2}.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. If \code{allocationRatioPlanned = 0} is entered, the optimal allocation ratio yielding the smallest overall sample size is determined.} } \value{ Returns a \code{\link{TrialDesignPlan}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.TrialDesignSet]{summary}} to display a summary of the object, \item \code{\link[=plot.TrialDesignPlan]{plot}} to plot the object, \item \code{\link[=as.data.frame.TrialDesignPlan]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the sample size for testing means in one or two samples. } \details{ At given design the function calculates the stage-wise (non-cumulated) and maximum sample size for testing means. In a two treatment groups design, additionally, an allocation ratio = n1/n2 can be specified. A null hypothesis value thetaH0 != 0 for testing the difference of two means or thetaH0 != 1 for testing the ratio of two means can be specified. Critical bounds and stopping for futility bounds are provided at the effect scale (mean, mean difference, or mean ratio, respectively) for each sample size calculation separately. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Calculate sample sizes in a fixed sample size parallel group design # with allocation ratio \code{n1 / n2 = 2} for a range of # alternative values 1, ..., 5 with assumed standard deviation = 3.5; # two-sided alpha = 0.05, power 1 - beta = 90\%: getSampleSizeMeans(alpha = 0.05, beta = 0.1, sided = 2, groups = 2, alternative = seq(1, 5, 1), stDev = 3.5, allocationRatioPlanned = 2) \donttest{ # Calculate sample sizes in a three-stage Pocock paired comparison design testing # H0: mu = 2 for a range of alternative values 3,4,5 with assumed standard # deviation = 3.5; one-sided alpha = 0.05, power 1 - beta = 90\%: getSampleSizeMeans(getDesignGroupSequential(typeOfDesign = "P", alpha = 0.05, sided = 1, beta = 0.1), groups = 1, thetaH0 = 2, alternative = seq(3, 5, 1), stDev = 3.5) } } \seealso{ Other sample size functions: \code{\link{getSampleSizeRates}()}, \code{\link{getSampleSizeSurvival}()} } \concept{sample size functions} rpact/man/param_accrualIntensityType.Rd0000644000175000017500000000113414020357215020120 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_accrualIntensityType} \alias{param_accrualIntensityType} \title{Parameter Description: Accrual Intensity Type} \arguments{ \item{accrualIntensityType}{A character value specifying the accrual intensity input type. Must be one of \code{"auto"}, \code{"absolute"}, or \code{"relative"}; default is \code{"auto"}, i.e., if all values are < 1 the type is \code{"relative"}, otherwise it is \code{"absolute"}.} } \description{ Parameter Description: Accrual Intensity Type } \keyword{internal} rpact/man/param_bindingFutility.Rd0000644000175000017500000000112014020357215017074 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_bindingFutility} \alias{param_bindingFutility} \title{Parameter Description: Binding Futility} \arguments{ \item{bindingFutility}{If \code{bindingFutility = TRUE} is specified the calculation of the critical values is affected by the futility bounds and the futility threshold is binding in the sense that the study must be stopped if the futility condition was reached (default is \code{FALSE}).} } \description{ Parameter Description: Binding Futility } \keyword{internal} rpact/man/param_selectArmsFunction.Rd0000644000175000017500000000105414060141510017537 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_selectArmsFunction} \alias{param_selectArmsFunction} \title{Parameter Description: Select Arms Function} \arguments{ \item{selectArmsFunction}{Optionally, a function can be entered that defines the way of how treatment arms are selected. This function is allowed to depend on \code{effectVector} with length \code{activeArms} and \code{stage} (see examples).} } \description{ Parameter Description: Select Arms Function } \keyword{internal} rpact/man/param_epsilonValue.Rd0000644000175000017500000000074214142514771016416 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_epsilonValue} \alias{param_epsilonValue} \title{Parameter Description: EpsilonValue} \arguments{ \item{epsilonValue}{For \code{typeOfSelection = "epsilon"} (select treatment arm / population not worse than epsilon compared to the best), the parameter \code{epsilonValue} has to be specified.} } \description{ Parameter Description: EpsilonValue } \keyword{internal} rpact/man/param_allocationRatioPlanned.Rd0000644000175000017500000000105214020357215020362 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_allocationRatioPlanned} \alias{param_allocationRatioPlanned} \title{Parameter Description: Allocation Ratio Planned} \arguments{ \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} } \description{ Parameter Description: Allocation Ratio Planned } \keyword{internal} rpact/man/param_typeOfDesign.Rd0000644000175000017500000000162514153377720016354 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_typeOfDesign} \alias{param_typeOfDesign} \title{Parameter Description: Type of Design} \arguments{ \item{typeOfDesign}{The type of design. Type of design is one of the following: O'Brien & Fleming (\code{"OF"}), Pocock (\code{"P"}), Wang & Tsiatis Delta class (\code{"WT"}), Pampallona & Tsiatis (\code{"PT"}), Haybittle & Peto ("HP"), Optimum design within Wang & Tsiatis class (\code{"WToptimum"}), O'Brien & Fleming type alpha spending (\code{"asOF"}), Pocock type alpha spending (\code{"asP"}), Kim & DeMets alpha spending (\code{"asKD"}), Hwang, Shi & DeCani alpha spending (\code{"asHSD"}), user defined alpha spending (\code{"asUser"}), no early efficacy stop (\code{"noEarlyEfficacy"}), default is \code{"OF"}.} } \description{ Parameter Description: Type of Design } \keyword{internal} rpact/man/getAvailablePlotTypes.Rd0000644000175000017500000000307414020357214017025 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_core_plot.R \name{plotTypes} \alias{plotTypes} \alias{getAvailablePlotTypes} \title{Get Available Plot Types} \usage{ plotTypes( obj, output = c("numeric", "caption", "numcap", "capnum"), numberInCaptionEnabled = FALSE ) getAvailablePlotTypes( obj, output = c("numeric", "caption", "numcap", "capnum"), numberInCaptionEnabled = FALSE ) } \arguments{ \item{obj}{The object for which the plot types shall be identified, e.g. produced by \code{\link{getDesignGroupSequential}} or \code{\link{getSampleSizeMeans}}.} \item{output}{The output type. Can be one of \code{c("numeric", "caption", "numcap", "capnum")}.} \item{numberInCaptionEnabled}{If \code{TRUE}, the number will be added to the caption, default is \code{FALSE}.} } \value{ Depending on how the \code{output} is specified, a numeric vector, a character vector, or a list will be returned. } \description{ Function to identify the available plot types of an object. } \details{ \code{plotTypes} and \code{getAvailablePlotTypes} are equivalent, i.e., \code{plotTypes} is a short form of \code{getAvailablePlotTypes}. \code{output}: \enumerate{ \item \code{numeric}: numeric output \item \code{caption}: caption as character output \item \code{numcap}: list with number and caption \item \code{capnum}: list with caption and number } } \examples{ design <- getDesignInverseNormal(kMax = 2) getAvailablePlotTypes(design, "numeric") plotTypes(design, "caption") getAvailablePlotTypes(design, "numcap") plotTypes(design, "capnum") } rpact/man/getFinalConfidenceInterval.Rd0000644000175000017500000001061414153377720020006 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_analysis_base.R \name{getFinalConfidenceInterval} \alias{getFinalConfidenceInterval} \title{Get Final Confidence Interval} \usage{ getFinalConfidenceInterval( design, dataInput, ..., directionUpper = TRUE, thetaH0 = NA_real_, tolerance = 1e-06, stage = NA_integer_ ) } \arguments{ \item{design}{The trial design.} \item{dataInput}{The summary data used for calculating the test results. This is either an element of \code{DatasetMeans}, of \code{DatasetRates}, or of \code{DatasetSurvival} and should be created with the function \code{getDataset}. For more information see \code{\link{getDataset}}.} \item{...}{Further (optional) arguments to be passed: \describe{ \item{\code{normalApproximation}}{ The type of computation of the p-values. Default is \code{FALSE} for testing means (i.e., the t test is used) and TRUE for testing rates and the hazard ratio. For testing rates, if \code{normalApproximation = FALSE} is specified, the binomial test (one sample) or the exact test of Fisher (two samples) is used for calculating the p-values. In the survival setting, \code{normalApproximation = FALSE} has no effect.} \item{\code{equalVariances}}{The type of t test. For testing means in two treatment groups, either the t test assuming that the variances are equal or the t test without assuming this, i.e., the test of Welch-Satterthwaite is calculated, default is \code{TRUE}.} }} \item{directionUpper}{Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values.} \item{thetaH0}{The null hypothesis value, default is \code{0} for the normal and the binary case (testing means and rates, respectively), it is \code{1} for the survival case (testing the hazard ratio).\cr\cr For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. That is, in case of (one-sided) testing of \itemize{ \item \emph{means}: a value \code{!= 0} (or a value \code{!= 1} for testing the mean ratio) can be specified. \item \emph{rates}: a value \code{!= 0} (or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. \item \emph{survival data}: a bound for testing H0: \code{hazard ratio = thetaH0 != 1} can be specified. } For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for defining the null hypothesis H0: \code{pi = thetaH0}.} \item{tolerance}{The numerical tolerance, default is \code{1e-06}.} \item{stage}{The stage number (optional). Default: total number of existing stages in the data input.} } \value{ Returns a \code{\link[base]{list}} containing \itemize{ \item \code{finalStage}, \item \code{medianUnbiased}, \item \code{finalConfidenceInterval}, \item \code{medianUnbiasedGeneral}, and \item \code{finalConfidenceIntervalGeneral}. } } \description{ Returns the final confidence interval for the parameter of interest. It is based on the prototype case, i.e., the test for testing a mean for normally distributed variables. } \details{ Depending on \code{design} and \code{dataInput} the final confidence interval and median unbiased estimate that is based on the stage-wise ordering of the sample space will be calculated and returned. Additionally, a non-standardized ("general") version is provided, the estimated standard deviation must be used to obtain the confidence interval for the parameter of interest. For the inverse normal combination test design with more than two stages, a warning informs that the validity of the confidence interval is theoretically shown only if no sample size change was performed. } \examples{ \donttest{ design <- getDesignInverseNormal(kMax = 2) data <- getDataset( n = c(20, 30), means = c(50, 51), stDevs = c(130, 140) ) getFinalConfidenceInterval(design, dataInput = data) } } \seealso{ Other analysis functions: \code{\link{getAnalysisResults}()}, \code{\link{getClosedCombinationTestResults}()}, \code{\link{getClosedConditionalDunnettTestResults}()}, \code{\link{getConditionalPower}()}, \code{\link{getConditionalRejectionProbabilities}()}, \code{\link{getFinalPValue}()}, \code{\link{getRepeatedConfidenceIntervals}()}, \code{\link{getRepeatedPValues}()}, \code{\link{getStageResults}()}, \code{\link{getTestActions}()} } \concept{analysis functions} rpact/man/getAccrualTime.Rd0000644000175000017500000001455714020357214015462 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_time.R \name{getAccrualTime} \alias{getAccrualTime} \title{Get Accrual Time} \usage{ getAccrualTime( accrualTime = NA_real_, ..., accrualIntensity = NA_real_, accrualIntensityType = c("auto", "absolute", "relative"), maxNumberOfSubjects = NA_real_ ) } \arguments{ \item{accrualTime}{The assumed accrual time intervals for the study, default is \code{c(0, 12)} (for details see \code{\link{getAccrualTime}}).} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{accrualIntensity}{A vector of accrual intensities, default is the relative intensity \code{0.1} (for details see \code{\link{getAccrualTime}}).} \item{accrualIntensityType}{A character value specifying the accrual intensity input type. Must be one of \code{"auto"}, \code{"absolute"}, or \code{"relative"}; default is \code{"auto"}, i.e., if all values are < 1 the type is \code{"relative"}, otherwise it is \code{"absolute"}.} \item{maxNumberOfSubjects}{The maximum number of subjects.} } \value{ Returns an \code{\link{AccrualTime}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.ParameterSet]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns an \code{AccrualTime} object that contains the accrual time and the accrual intensity. } \section{Staggered patient entry}{ \code{accrualTime} is the time period of subjects' accrual in a study. It can be a value that defines the end of accrual or a vector. In this case, \code{accrualTime} can be used to define a non-constant accrual over time. For this, \code{accrualTime} is a vector that defines the accrual intervals. The first element of \code{accrualTime} must be equal to \code{0} and, additionally, \code{accrualIntensity} needs to be specified. \code{accrualIntensity} itself is a value or a vector (depending on the length of \code{accrualtime}) that defines the intensity how subjects enter the trial in the intervals defined through \code{accrualTime}. \code{accrualTime} can also be a list that combines the definition of the accrual time and accrual intensity (see below and examples for details). If the length of \code{accrualTime} and the length of \code{accrualIntensity} are the same (i.e., the end of accrual is undefined), \code{maxNumberOfSubjects > 0} needs to be specified and the end of accrual is calculated. In that case, \code{accrualIntensity} is the number of subjects per time unit, i.e., the absolute accrual intensity. If the length of \code{accrualTime} equals the length of \code{accrualIntensity - 1} (i.e., the end of accrual is defined), \code{maxNumberOfSubjects} is calculated if the absolute accrual intensity is given. If all elements in \code{accrualIntensity} are smaller than 1, \code{accrualIntensity} defines the *relative* intensity how subjects enter the trial. For example, \code{accrualIntensity = c(0.1, 0.2)} specifies that in the second accrual interval the intensity is doubled as compared to the first accrual interval. The actual (absolute) accrual intensity is calculated for the calculated or given \code{maxNumberOfSubjects}. Note that the default is \code{accrualIntensity = 0.1} meaning that the *absolute* accrual intensity will be calculated. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ \donttest{ # Assume that in a trial the accrual after the first 6 months is doubled # and the total accrual time is 30 months. # Further assume that a total of 1000 subjects are entered in the trial. # The number of subjects to be accrued in the first 6 months and afterwards # is achieved through getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.1, 0.2), maxNumberOfSubjects = 1000) # The same result is obtained via the list based definition getAccrualTime(list( "0 - <6" = 0.1, "6 - <=30" = 0.2), maxNumberOfSubjects = 1000) # Calculate the end of accrual at given absolute intensity: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(18, 36), maxNumberOfSubjects = 1000) # Via the list based definition this is getAccrualTime(list( "0 - <6" = 18, ">=6" = 36), maxNumberOfSubjects = 1000) # You can use an accrual time object in getSampleSizeSurvival() or # getPowerSurvival(). # For example, if the maximum number of subjects and the follow up # time needs to be calculated for a given effect size: accrualTime = getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.1, 0.2)) getSampleSizeSurvival(accrualTime = accrualTime, pi1 = 0.4, pi2 = 0.2) # Or if the power and follow up time needs to be calculated for given # number of events and subjects: accrualTime = getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.1, 0.2), maxNumberOfSubjects = 110) getPowerSurvival(accrualTime = accrualTime, pi1 = 0.4, pi2 = 0.2, maxNumberOfEvents = 46) # How to show accrual time details # You can use a sample size or power object as argument for the function # getAccrualTime(): sampleSize <- getSampleSizeSurvival(accrualTime = c(0, 6), accrualIntensity = c(22, 53), lambda2 = 0.05, hazardRatio = 0.8, followUpTime = 6) sampleSize accrualTime <- getAccrualTime(sampleSize) accrualTime } } \seealso{ \code{\link{getNumberOfSubjects}} for calculating the number of subjects at given time points. } rpact/man/param_rValue.Rd0000644000175000017500000000065114142514771015205 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_rValue} \alias{param_rValue} \title{Parameter Description: RValue} \arguments{ \item{rValue}{For \code{typeOfSelection = "rbest"} (select the \code{rValue} best treatment arms / populations), the parameter \code{rValue} has to be specified.} } \description{ Parameter Description: RValue } \keyword{internal} rpact/man/PowerAndAverageSampleNumberResult_as.data.frame.Rd0000644000175000017500000000274514020357214023775 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_power_and_asn.R \name{PowerAndAverageSampleNumberResult_as.data.frame} \alias{PowerAndAverageSampleNumberResult_as.data.frame} \alias{as.data.frame.PowerAndAverageSampleNumberResult} \title{Coerce Power And Average Sample Number Result to a Data Frame} \usage{ \method{as.data.frame}{PowerAndAverageSampleNumberResult}( x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ... ) } \arguments{ \item{x}{A \code{\link{PowerAndAverageSampleNumberResult}} object.} \item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column names will be used; syntactic names (variable names) otherwise (see \code{\link[base]{make.names}}).} \item{includeAllParameters}{Logical. If \code{TRUE}, all available parameters will be included in the data frame; a meaningful parameter selection otherwise, default is \code{FALSE}.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} } \value{ Returns a \code{\link[base]{data.frame}}. } \description{ Returns the \code{\link{PowerAndAverageSampleNumberResult}} as data frame. } \details{ Coerces the \code{\link{PowerAndAverageSampleNumberResult}} object to a data frame. } \examples{ data <- as.data.frame(getPowerAndAverageSampleNumber(getDesignGroupSequential())) head(data) dim(data) } \keyword{internal} rpact/man/TrialDesignSet.Rd0000644000175000017500000000141514020357214015437 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_set.R \docType{class} \name{TrialDesignSet} \alias{TrialDesignSet} \title{Class for trial design sets.} \description{ \code{TrialDesignSet} is a class for creating a collection of different trial designs. } \details{ This object cannot be created directly; better use \code{\link{getDesignSet}} with suitable arguments to create a set of designs. } \section{Fields}{ \describe{ \item{\code{designs}}{The designs (optional).} \item{\code{design}}{The master design (optional).} }} \section{Methods}{ \describe{ \item{\code{add(...)}}{Adds 'designs' OR a 'design' and/or a design parameter, e.g., deltaWT = c(0.1, 0.3, 0.4)} }} \seealso{ \code{\link{getDesignSet}} } \keyword{internal} rpact/man/dataMultiArmMeans.Rd0000644000175000017500000000100214102177375016127 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{dataMultiArmMeans} \alias{dataMultiArmMeans} \title{Multi-Arm Dataset of Means} \format{ A \code{\link[base]{data.frame}} object. } \usage{ dataMultiArmMeans } \description{ A dataset containing the sample sizes, means, and standard deviations of four groups. Use \code{getDataset(dataMultiArmMeans)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. } \keyword{datasets} rpact/man/getClosedConditionalDunnettTestResults.Rd0000644000175000017500000000731614153377720022460 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_analysis_multiarm.R \name{getClosedConditionalDunnettTestResults} \alias{getClosedConditionalDunnettTestResults} \title{Get Closed Conditional Dunnett Test Results} \usage{ getClosedConditionalDunnettTestResults( stageResults, ..., stage = stageResults$stage ) } \arguments{ \item{stageResults}{The results at given stage, obtained from \code{\link{getStageResults}}.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{stage}{The stage number (optional). Default: total number of existing stages in the data input.} } \value{ Returns a \code{\link{ClosedCombinationTestResults}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.ParameterSet]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Calculates and returns the results from the closed conditional Dunnett test. } \details{ For performing the conditional Dunnett test the design must be defined through the function \code{\link{getDesignConditionalDunnett}}.\cr See Koenig et al. (2008) and Wassmer & Brannath (2016), chapter 11 for details of the test procedure. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ \donttest{ # In a two-stage design a conditional Dunnett test should be performed # where the unconditional second stage p-values should be used for the # test decision. # At the first stage the second treatment arm was dropped. The results of # a closed conditionsal Dunnett test are obtained as follows with the given # data (treatment arm 4 refers to the reference group): data <- getDataset( n1 = c(22, 23), n2 = c(21, NA), n3 = c(20, 25), n4 = c(25, 27), means1 = c(1.63, 1.51), means2 = c(1.4, NA), means3 = c(0.91, 0.95), means4 = c(0.83, 0.75), stds1 = c(1.2, 1.4), stds2 = c(1.3, NA), stds3 = c(1.1, 1.14), stds4 = c(1.02, 1.18)) # For getting the results of the closed test procedure, use the following commands: design <- getDesignConditionalDunnett(secondStageConditioning = FALSE) stageResults <- getStageResults(design, dataInput = data) getClosedConditionalDunnettTestResults(stageResults) } } \seealso{ Other analysis functions: \code{\link{getAnalysisResults}()}, \code{\link{getClosedCombinationTestResults}()}, \code{\link{getConditionalPower}()}, \code{\link{getConditionalRejectionProbabilities}()}, \code{\link{getFinalConfidenceInterval}()}, \code{\link{getFinalPValue}()}, \code{\link{getRepeatedConfidenceIntervals}()}, \code{\link{getRepeatedPValues}()}, \code{\link{getStageResults}()}, \code{\link{getTestActions}()} } \concept{analysis functions} rpact/man/getStageResults.Rd0000644000175000017500000001375114153377720015724 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_analysis_base.R \name{getStageResults} \alias{getStageResults} \title{Get Stage Results} \usage{ getStageResults(design, dataInput, ..., stage = NA_integer_) } \arguments{ \item{design}{The trial design.} \item{dataInput}{The summary data used for calculating the test results. This is either an element of \code{DatasetMeans}, of \code{DatasetRates}, or of \code{DatasetSurvival} and should be created with the function \code{getDataset}. For more information see \code{\link{getDataset}}.} \item{...}{Further (optional) arguments to be passed: \describe{ \item{\code{thetaH0}}{The null hypothesis value, default is \code{0} for the normal and the binary case (testing means and rates, respectively), it is \code{1} for the survival case (testing the hazard ratio).\cr\cr For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. That is, in case of (one-sided) testing of \itemize{ \item \emph{means}: a value \code{!= 0} (or a value \code{!= 1} for testing the mean ratio) can be specified. \item \emph{rates}: a value \code{!= 0} (or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. \item \emph{survival data}: a bound for testing H0: \code{hazard ratio = thetaH0 != 1} can be specified. } For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for defining the null hypothesis H0: \code{pi = thetaH0}.} \item{\code{normalApproximation}}{The type of computation of the p-values. Default is \code{FALSE} for testing means (i.e., the t test is used) and \code{TRUE} for testing rates and the hazard ratio. For testing rates, if \code{normalApproximation = FALSE} is specified, the binomial test (one sample) or the exact test of Fisher (two samples) is used for calculating the p-values. In the survival setting, \code{normalApproximation = FALSE} has no effect.} \item{\code{equalVariances}}{The type of t test. For testing means in two treatment groups, either the t test assuming that the variances are equal or the t test without assuming this, i.e., the test of Welch-Satterthwaite is calculated, default is \code{TRUE}.} \item{\code{directionUpper}}{The direction of one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values.} \item{\code{intersectionTest}}{Defines the multiple test for the intersection hypotheses in the closed system of hypotheses when testing multiple hypotheses. Five options are available in multi-arm designs: \code{"Dunnett"}, \code{"Bonferroni"}, \code{"Simes"}, \code{"Sidak"}, and \code{"Hierarchical"}, default is \code{"Dunnett"}. Four options are available in population enrichment designs: \code{"SpiessensDebois"} (one subset only), \code{"Bonferroni"}, \code{"Simes"}, and \code{"Sidak"}, default is \code{"Simes"}.} \item{\code{varianceOption}}{Defines the way to calculate the variance in multiple treatment arms (> 2) or population enrichment designs for testing means. For multiple arms, three options are available: \code{"overallPooled"}, \code{"pairwisePooled"}, and \code{"notPooled"}, default is \code{"overallPooled"}. For enrichment designs, the options are: \code{"pooled"}, \code{"pooledFromFull"} (one subset only), and \code{"notPooled"}, default is \code{"pooled"}.} \item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. For testing means and rates, also a non-stratified analysis based on overall data can be performed. For survival data, only a stratified analysis is possible (see Brannath et al., 2009), default is \code{TRUE}.} }} \item{stage}{The stage number (optional). Default: total number of existing stages in the data input.} } \value{ Returns a \code{\link{StageResults}} object. \itemize{ \item \code{\link[=names.StageResults]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.StageResults]{plot}} to plot the object, \item \code{\link[=as.data.frame.StageResults]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns summary statistics and p-values for a given data set and a given design. } \details{ Calculates and returns the stage results of the specified design and data input at the specified stage. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ design <- getDesignInverseNormal() dataRates <- getDataset( n1 = c(10, 10), n2 = c(20, 20), events1 = c( 8, 10), events2 = c(10, 16)) getStageResults(design, dataRates) } \seealso{ Other analysis functions: \code{\link{getAnalysisResults}()}, \code{\link{getClosedCombinationTestResults}()}, \code{\link{getClosedConditionalDunnettTestResults}()}, \code{\link{getConditionalPower}()}, \code{\link{getConditionalRejectionProbabilities}()}, \code{\link{getFinalConfidenceInterval}()}, \code{\link{getFinalPValue}()}, \code{\link{getRepeatedConfidenceIntervals}()}, \code{\link{getRepeatedPValues}()}, \code{\link{getTestActions}()} } \concept{analysis functions} rpact/man/param_lambda2.Rd0000644000175000017500000000072014020357215015237 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_lambda2} \alias{param_lambda2} \title{Parameter Description: Lambda (2)} \arguments{ \item{lambda2}{The assumed hazard rate in the reference group, there is no default. \code{lambda2} can also be used to define piecewise exponentially distributed survival times (see details).} } \description{ Parameter Description: Lambda (2) } \keyword{internal} rpact/man/AnalysisResultsMultiArm.Rd0000644000175000017500000000107114102177375017405 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsMultiArm} \alias{AnalysisResultsMultiArm} \title{Basic Class for Analysis Results Multi-Arm} \description{ A basic class for multi-arm analysis results. } \details{ \code{AnalysisResultsMultiArm} is the basic class for \itemize{ \item \code{\link{AnalysisResultsMultiArmFisher}}, \item \code{\link{AnalysisResultsMultiArmInverseNormal}}, and \item \code{\link{AnalysisResultsConditionalDunnett}}. } } \keyword{internal} rpact/man/TrialDesignPlan.Rd0000644000175000017500000000071014020357214015573 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_plan.R \docType{class} \name{TrialDesignPlan} \alias{TrialDesignPlan} \title{Basic Trial Design Plan} \description{ Basic class for trial design plans. } \details{ \code{TrialDesignPlan} is the basic class for \itemize{ \item \code{TrialDesignPlanMeans}, \item \code{TrialDesignPlanRates}, and \item \code{TrialDesignPlanSurvival}. } } \keyword{internal} rpact/man/FieldSet.Rd0000644000175000017500000000046614020357214014262 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_parameter_set.R \docType{class} \name{FieldSet} \alias{FieldSet} \title{Field Set} \description{ Basic class for field sets. } \details{ The field set implements basic functions for a set of fields. } \keyword{internal} rpact/man/SimulationResultsMultiArmMeans.Rd0000644000175000017500000000066514020357214020731 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R \docType{class} \name{SimulationResultsMultiArmMeans} \alias{SimulationResultsMultiArmMeans} \title{Class for Simulation Results Multi-Arm Means} \description{ A class for simulation results means in multi-arm designs. } \details{ Use \code{\link{getSimulationMultiArmMeans}} to create an object of this type. } \keyword{internal} rpact/man/getPlotSettings.Rd0000644000175000017500000000177014046535122015725 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_plot_settings.R \name{getPlotSettings} \alias{getPlotSettings} \title{Get Plot Settings} \usage{ getPlotSettings( lineSize = 0.8, pointSize = 3, pointColor = NA_character_, mainTitleFontSize = 14, axesTextFontSize = 10, legendFontSize = 11, scalingFactor = 1 ) } \arguments{ \item{lineSize}{The line size, default is \code{0.8}.} \item{pointSize}{The point size, default is \code{3}.} \item{pointColor}{The point color (character), default is \code{NA_character_}.} \item{mainTitleFontSize}{The main title font size, default is \code{14}.} \item{axesTextFontSize}{The axes text font size, default is \code{10}.} \item{legendFontSize}{The legend font size, default is \code{11}.} \item{scalingFactor}{The scaling factor, default is \code{1}.} } \description{ Returns a plot settings object. } \details{ Returns an object of class \code{PlotSettings} that collects typical plot settings. } \keyword{internal} rpact/man/param_pi2_survival.Rd0000644000175000017500000000064514020357215016370 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_pi2_survival} \alias{param_pi2_survival} \title{Parameter Description: Pi (2) for Survival Data} \arguments{ \item{pi2}{A numeric value that represents the assumed event rate in the control group, default is \code{0.2}.} } \description{ Parameter Description: Pi (2) for Survival Data } \keyword{internal} rpact/man/param_informationEpsilon.Rd0000644000175000017500000000147614153377720017637 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_informationEpsilon} \alias{param_informationEpsilon} \title{Parameter Description: Information Epsilon} \arguments{ \item{informationEpsilon}{Positive integer value specifying the absolute information epsilon, which defines the maximum distance from the observed information to the maximum information that causes the final analysis. Updates at the final analysis in case the observed information at the final analysis is smaller ("under-running") than the planned maximum information \code{maxInformation}, default is 0. Alternatively, a floating-point number > 0 and < 1 can be specified to define a relative information epsilon.} } \description{ Parameter Description: Information Epsilon } \keyword{internal} rpact/man/param_median2.Rd0000644000175000017500000000055514020357215015262 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_median2} \alias{param_median2} \title{Parameter Description: Median (2)} \arguments{ \item{median2}{The assumed median survival time in the reference group, there is no default.} } \description{ Parameter Description: Median (2) } \keyword{internal} rpact/man/AnalysisResults.Rd0000644000175000017500000000077314020357214015731 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResults} \alias{AnalysisResults} \title{Basic Class for Analysis Results} \description{ A basic class for analysis results. } \details{ \code{AnalysisResults} is the basic class for \itemize{ \item \code{\link{AnalysisResultsFisher}}, \item \code{\link{AnalysisResultsGroupSequential}}, and \item \code{\link{AnalysisResultsInverseNormal}}. } } \keyword{internal} rpact/man/plot.StageResults.Rd0000644000175000017500000001225614060361011016157 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R \name{plot.StageResults} \alias{plot.StageResults} \title{Stage Results Plotting} \usage{ \method{plot}{StageResults}( x, y, ..., type = 1L, nPlanned, allocationRatioPlanned = 1, main = NA_character_, xlab = NA_character_, ylab = NA_character_, legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, showSource = FALSE, plotSettings = NULL ) } \arguments{ \item{x}{The stage results at given stage, obtained from \code{getStageResults} or \code{getAnalysisResults}.} \item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} \item{...}{Optional \link[=param_three_dots_plot]{plot arguments}. Furthermore the following arguments can be defined: \itemize{ \item \code{thetaRange}: A range of assumed effect sizes if testing means or a survival design was specified. Additionally, if testing means was selected, an assumed standard deviation can be specified (default is 1). \item \code{piTreatmentRange}: A range of assumed rates pi1 to calculate the conditional power. Additionally, if a two-sample comparison was selected, pi2 can be specified (default is the value from \code{getAnalysisResults}). \item \code{directionUpper}: Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. \item \code{\link[=param_thetaH0]{thetaH0}}: The null hypothesis value, default is 0 for the normal and the binary case, it is 1 for the survival case. For testing a rate in one sample, a value thetaH0 in (0,1) has to be specified for defining the null hypothesis H0: pi = thetaH0. }} \item{type}{The plot type (default = 1). Note that at the moment only one type (the conditional power plot) is available.} \item{nPlanned}{The additional (i.e., "new" and not cumulative) sample size planned for each of the subsequent stages. The argument must be a vector with length equal to the number of remaining stages and contain the combined sample size from both treatment groups if two groups are considered. For survival outcomes, it should contain the planned number of additional events. For multi-arm designs, it is the per-comparison (combined) sample size. For enrichment designs, it is the (combined) sample size for the considered sub-population.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} \item{main}{The main title.} \item{xlab}{The x-axis label.} \item{ylab}{The y-axis label.} \item{legendTitle}{The legend title.} \item{palette}{The palette, default is \code{"Set1"}.} \item{legendPosition}{The position of the legend. By default (\code{NA_integer_}) the algorithm tries to find a suitable position. Choose one of the following values to specify the position manually: \itemize{ \item \code{-1}: no legend will be shown \item \code{NA}: the algorithm tries to find a suitable position \item \code{0}: legend position outside plot \item \code{1}: legend position left top \item \code{2}: legend position left center \item \code{3}: legend position left bottom \item \code{4}: legend position right top \item \code{5}: legend position right center \item \code{6}: legend position right bottom }} \item{showSource}{If \code{TRUE}, the parameter names of the object will be printed which were used to create the plot; that may be, e.g., useful to check the values or to create own plots with the base R \code{plot} function. Alternatively \code{showSource} can be defined as one of the following character values: \itemize{ \item \code{"commands"}: returns a character vector with plot commands \item \code{"axes"}: returns a list with the axes definitions \item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function does not stop if an error occurs) \item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function stops if an error occurs) } Note: no plot object will be returned if \code{showSource} is a character.} \item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link{getPlotSettings}}.} } \value{ Returns a \code{ggplot2} object. } \description{ Plots the conditional power together with the likelihood function. } \details{ Generic function to plot all kinds of stage results. The conditional power is calculated only if effect size and sample size is specified. } \examples{ design <- getDesignGroupSequential(kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.5, 0.8, 1), typeOfDesign = "WT", deltaWT = 0.25) dataExample <- getDataset( n = c(20, 30, 30), means = c(50, 51, 55), stDevs = c(130, 140, 120) ) stageResults <- getStageResults(design, dataExample, thetaH0 = 20) if (require(ggplot2)) plot(stageResults, nPlanned = c(30), thetaRange = c(0, 100)) } rpact/man/getSampleSizeSurvival.Rd0000644000175000017500000003701314153377720017104 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_design_sample_size_calculator.R \name{getSampleSizeSurvival} \alias{getSampleSizeSurvival} \title{Get Sample Size Survival} \usage{ getSampleSizeSurvival( design = NULL, ..., typeOfComputation = c("Schoenfeld", "Freedman", "HsiehFreedman"), thetaH0 = 1, pi1 = NA_real_, pi2 = NA_real_, lambda1 = NA_real_, lambda2 = NA_real_, median1 = NA_real_, median2 = NA_real_, kappa = 1, hazardRatio = NA_real_, piecewiseSurvivalTime = NA_real_, allocationRatioPlanned = NA_real_, eventTime = 12L, accrualTime = c(0L, 12L), accrualIntensity = 0.1, accrualIntensityType = c("auto", "absolute", "relative"), followUpTime = NA_real_, maxNumberOfSubjects = NA_real_, dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12L ) } \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{typeOfComputation}{Three options are available: \code{"Schoenfeld"}, \code{"Freedman"}, \code{"HsiehFreedman"}, the default is \code{"Schoenfeld"}. For details, see Hsieh (Statistics in Medicine, 1992). For non-inferiority testing (i.e., \code{thetaH0 != 1}), only Schoenfeld's formula can be used.} \item{thetaH0}{The null hypothesis value, default is \code{0} for the normal and the binary case (testing means and rates, respectively), it is \code{1} for the survival case (testing the hazard ratio).\cr\cr For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. That is, in case of (one-sided) testing of \itemize{ \item \emph{means}: a value \code{!= 0} (or a value \code{!= 1} for testing the mean ratio) can be specified. \item \emph{rates}: a value \code{!= 0} (or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. \item \emph{survival data}: a bound for testing H0: \code{hazard ratio = thetaH0 != 1} can be specified. } For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for defining the null hypothesis H0: \code{pi = thetaH0}.} \item{pi1}{A numeric value or vector that represents the assumed event rate in the treatment group, default is \code{seq(0.2, 0.5, 0.1)} (power calculations and simulations) or \code{seq(0.4, 0.6, 0.1)} (sample size calculations).} \item{pi2}{A numeric value that represents the assumed event rate in the control group, default is \code{0.2}.} \item{lambda1}{The assumed hazard rate in the treatment group, there is no default. \code{lambda1} can also be used to define piecewise exponentially distributed survival times (see details).} \item{lambda2}{The assumed hazard rate in the reference group, there is no default. \code{lambda2} can also be used to define piecewise exponentially distributed survival times (see details).} \item{median1}{The assumed median survival time in the treatment group, there is no default.} \item{median2}{The assumed median survival time in the reference group, there is no default.} \item{kappa}{A numeric value > 0. A \code{kappa != 1} will be used for the specification of the shape of the Weibull distribution. Default is \code{1}, i.e., the exponential survival distribution is used instead of the Weibull distribution. Note that the Weibull distribution cannot be used for the piecewise definition of the survival time distribution, i.e., only \code{piecewiselambda} (as a single value) and \code{kappa} can be specified. This function is equivalent to \code{pweibull(t, shape = kappa, scale = 1 / lambda)} of the \code{stats} package, i.e., the scale parameter is \code{1 / 'hazard rate'}.\cr For example, \code{getPiecewiseExponentialDistribution(time = 130, piecewiseLambda = 0.01, kappa = 4.2)} and \code{pweibull(q = 130, shape = 4.2, scale = 1 / 0.01)} provide the sample result.} \item{hazardRatio}{The vector of hazard ratios under consideration. If the event or hazard rates in both treatment groups are defined, the hazard ratio needs not to be specified as it is calculated, there is no default.} \item{piecewiseSurvivalTime}{A vector that specifies the time intervals for the piecewise definition of the exponential survival time cumulative distribution function \cr (for details see \code{\link{getPiecewiseSurvivalTime}}).} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. If \code{allocationRatioPlanned = 0} is entered, the optimal allocation ratio yielding the smallest overall sample size is determined.} \item{eventTime}{The assumed time under which the event rates are calculated, default is \code{12}.} \item{accrualTime}{The assumed accrual time intervals for the study, default is \code{c(0, 12)} (for details see \code{\link{getAccrualTime}}).} \item{accrualIntensity}{A vector of accrual intensities, default is the relative intensity \code{0.1} (for details see \code{\link{getAccrualTime}}).} \item{accrualIntensityType}{A character value specifying the accrual intensity input type. Must be one of \code{"auto"}, \code{"absolute"}, or \code{"relative"}; default is \code{"auto"}, i.e., if all values are < 1 the type is \code{"relative"}, otherwise it is \code{"absolute"}.} \item{followUpTime}{The assumed (additional) follow-up time for the study, default is \code{6}. The total study duration is \code{accrualTime + followUpTime}.} \item{maxNumberOfSubjects}{If \code{maxNumberOfSubjects > 0} is specified, the follow-up time for the required number of events is determined.} \item{dropoutRate1}{The assumed drop-out rate in the treatment group, default is \code{0}.} \item{dropoutRate2}{The assumed drop-out rate in the control group, default is \code{0}.} \item{dropoutTime}{The assumed time for drop-out rates in the control and the treatment group, default is \code{12}.} } \value{ Returns a \code{\link{TrialDesignPlan}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.TrialDesignSet]{summary}} to display a summary of the object, \item \code{\link[=plot.TrialDesignPlan]{plot}} to plot the object, \item \code{\link[=as.data.frame.TrialDesignPlan]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the sample size for testing the hazard ratio in a two treatment groups survival design. } \details{ At given design the function calculates the number of events and an estimate for the necessary number of subjects for testing the hazard ratio in a survival design. It also calculates the time when the required events are expected under the given assumptions (exponentially, piecewise exponentially, or Weibull distributed survival times and constant or non-constant piecewise accrual). Additionally, an allocation ratio = \code{n1 / n2} can be specified where \code{n1} and \code{n2} are the number of subjects in the two treatment groups. Optional argument \code{accountForObservationTimes}: if \code{accountForObservationTimes = TRUE}, the number of subjects is calculated assuming specific accrual and follow-up time, default is \code{TRUE}. The formula of Kim & Tsiatis (Biometrics, 1990) is used to calculate the expected number of events under the alternative (see also Lakatos & Lan, Statistics in Medicine, 1992). These formulas are generalized to piecewise survival times and non-constant piecewise accrual over time.\cr Optional argument \code{accountForObservationTimes}: if \code{accountForObservationTimes = FALSE}, only the event rates are used for the calculation of the maximum number of subjects. } \section{Piecewise survival time}{ The first element of the vector \code{piecewiseSurvivalTime} must be equal to \code{0}. \code{piecewiseSurvivalTime} can also be a list that combines the definition of the time intervals and hazard rates in the reference group. The definition of the survival time in the treatment group is obtained by the specification of the hazard ratio (see examples for details). } \section{Staggered patient entry}{ \code{accrualTime} is the time period of subjects' accrual in a study. It can be a value that defines the end of accrual or a vector. In this case, \code{accrualTime} can be used to define a non-constant accrual over time. For this, \code{accrualTime} is a vector that defines the accrual intervals. The first element of \code{accrualTime} must be equal to \code{0} and, additionally, \code{accrualIntensity} needs to be specified. \code{accrualIntensity} itself is a value or a vector (depending on the length of \code{accrualtime}) that defines the intensity how subjects enter the trial in the intervals defined through \code{accrualTime}. \code{accrualTime} can also be a list that combines the definition of the accrual time and accrual intensity (see below and examples for details). If the length of \code{accrualTime} and the length of \code{accrualIntensity} are the same (i.e., the end of accrual is undefined), \code{maxNumberOfSubjects > 0} needs to be specified and the end of accrual is calculated. In that case, \code{accrualIntensity} is the number of subjects per time unit, i.e., the absolute accrual intensity. If the length of \code{accrualTime} equals the length of \code{accrualIntensity - 1} (i.e., the end of accrual is defined), \code{maxNumberOfSubjects} is calculated if the absolute accrual intensity is given. If all elements in \code{accrualIntensity} are smaller than 1, \code{accrualIntensity} defines the *relative* intensity how subjects enter the trial. For example, \code{accrualIntensity = c(0.1, 0.2)} specifies that in the second accrual interval the intensity is doubled as compared to the first accrual interval. The actual (absolute) accrual intensity is calculated for the calculated or given \code{maxNumberOfSubjects}. Note that the default is \code{accrualIntensity = 0.1} meaning that the *absolute* accrual intensity will be calculated. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Fixed sample size trial with median survival 20 vs. 30 months in treatment and # reference group, respectively, alpha = 0.05 (two-sided), and power 1 - beta = 90\%. # 20 subjects will be recruited per month up to 400 subjects, i.e., accrual time # is 20 months. getSampleSizeSurvival(alpha = 0.05, sided = 2, beta = 0.1, lambda1 = log(2) / 20, lambda2 = log(2) / 30, accrualTime = c(0,20), accrualIntensity = 20) \donttest{ # Fixed sample size with minimum required definitions, pi1 = c(0.4,0.5,0.6) and # pi2 = 0.2 at event time 12, accrual time 12 and follow-up time 6 as default, # only alpha = 0.01 is specified getSampleSizeSurvival(alpha = 0.01) # Four stage O'Brien & Fleming group sequential design with minimum required # definitions, pi1 = c(0.4,0.5,0.6) and pi2 = 0.2 at event time 12, # accrual time 12 and follow-up time 6 as default getSampleSizeSurvival(design = getDesignGroupSequential(kMax = 4)) # For fixed sample design, determine necessary accrual time if 200 subjects and # 30 subjects per time unit can be recruited getSampleSizeSurvival(accrualTime = c(0), accrualIntensity = c(30), maxNumberOfSubjects = 200) # Determine necessary accrual time if 200 subjects and if the first 6 time units # 20 subjects per time unit can be recruited, then 30 subjects per time unit getSampleSizeSurvival(accrualTime = c(0, 6), accrualIntensity = c(20, 30), maxNumberOfSubjects = 200) # Determine maximum number of Subjects if the first 6 time units 20 subjects # per time unit can be recruited, and after 10 time units 30 subjects per time unit getSampleSizeSurvival(accrualTime = c(0, 6, 10), accrualIntensity = c(20, 30)) # Specify accrual time as a list at <- list( "0 - <6" = 20, "6 - Inf" = 30) getSampleSizeSurvival(accrualTime = at, maxNumberOfSubjects = 200) # Specify accrual time as a list, if maximum number of subjects need to be calculated at <- list( "0 - <6" = 20, "6 - <=10" = 30) getSampleSizeSurvival(accrualTime = at) # Specify effect size for a two-stage group design with O'Brien & Fleming boundaries # Effect size is based on event rates at specified event time # needs to be specified because it should be shown that hazard ratio < 1 getSampleSizeSurvival(design = getDesignGroupSequential(kMax = 2), pi1 = 0.2, pi2 = 0.3, eventTime = 24) # Effect size is based on event rate at specified event # time for the reference group and hazard ratio getSampleSizeSurvival(design = getDesignGroupSequential(kMax = 2), hazardRatio = 0.5, pi2 = 0.3, eventTime = 24) # Effect size is based on hazard rate for the reference group and hazard ratio getSampleSizeSurvival(design = getDesignGroupSequential(kMax = 2), hazardRatio = 0.5, lambda2 = 0.02) # Specification of piecewise exponential survival time and hazard ratios getSampleSizeSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.01, 0.02, 0.04), hazardRatio = c(1.5, 1.8, 2)) # Specification of piecewise exponential survival time as a list and hazard ratios pws <- list( "0 - <5" = 0.01, "5 - <10" = 0.02, ">=10" = 0.04) getSampleSizeSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = pws, hazardRatio = c(1.5, 1.8, 2)) # Specification of piecewise exponential survival time for both treatment arms getSampleSizeSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.01, 0.02, 0.04), lambda1 = c(0.015, 0.03, 0.06)) # Specification of piecewise exponential survival time as a list pws <- list( "0 - <5" = 0.01, "5 - <10" = 0.02, ">=10" = 0.04) getSampleSizeSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = pws, hazardRatio = c(1.5, 1.8, 2)) # Specify effect size based on median survival times getSampleSizeSurvival(median1 = 5, median2 = 3) # Specify effect size based on median survival times of Weibull distribtion with # kappa = 2 getSampleSizeSurvival(median1 = 5, median2 = 3, kappa = 2) # Identify minimal and maximal required subjects to # reach the required events in spite of dropouts getSampleSizeSurvival(accrualTime = c(0, 18), accrualIntensity = c(20, 30), lambda2 = 0.4, lambda1 = 0.3, followUpTime = Inf, dropoutRate1 = 0.001, dropoutRate2 = 0.005) getSampleSizeSurvival(accrualTime = c(0, 18), accrualIntensity = c(20, 30), lambda2 = 0.4, lambda1 = 0.3, followUpTime = 0, dropoutRate1 = 0.001, dropoutRate2 = 0.005) } } \seealso{ Other sample size functions: \code{\link{getSampleSizeMeans}()}, \code{\link{getSampleSizeRates}()} } \concept{sample size functions} rpact/man/param_lambda1.Rd0000644000175000017500000000072014020357215015236 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_lambda1} \alias{param_lambda1} \title{Parameter Description: Lambda (1)} \arguments{ \item{lambda1}{The assumed hazard rate in the treatment group, there is no default. \code{lambda1} can also be used to define piecewise exponentially distributed survival times (see details).} } \description{ Parameter Description: Lambda (1) } \keyword{internal} rpact/man/FieldSet_print.Rd0000644000175000017500000000117214020357214015471 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_parameter_set.R \name{FieldSet_print} \alias{FieldSet_print} \alias{print.FieldSet} \title{Print Field Set Values} \usage{ \method{print}{FieldSet}(x, ...) } \arguments{ \item{x}{A \code{\link{FieldSet}} object.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} } \description{ \code{print} prints its \code{\link{FieldSet}} argument and returns it invisibly (via \code{invisible(x)}). } \details{ Prints the field set. } \keyword{internal} rpact/man/SimulationResultsSurvival.Rd0000644000175000017500000000061514020357214020021 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R \docType{class} \name{SimulationResultsSurvival} \alias{SimulationResultsSurvival} \title{Class for Simulation Results Survival} \description{ A class for simulation results survival. } \details{ Use \code{\link{getSimulationSurvival}} to create an object of this type. } \keyword{internal} rpact/man/getTestActions.Rd0000644000175000017500000000260114153377720015527 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_analysis_base.R \name{getTestActions} \alias{getTestActions} \title{Get Test Actions} \usage{ getTestActions(stageResults, ...) } \arguments{ \item{stageResults}{The results at given stage, obtained from \code{\link{getStageResults}}.} \item{...}{Only available for backward compatibility.} } \value{ Returns a \code{\link[base]{character}} vector of length \code{kMax} Returns a \code{\link[base]{numeric}} vector of length \code{kMax}containing the test actions of each stage. } \description{ Returns test actions. } \details{ Returns the test actions of the specified design and stage results at the specified stage. } \examples{ design <- getDesignInverseNormal(kMax = 2) data <- getDataset( n = c( 20, 30), means = c( 50, 51), stDevs = c(130, 140) ) getTestActions(getStageResults(design, dataInput = data)) } \seealso{ Other analysis functions: \code{\link{getAnalysisResults}()}, \code{\link{getClosedCombinationTestResults}()}, \code{\link{getClosedConditionalDunnettTestResults}()}, \code{\link{getConditionalPower}()}, \code{\link{getConditionalRejectionProbabilities}()}, \code{\link{getFinalConfidenceInterval}()}, \code{\link{getFinalPValue}()}, \code{\link{getRepeatedConfidenceIntervals}()}, \code{\link{getRepeatedPValues}()}, \code{\link{getStageResults}()} } \concept{analysis functions} rpact/man/getLogLevel.Rd0000644000175000017500000000123114020357214014763 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_core_utilities.R \name{getLogLevel} \alias{getLogLevel} \title{Get Log Level} \usage{ getLogLevel() } \value{ Returns a \code{\link[base]{character}} of length 1 specifying the current log level. } \description{ Returns the current \code{rpact} log level. } \details{ This function gets the log level of the \code{rpact} internal log message system. } \examples{ # show current log level getLogLevel() } \seealso{ \itemize{ \item \code{\link{setLogLevel}} for setting the log level, \item \code{\link{resetLogLevel}} for resetting the log level to default. } } \keyword{internal} rpact/man/param_nPlanned.Rd0000644000175000017500000000146214055345235015507 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_nPlanned} \alias{param_nPlanned} \title{Parameter Description: N Planned} \arguments{ \item{nPlanned}{The additional (i.e., "new" and not cumulative) sample size planned for each of the subsequent stages. The argument must be a vector with length equal to the number of remaining stages and contain the combined sample size from both treatment groups if two groups are considered. For survival outcomes, it should contain the planned number of additional events. For multi-arm designs, it is the per-comparison (combined) sample size. For enrichment designs, it is the (combined) sample size for the considered sub-population.} } \description{ Parameter Description: N Planned } \keyword{internal} rpact/man/TrialDesignPlanMeans.Rd0000644000175000017500000000065614020357214016570 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_plan.R \docType{class} \name{TrialDesignPlanMeans} \alias{TrialDesignPlanMeans} \title{Trial Design Plan Means} \description{ Trial design plan for means. } \details{ This object cannot be created directly; use \code{\link{getSampleSizeMeans}} with suitable arguments to create a design plan for a dataset of means. } \keyword{internal} rpact/man/param_three_dots.Rd0000644000175000017500000000064314020357215016101 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_three_dots} \alias{param_three_dots} \title{Parameter Description: "..."} \arguments{ \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} } \description{ Parameter Description: "..." } \keyword{internal} rpact/man/param_typeOfComputation.Rd0000644000175000017500000000115114020357215017425 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_typeOfComputation} \alias{param_typeOfComputation} \title{Parameter Description: Type Of Computation} \arguments{ \item{typeOfComputation}{Three options are available: \code{"Schoenfeld"}, \code{"Freedman"}, \code{"HsiehFreedman"}, the default is \code{"Schoenfeld"}. For details, see Hsieh (Statistics in Medicine, 1992). For non-inferiority testing (i.e., \code{thetaH0 != 1}), only Schoenfeld's formula can be used.} } \description{ Parameter Description: Type Of Computation } \keyword{internal} rpact/man/AnalysisResultsEnrichmentInverseNormal.Rd0000644000175000017500000000105414020357214022444 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsEnrichmentInverseNormal} \alias{AnalysisResultsEnrichmentInverseNormal} \title{Analysis Results Enrichment Inverse Normal} \description{ Class for enrichment analysis results based on a inverse normal design. } \details{ This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the enrichment analysis results of an inverse normal design. } \keyword{internal} rpact/man/AnalysisResultsInverseNormal.Rd0000644000175000017500000000077714020357214020442 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsInverseNormal} \alias{AnalysisResultsInverseNormal} \title{Analysis Results Inverse Normal} \description{ Class for analysis results results based on an inverse normal design. } \details{ This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the analysis results of a inverse normal design. } \keyword{internal} rpact/man/param_calcSubjectsFunction.Rd0000644000175000017500000000121714020357215020052 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_calcSubjectsFunction} \alias{param_calcSubjectsFunction} \title{Parameter Description: Calculate Subjects Function} \arguments{ \item{calcSubjectsFunction}{Optionally, a function can be entered that defines the way of performing the sample size recalculation. By default, sample size recalculation is performed with conditional power with specified \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (see details and examples).} } \description{ Parameter Description: Calculate Subjects Function } \keyword{internal} rpact/man/param_selectPopulationsFunction.Rd0000644000175000017500000000111514102177376021170 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_selectPopulationsFunction} \alias{param_selectPopulationsFunction} \title{Parameter Description: Select Populations Function} \arguments{ \item{selectPopulationsFunction}{Optionally, a function can be entered that defines the way of how populations are selected. This function is allowed to depend on \code{effectVector} with length \code{populations} and \code{stage} (see examples).} } \description{ Parameter Description: Select Populations Function } \keyword{internal} rpact/man/EventProbabilities.Rd0000644000175000017500000000057414020357214016355 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_event_probabilities.R \docType{class} \name{EventProbabilities} \alias{EventProbabilities} \title{Event Probabilities} \description{ Class for the definition of event probabilities. } \details{ \code{EventProbabilities} is a class for the definition of event probabilities. } \keyword{internal} rpact/man/Dataset_print.Rd0000644000175000017500000000152314046540575015373 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R \name{Dataset_print} \alias{Dataset_print} \alias{print.Dataset} \title{Print Dataset Values} \usage{ \method{print}{Dataset}( x, ..., markdown = FALSE, output = c("list", "long", "wide", "r", "rComplete") ) } \arguments{ \item{x}{A \code{\link{Dataset}} object.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{markdown}{If \code{TRUE}, the output will be created in Markdown.} \item{output}{A character defining the output type, default is "list".} } \description{ \code{print} prints its \code{\link{Dataset}} argument and returns it invisibly (via \code{invisible(x)}). } \details{ Prints the dataset. } \keyword{internal} rpact/man/dataEnrichmentSurvival.Rd0000644000175000017500000000104414102177375017247 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{dataEnrichmentSurvival} \alias{dataEnrichmentSurvival} \title{Enrichment Dataset of Survival Data} \format{ A \code{\link[base]{data.frame}} object. } \usage{ dataEnrichmentSurvival } \description{ A dataset containing the log-rank statistics, events, and allocation ratios of two groups. Use \code{getDataset(dataEnrichmentSurvival)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. } \keyword{datasets} rpact/man/param_activeArms.Rd0000644000175000017500000000060014153377720016042 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_activeArms} \alias{param_activeArms} \title{Parameter Description: Active Arms} \arguments{ \item{activeArms}{The number of active treatment arms to be compared with control, default is \code{3}.} } \description{ Parameter Description: Active Arms } \keyword{internal} rpact/man/sub-TrialDesignSet-method.Rd0000644000175000017500000000117214134251163017506 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_set.R \name{[,TrialDesignSet-method} \alias{[,TrialDesignSet-method} \title{Access Trial Design by Index} \usage{ \S4method{[}{TrialDesignSet}(x, i, j, ..., drop = TRUE) } \description{ Function to the \code{TrialDesign} at position \code{i} in a \code{TrialDesignSet} object. } \details{ Can be used to iterate with "[index]"-syntax over all designs in a design set. } \examples{ designSet <- getDesignSet(design = getDesignFisher(), alpha = c(0.01, 0.05)) for (i in 1:length(designSet)) { print(designSet[i]$alpha) } } \keyword{internal} rpact/man/getDesignInverseNormal.Rd0000644000175000017500000001663414153377720017220 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_design_group_sequential.R \name{getDesignInverseNormal} \alias{getDesignInverseNormal} \title{Get Design Inverse Normal} \usage{ getDesignInverseNormal( ..., kMax = NA_integer_, alpha = NA_real_, beta = NA_real_, sided = 1, informationRates = NA_real_, futilityBounds = NA_real_, typeOfDesign = c("OF", "P", "WT", "PT", "HP", "WToptimum", "asP", "asOF", "asKD", "asHSD", "asUser", "noEarlyEfficacy"), deltaWT = NA_real_, deltaPT1 = NA_real_, deltaPT0 = NA_real_, optimizationCriterion = c("ASNH1", "ASNIFH1", "ASNsum"), gammaA = NA_real_, typeBetaSpending = c("none", "bsP", "bsOF", "bsKD", "bsHSD", "bsUser"), userAlphaSpending = NA_real_, userBetaSpending = NA_real_, gammaB = NA_real_, bindingFutility = NA, constantBoundsHP = 3, twoSidedPower = NA, tolerance = 1e-08 ) } \arguments{ \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{kMax}{The maximum number of stages \code{K}. \code{K = 1, 2, 3, ...} (default is \code{3}). The maximum selectable \code{kMax} is \code{20} for group sequential or inverse normal and \code{6} for Fisher combination test designs.} \item{alpha}{The significance level alpha, default is \code{0.025}.} \item{beta}{Type II error rate, necessary for providing sample size calculations \cr (e.g., \code{\link{getSampleSizeMeans}}), beta spending function designs, or optimum designs, default is \code{0.20}.} \item{sided}{Is the alternative one-sided (\code{1}) or two-sided (\code{2}), default is \code{1}.} \item{informationRates}{The information rates (that must be fixed prior to the trial), default is \code{(1:kMax) / kMax}.} \item{futilityBounds}{The futility bounds, defined on the test statistic z scale (numeric vector of length \code{kMax - 1}).} \item{typeOfDesign}{The type of design. Type of design is one of the following: O'Brien & Fleming (\code{"OF"}), Pocock (\code{"P"}), Wang & Tsiatis Delta class (\code{"WT"}), Pampallona & Tsiatis (\code{"PT"}), Haybittle & Peto ("HP"), Optimum design within Wang & Tsiatis class (\code{"WToptimum"}), O'Brien & Fleming type alpha spending (\code{"asOF"}), Pocock type alpha spending (\code{"asP"}), Kim & DeMets alpha spending (\code{"asKD"}), Hwang, Shi & DeCani alpha spending (\code{"asHSD"}), user defined alpha spending (\code{"asUser"}), no early efficacy stop (\code{"noEarlyEfficacy"}), default is \code{"OF"}.} \item{deltaWT}{Delta for Wang & Tsiatis Delta class.} \item{deltaPT1}{Delta1 for Pampallona & Tsiatis class rejecting H0 boundaries.} \item{deltaPT0}{Delta0 for Pampallona & Tsiatis class rejecting H1 boundaries.} \item{optimizationCriterion}{Optimization criterion for optimum design within Wang & Tsiatis class (\code{"ASNH1"}, \code{"ASNIFH1"}, \code{"ASNsum"}), default is \code{"ASNH1"}, see details.} \item{gammaA}{Parameter for alpha spending function.} \item{typeBetaSpending}{Type of beta spending. Type of of beta spending is one of the following: O'Brien & Fleming type beta spending, Pocock type beta spending, Kim & DeMets beta spending, Hwang, Shi & DeCani beta spending, user defined beta spending (\code{"bsOF"}, \code{"bsP"}, \code{"bsKD"}, \code{"bsHSD"}, \code{"bsUser"}, default is \code{"none"}).} \item{userAlphaSpending}{The user defined alpha spending. Numeric vector of length \code{kMax} containing the cumulative alpha-spending (Type I error rate) up to each interim stage: \code{0 <= alpha_1 <= ... <= alpha_K <= alpha}.} \item{userBetaSpending}{The user defined beta spending. Vector of length \code{kMax} containing the cumulative beta-spending up to each interim stage.} \item{gammaB}{Parameter for beta spending function.} \item{bindingFutility}{If \code{bindingFutility = TRUE} is specified the calculation of the critical values is affected by the futility bounds and the futility threshold is binding in the sense that the study must be stopped if the futility condition was reached (default is \code{FALSE}).} \item{constantBoundsHP}{The constant bounds up to stage \code{kMax - 1} for the Haybittle & Peto design (default is \code{3}).} \item{twoSidedPower}{For two-sided testing, if \code{twoSidedPower = TRUE} is specified the sample size calculation is performed by considering both tails of the distribution. Default is \code{FALSE}, i.e., it is assumed that one tail probability is equal to 0 or the power should be directed to one part.} \item{tolerance}{The numerical tolerance, default is \code{1e-08}.} } \value{ Returns a \code{\link{TrialDesign}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.TrialDesign]{plot}} to plot the object, \item \code{\link[=as.data.frame.TrialDesign]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Provides adjusted boundaries and defines a group sequential design for its use in the inverse normal combination test. } \details{ Depending on \code{typeOfDesign} some parameters are specified, others not. For example, only if \code{typeOfDesign} \code{"asHSD"} is selected, \code{gammaA} needs to be specified. If an alpha spending approach was specified (\code{"asOF"}, \code{"asP"}, \code{"asKD"}, \code{"asHSD"}, or \code{"asUser"}) additionally a beta spending function can be specified to produce futility bounds. For optimum designs, \code{"ASNH1"} minimizes the expected sample size under H1, \code{"ASNIFH1"} minimizes the sum of the maximum sample and the expected sample size under H1, and \code{"ASNsum"} minimizes the sum of the maximum sample size, the expected sample size under a value midway H0 and H1, and the expected sample size under H1. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Calculate two-sided critical values for a four-stage # Wang & Tsiatis design with Delta = 0.25 at level alpha = 0.05 getDesignInverseNormal(kMax = 4, sided = 2, typeOfDesign = "WT", deltaWT = 0.25) # Calculate the Pocock type alpha spending critical values if the second # interim analysis was performed after 70\% of information was observed getDesignInverseNormal(informationRates = c(0.4, 0.7), typeOfDesign = "asP") } \seealso{ \code{\link{getDesignSet}} for creating a set of designs to compare different designs. Other design functions: \code{\link{getDesignCharacteristics}()}, \code{\link{getDesignConditionalDunnett}()}, \code{\link{getDesignFisher}()}, \code{\link{getDesignGroupSequential}()}, \code{\link{getPowerAndAverageSampleNumber}()} } \concept{design functions} rpact/man/plot.ParameterSet.Rd0000644000175000017500000000535014046535122016135 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_parameter_set.R \name{plot.ParameterSet} \alias{plot.ParameterSet} \title{Parameter Set Plotting} \usage{ \method{plot}{ParameterSet}( x, y, ..., main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", legendPosition = NA_integer_, showSource = FALSE, plotSettings = NULL ) } \arguments{ \item{x}{The object that inherits from \code{\link{ParameterSet}}.} \item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} \item{...}{Optional plot arguments. At the moment \code{xlim} and \code{ylim} are implemented for changing x or y axis limits without dropping data observations.} \item{main}{The main title.} \item{xlab}{The x-axis label.} \item{ylab}{The y-axis label.} \item{type}{The plot type (default = 1).} \item{palette}{The palette, default is \code{"Set1"}.} \item{legendPosition}{The position of the legend. By default (\code{NA_integer_}) the algorithm tries to find a suitable position. Choose one of the following values to specify the position manually: \itemize{ \item \code{-1}: no legend will be shown \item \code{NA}: the algorithm tries to find a suitable position \item \code{0}: legend position outside plot \item \code{1}: legend position left top \item \code{2}: legend position left center \item \code{3}: legend position left bottom \item \code{4}: legend position right top \item \code{5}: legend position right center \item \code{6}: legend position right bottom }} \item{showSource}{If \code{TRUE}, the parameter names of the object will be printed which were used to create the plot; that may be, e.g., useful to check the values or to create own plots with the base R \code{plot} function. Alternatively \code{showSource} can be defined as one of the following character values: \itemize{ \item \code{"commands"}: returns a character vector with plot commands \item \code{"axes"}: returns a list with the axes definitions \item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function does not stop if an error occurs) \item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function stops if an error occurs) } Note: no plot object will be returned if \code{showSource} is a character.} \item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link{getPlotSettings}}.} } \value{ Returns a \code{ggplot2} object. } \description{ Plots an object that inherits from class \code{\link{ParameterSet}}. } \details{ Generic function to plot a parameter set. } rpact/man/dataMultiArmSurvival.Rd0000644000175000017500000000103514102177375016705 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{dataMultiArmSurvival} \alias{dataMultiArmSurvival} \title{Multi-Arm Dataset of Survival Data} \format{ A \code{\link[base]{data.frame}} object. } \usage{ dataMultiArmSurvival } \description{ A dataset containing the log-rank statistics, events, and allocation ratios of three groups. Use \code{getDataset(dataMultiArmSurvival)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. } \keyword{datasets} rpact/man/param_dropoutTime.Rd0000644000175000017500000000062214020357215016251 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_dropoutTime} \alias{param_dropoutTime} \title{Parameter Description: Dropout Time} \arguments{ \item{dropoutTime}{The assumed time for drop-out rates in the control and the treatment group, default is \code{12}.} } \description{ Parameter Description: Dropout Time } \keyword{internal} rpact/man/getSampleSizeRates.Rd0000644000175000017500000001367714153377720016361 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_design_sample_size_calculator.R \name{getSampleSizeRates} \alias{getSampleSizeRates} \title{Get Sample Size Rates} \usage{ getSampleSizeRates( design = NULL, ..., groups = 2, normalApproximation = TRUE, riskRatio = FALSE, thetaH0 = ifelse(riskRatio, 1, 0), pi1 = c(0.4, 0.5, 0.6), pi2 = 0.2, allocationRatioPlanned = NA_real_ ) } \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{groups}{The number of treatment groups (1 or 2), default is \code{2}.} \item{normalApproximation}{If \code{FALSE}, the sample size for the case of one treatment group is calculated exactly using the binomial distribution, default is \code{TRUE}.} \item{riskRatio}{If \code{TRUE}, the sample size for one-sided testing of H0: \code{pi1 / pi2 = thetaH0} is calculated, default is \code{FALSE}.} \item{thetaH0}{The null hypothesis value, default is \code{0} for the normal and the binary case (testing means and rates, respectively), it is \code{1} for the survival case (testing the hazard ratio).\cr\cr For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. That is, in case of (one-sided) testing of \itemize{ \item \emph{means}: a value \code{!= 0} (or a value \code{!= 1} for testing the mean ratio) can be specified. \item \emph{rates}: a value \code{!= 0} (or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. \item \emph{survival data}: a bound for testing H0: \code{hazard ratio = thetaH0 != 1} can be specified. } For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for defining the null hypothesis H0: \code{pi = thetaH0}.} \item{pi1}{A numeric value or vector that represents the assumed probability in the active treatment group if two treatment groups are considered, or the alternative probability for a one treatment group design, default is \code{seq(0.2, 0.5, 0.1)} (power calculations and simulations) or \code{seq(0.4, 0.6, 0.1)} (sample size calculations).} \item{pi2}{A numeric value that represents the assumed probability in the reference group if two treatment groups are considered, default is \code{0.2}.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. If \code{allocationRatioPlanned = 0} is entered, the optimal allocation ratio yielding the smallest overall sample size is determined.} } \value{ Returns a \code{\link{TrialDesignPlan}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.TrialDesignSet]{summary}} to display a summary of the object, \item \code{\link[=plot.TrialDesignPlan]{plot}} to plot the object, \item \code{\link[=as.data.frame.TrialDesignPlan]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the sample size for testing rates in one or two samples. } \details{ At given design the function calculates the stage-wise (non-cumulated) and maximum sample size for testing rates. In a two treatment groups design, additionally, an allocation ratio = n1/n2 can be specified. If a null hypothesis value thetaH0 != 0 for testing the difference of two rates thetaH0 != 1 for testing the risk ratio is specified, the sample size formula according to Farrington & Manning (Statistics in Medicine, 1990) is used. Critical bounds and stopping for futility bounds are provided at the effect scale (rate, rate difference, or rate ratio, respectively) for each sample size calculation separately. For the two-sample case, the calculation here is performed at fixed pi2 as given as argument in the function. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Calculate the stage-wise sample sizes, maximum sample sizes, and the optimum # allocation ratios for a range of pi1 values when testing # H0: pi1 - pi2 = -0.1 within a two-stage O'Brien & Fleming design; # alpha = 0.05 one-sided, power 1 - beta = 90\%: getSampleSizeRates(getDesignGroupSequential(kMax = 2, alpha = 0.05, beta = 0.1), groups = 2, thetaH0 = -0.1, pi1 = seq(0.4, 0.55, 0.025), pi2 = 0.4, allocationRatioPlanned = 0) \donttest{ # Calculate the stage-wise sample sizes, maximum sample sizes, and the optimum # allocation ratios for a range of pi1 values when testing # H0: pi1 / pi2 = 0.80 within a three-stage O'Brien & Fleming design; # alpha = 0.025 one-sided, power 1 - beta = 90\%: getSampleSizeRates(getDesignGroupSequential(kMax = 3, alpha = 0.025, beta = 0.1), groups = 2, riskRatio = TRUE, thetaH0 = 0.80, pi1 = seq(0.3, 0.5, 0.025), pi2 = 0.3, allocationRatioPlanned = 0) } } \seealso{ Other sample size functions: \code{\link{getSampleSizeMeans}()}, \code{\link{getSampleSizeSurvival}()} } \concept{sample size functions} rpact/man/param_thetaH1.Rd0000644000175000017500000000070014020357215015231 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_thetaH1} \alias{param_thetaH1} \title{Parameter Description: Effect Under Alternative} \arguments{ \item{thetaH1}{If specified, the value of the alternative under which the conditional power or sample size recalculation calculation is performed.} } \description{ Parameter Description: Effect Under Alternative } \keyword{internal} rpact/man/TrialDesignSet_as.data.frame.Rd0000644000175000017500000000324114020357214020122 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_set.R \name{TrialDesignSet_as.data.frame} \alias{TrialDesignSet_as.data.frame} \alias{as.data.frame.TrialDesignSet} \title{Coerce Trial Design Set to a Data Frame} \usage{ \method{as.data.frame}{TrialDesignSet}( x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, addPowerAndAverageSampleNumber = FALSE, theta = seq(-1, 1, 0.02), nMax = NA_integer_, ... ) } \arguments{ \item{x}{A \code{\link{TrialDesignSet}} object.} \item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column names will be used; syntactic names (variable names) otherwise (see \code{\link[base]{make.names}}).} \item{includeAllParameters}{Logical. If \code{TRUE}, all available parameters will be included in the data frame; a meaningful parameter selection otherwise, default is \code{FALSE}.} \item{addPowerAndAverageSampleNumber}{If \code{TRUE}, power and average sample size will be added to data frame, default is \code{FALSE}.} \item{theta}{A vector of standardized effect sizes (theta values), default is a sequence from -1 to 1.} \item{nMax}{The maximum sample size.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} } \value{ Returns a \code{\link[base]{data.frame}}. } \description{ Returns the \code{TrialDesignSet} as data frame. } \details{ Coerces the design set to a data frame. } \examples{ designSet <- getDesignSet(design = getDesignGroupSequential(), alpha = c(0.01, 0.05)) as.data.frame(designSet) } \keyword{internal} rpact/man/getDataset.Rd0000644000175000017500000002603714153377720014665 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R \name{getDataset} \alias{getDataset} \alias{getDataSet} \title{Get Dataset} \usage{ getDataset(..., floatingPointNumbersEnabled = FALSE) getDataSet(..., floatingPointNumbersEnabled = FALSE) } \arguments{ \item{...}{A \code{data.frame} or some data vectors defining the dataset.} \item{floatingPointNumbersEnabled}{If \code{TRUE}, sample sizes can be specified as floating-point numbers (this make sense, e.g., for theoretical comparisons); \cr by default \code{floatingPointNumbersEnabled = FALSE}, i.e., samples sizes defined as floating-point numbers will be truncated.} } \value{ Returns a \code{\link{Dataset}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.Dataset]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Creates a dataset object and returns it. } \details{ The different dataset types \code{DatasetMeans}, of \code{DatasetRates}, or \code{DatasetSurvival} can be created as follows: \itemize{ \item An element of \code{\link{DatasetMeans}} for one sample is created by \cr \code{getDataset(sampleSizes =, means =, stDevs =)} where \cr \code{sampleSizes}, \code{means}, \code{stDevs} are vectors with stage-wise sample sizes, means and standard deviations of length given by the number of available stages. \item An element of \code{\link{DatasetMeans}} for two samples is created by \cr \code{getDataset(sampleSizes1 =, sampleSizes2 =, means1 =, means2 =, } \cr \code{stDevs1 =, stDevs2 =)} where \code{sampleSizes1}, \code{sampleSizes2}, \code{means1}, \code{means2}, \code{stDevs1}, \code{stDevs2} are vectors with stage-wise sample sizes, means and standard deviations for the two treatment groups of length given by the number of available stages. \item An element of \code{\link{DatasetRates}} for one sample is created by \cr \code{getDataset(sampleSizes =, events =)} where \code{sampleSizes}, \code{events} are vectors with stage-wise sample sizes and events of length given by the number of available stages. \item An element of \code{\link{DatasetRates}} for two samples is created by \cr \code{getDataset(sampleSizes1 =, sampleSizes2 =, events1 =, events2 =)} where \code{sampleSizes1}, \code{sampleSizes2}, \code{events1}, \code{events2} are vectors with stage-wise sample sizes and events for the two treatment groups of length given by the number of available stages. \item An element of \code{\link{DatasetSurvival}} is created by \cr \code{getDataset(events =, logRanks =, allocationRatios =)} where \code{events}, \code{logRanks}, and \code{allocation ratios} are the stage-wise events, (one-sided) logrank statistics, and allocation ratios. \item An element of \code{\link{DatasetMeans}}, \code{\link{DatasetRates}}, and \code{\link{DatasetSurvival}} for more than one comparison is created by adding subsequent digits to the variable names. The system can analyze these data in a multi-arm many-to-one comparison setting where the group with the highest index represents the control group. } Prefix \code{overall[Capital case of first letter of variable name]...} for the variable names enables entering the overall (cumulative) results and calculates stage-wise statistics. \code{n} can be used in place of \code{samplesizes}. Note that in survival design usually the overall (cumulative) events and logrank test statistics are provided in the output, so \cr \code{getDataset(overallEvents=, overallLogRanks =, overallAllocationRatios =)} \cr is the usual command for entering survival data. Note also that for \code{overallLogranks} also the z scores from a Cox regression can be used. For multi-arm designs, the index refers to the considered comparison. For example,\cr \code{ getDataset(events1=c(13, 33), logRanks1 = c(1.23, 1.55), events2 = c(16, NA), logRanks2 = c(1.55, NA)) } \cr refers to the case where one active arm (1) is considered at both stages whereas active arm 2 was dropped at interim. Number of events and logrank statistics are entered for the corresponding comparison to control (see Examples). For enrichment designs, the comparison of two samples is provided for an unstratified (sub-population wise) or stratified data input.\cr For unstratified (sub-population wise) data input the data sets are defined for the sub-populations S1, S2, ..., F, where F refers to the full populations. Use of \code{getDataset(S1 = , S2, ..., F = )} defines the data set to be used in \code{\link{getAnalysisResults}} (see examples)\cr For stratified data input the data sets are defined for the strata S1, S12, S2, ..., R, where R refers to the remainder of the strata such that the union of all sets is the full population. Use of \code{getDataset(S1 = , S12 = , S2, ..., R = )} defines the data set to be used in \code{\link{getAnalysisResults}} (see examples)\cr For survival data, for enrichment designs the log-rank statistics should be entered as stratified log-rank statistics in order to provide strong control of Type I error rate. For stratified data input, the variables to be specified in \code{getDataset()} are \code{events}, \code{expectedEvents}, \code{varianceEvents}, and \code{allocationRatios} or \code{overallEvents}, \code{overallExpectedEvents}, \code{overallVarianceEvents}, and \code{overallAllocationRatios}. From this, (stratified) log-rank tests are calculated. } \examples{ # Create a Dataset of Means (one group): datasetOfMeans <- getDataset( n = c(22, 11, 22, 11), means = c(1, 1.1, 1, 1), stDevs = c(1, 2, 2, 1.3) ) datasetOfMeans datasetOfMeans$show(showType = 2) \donttest{ datasetOfMeans <- getDataset( overallSampleSizes = c(22, 33, 55, 66), overallMeans = c(1.000, 1.033, 1.020, 1.017), overallStDevs = c(1.00, 1.38, 1.64, 1.58) ) datasetOfMeans datasetOfMeans$show(showType = 2) as.data.frame(datasetOfMeans) # Create a Dataset of Means (two groups): datasetOfMeans <- getDataset( n1 = c(22, 11, 22, 11), n2 = c(22, 13, 22, 13), means1 = c(1, 1.1, 1, 1), means2 = c(1.4, 1.5, 3, 2.5), stDevs1 = c(1, 2, 2, 1.3), stDevs2 = c(1, 2, 2, 1.3) ) datasetOfMeans datasetOfMeans <- getDataset( overallSampleSizes1 = c(22, 33, 55, 66), overallSampleSizes2 = c(22, 35, 57, 70), overallMeans1 = c(1, 1.033, 1.020, 1.017), overallMeans2 = c(1.4, 1.437, 2.040, 2.126), overallStDevs1 = c(1, 1.38, 1.64, 1.58), overallStDevs2 = c(1, 1.43, 1.82, 1.74) ) datasetOfMeans df <- data.frame( stages = 1:4, n1 = c(22, 11, 22, 11), n2 = c(22, 13, 22, 13), means1 = c(1, 1.1, 1, 1), means2 = c(1.4, 1.5, 3, 2.5), stDevs1 = c(1, 2, 2, 1.3), stDevs2 = c(1, 2, 2, 1.3) ) datasetOfMeans <- getDataset(df) datasetOfMeans # Create a Dataset of Means (three groups) where the comparison of # treatment arm 1 to control is dropped at the second interim stage: datasetOfMeans <- getDataset( overallN1 = c(22, 33, NA), overallN2 = c(20, 34, 56), overallN3 = c(22, 31, 52), overallMeans1 = c(1.64, 1.54, NA), overallMeans2 = c(1.7, 1.5, 1.77), overallMeans3 = c(2.5, 2.06, 2.99), overallStDevs1 = c(1.5, 1.9, NA), overallStDevs2 = c(1.3, 1.3, 1.1), overallStDevs3 = c(1, 1.3, 1.8)) datasetOfMeans # Create a Dataset of Rates (one group): datasetOfRates <- getDataset( n = c(8, 10, 9, 11), events = c(4, 5, 5, 6) ) datasetOfRates # Create a Dataset of Rates (two groups): datasetOfRates <- getDataset( n2 = c(8, 10, 9, 11), n1 = c(11, 13, 12, 13), events2 = c(3, 5, 5, 6), events1 = c(10, 10, 12, 12) ) datasetOfRates # Create a Dataset of Rates (three groups) where the comparison of # treatment arm 2 to control is dropped at the first interim stage: datasetOfRates <- getDataset( overallN1 = c(22, 33, 44), overallN2 = c(20, NA, NA), overallN3 = c(20, 34, 44), overallEvents1 = c(11, 14, 22), overallEvents2 = c(17, NA, NA), overallEvents3 = c(17, 19, 33)) datasetOfRates # Create a Survival Dataset datasetSurvival <- getDataset( overallEvents = c(8, 15, 19, 31), overallAllocationRatios = c(1, 1, 1, 2), overallLogRanks = c(1.52, 1.98, 1.99, 2.11) ) datasetSurvival # Create a Survival Dataset with four comparisons where treatment # arm 2 was dropped at the first interim stage, and treatment arm 4 # at the second. datasetSurvival <- getDataset( overallEvents1 = c(18, 45, 56), overallEvents2 = c(22, NA, NA), overallEvents3 = c(12, 41, 56), overallEvents4 = c(27, 56, NA), overallLogRanks1 = c(1.52, 1.98, 1.99), overallLogRanks2 = c(3.43, NA, NA), overallLogRanks3 = c(1.45, 1.67, 1.87), overallLogRanks4 = c(1.12, 1.33, NA) ) datasetSurvival # Enrichment: Stratified and unstratified data input # The following data are from one study. Only the first # (stratified) data input enables a stratified analysis. # Stratified data input S1 <- getDataset( sampleSize1 = c(18, 17), sampleSize2 = c(12, 33), mean1 = c(125.6, 111.1), mean2 = c(107.7, 77.7), stDev1 = c(120.1, 145.6), stDev2 = c(128.5, 133.3)) S2 <- getDataset( sampleSize1 = c(11, NA), sampleSize2 = c(14, NA), mean1 = c(100.1, NA), mean2 = c( 68.3, NA), stDev1 = c(116.8, NA), stDev2 = c(124.0, NA)) S12 <- getDataset( sampleSize1 = c(21, 17), sampleSize2 = c(21, 12), mean1 = c(135.9, 117.7), mean2 = c(84.9, 107.7), stDev1 = c(185.0, 92.3), stDev2 = c(139.5, 107.7)) R <- getDataset( sampleSize1 = c(19, NA), sampleSize2 = c(33, NA), mean1 = c(142.4, NA), mean2 = c(77.1, NA), stDev1 = c(120.6, NA), stDev2 = c(163.5, NA)) dataEnrichment <- getDataset(S1 = S1, S2 = S2, S12 = S12, R = R) dataEnrichment # Unstratified data input S1N <- getDataset( sampleSize1 = c(39, 34), sampleSize2 = c(33, 45), stDev1 = c(156.503, 120.084), stDev2 = c(134.025, 126.502), mean1 = c(131.146, 114.4), mean2 = c(93.191, 85.7)) S2N <- getDataset( sampleSize1 = c(32, NA), sampleSize2 = c(35, NA), stDev1 = c(163.645, NA), stDev2 = c(131.888, NA), mean1 = c(123.594, NA), mean2 = c(78.26, NA)) F <- getDataset( sampleSize1 = c(69, NA), sampleSize2 = c(80, NA), stDev1 = c(165.468, NA), stDev2 = c(143.979, NA), mean1 = c(129.296, NA), mean2 = c(82.187, NA)) dataEnrichmentN <- getDataset(S1 = S1N, S2 = S2N, F = F) dataEnrichmentN } } rpact/man/t-FieldSet-method.Rd0000644000175000017500000000070114046540575016005 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_parameter_set.R \name{t,FieldSet-method} \alias{t,FieldSet-method} \title{Field Set Transpose} \usage{ \S4method{t}{FieldSet}(x) } \arguments{ \item{x}{A \code{FieldSet}.} } \description{ Given a \code{FieldSet} \code{x}, t returns the transpose of \code{x}. } \details{ Implementation of the base R generic function \code{\link[base]{t}} } \keyword{internal} rpact/man/param_plotPointsEnabled.Rd0000644000175000017500000000060214020357215017362 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_plotPointsEnabled} \alias{param_plotPointsEnabled} \title{Parameter Description: Plot Points Enabled} \arguments{ \item{plotPointsEnabled}{If \code{TRUE}, additional points will be plotted.} } \description{ Parameter Description: Plot Points Enabled } \keyword{internal} rpact/man/AnalysisResultsMultiArmInverseNormal.Rd0000644000175000017500000000104514020357214022102 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsMultiArmInverseNormal} \alias{AnalysisResultsMultiArmInverseNormal} \title{Analysis Results Multi-Arm Inverse Normal} \description{ Class for multi-arm analysis results based on a inverse normal design. } \details{ This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the multi-arm analysis results of an inverse normal design. } \keyword{internal} rpact/man/TrialDesignConditionalDunnett.Rd0000644000175000017500000000071114020357214020507 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R \docType{class} \name{TrialDesignConditionalDunnett} \alias{TrialDesignConditionalDunnett} \title{Conditional Dunnett Design} \description{ Trial design for conditional Dunnett tests. } \details{ This object should not be created directly. } \seealso{ \code{\link{getDesignConditionalDunnett}} for creating a conditional Dunnett test design. } \keyword{internal} rpact/man/kable.ParameterSet.Rd0000644000175000017500000000201714134251077016234 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_parameter_set.R \name{kable.ParameterSet} \alias{kable.ParameterSet} \title{Create output in Markdown} \usage{ kable.ParameterSet(x, ...) } \arguments{ \item{x}{A \code{ParameterSet}. If x does not inherit from class \code{\link{ParameterSet}}, \code{knitr::kable(x)} will be returned.} \item{...}{Other arguments (see \code{\link[knitr]{kable}}).} } \description{ The \code{kable()} function returns the output of the specified object formatted in Markdown. } \details{ Generic function to represent a parameter set in Markdown. Use \code{options("rpact.print.heading.base.number" = "NUMBER")} (where \code{NUMBER} is an integer value >= -1) to specify the heading level. The default is \code{options("rpact.print.heading.base.number" = "0")}, i.e., the top headings start with \code{##} in Markdown. \code{options("rpact.print.heading.base.number" = "-1")} means that all headings will be written bold but are not explicit defined as header. } rpact/man/dataEnrichmentRatesStratified.Rd0000644000175000017500000000105014102177375020526 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{dataEnrichmentRatesStratified} \alias{dataEnrichmentRatesStratified} \title{Stratified Enrichment Dataset of Rates} \format{ A \code{\link[base]{data.frame}} object. } \usage{ dataEnrichmentRatesStratified } \description{ A dataset containing the sample sizes and events of two groups. Use \code{getDataset(dataEnrichmentRatesStratified)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. } \keyword{datasets} rpact/man/dataEnrichmentMeans.Rd0000644000175000017500000000101214102177375016472 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{dataEnrichmentMeans} \alias{dataEnrichmentMeans} \title{Enrichment Dataset of Means} \format{ A \code{\link[base]{data.frame}} object. } \usage{ dataEnrichmentMeans } \description{ A dataset containing the sample sizes, means, and standard deviations of two groups. Use \code{getDataset(dataEnrichmentMeans)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. } \keyword{datasets} rpact/man/getData.Rd0000644000175000017500000000652114142514771014142 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R \name{getData} \alias{getData} \alias{getData.SimulationResults} \title{Get Simulation Data} \usage{ getData(x) getData.SimulationResults(x) } \arguments{ \item{x}{A \code{\link{SimulationResults}} object created by \code{\link{getSimulationMeans}},\cr \code{\link{getSimulationRates}}, \code{\link{getSimulationSurvival}}, \code{\link{getSimulationMultiArmMeans}},\cr \code{\link{getSimulationMultiArmRates}}, or \code{\link{getSimulationMultiArmSurvival}}.} } \value{ Returns a \code{\link[base]{data.frame}}. } \description{ Returns the aggregated simulation data. } \details{ This function can be used to get the aggregated simulated data from an simulation results object, for example, obtained by \code{\link{getSimulationSurvival}}. In this case, the data frame contains the following columns: \enumerate{ \item \code{iterationNumber}: The number of the simulation iteration. \item \code{stageNumber}: The stage. \item \code{pi1}: The assumed or derived event rate in the treatment group. \item \code{pi2}: The assumed or derived event rate in the control group. \item \code{hazardRatio}: The hazard ratio under consideration (if available). \item \code{analysisTime}: The analysis time. \item \code{numberOfSubjects}: The number of subjects under consideration when the (interim) analysis takes place. \item \code{eventsPerStage1}: The observed number of events per stage in treatment group 1. \item \code{eventsPerStage2}: The observed number of events per stage in treatment group 2. \item \code{eventsPerStage}: The observed number of events per stage in both treatment groups. \item \code{rejectPerStage}: 1 if null hypothesis can be rejected, 0 otherwise. \item \code{eventsNotAchieved}: 1 if number of events could not be reached with observed number of subjects, 0 otherwise. \item \code{futilityPerStage}: 1 if study should be stopped for futility, 0 otherwise. \item \code{testStatistic}: The test statistic that is used for the test decision, depends on which design was chosen (group sequential, inverse normal, or Fisher combination test)' \item \code{logRankStatistic}: Z-score statistic which corresponds to a one-sided log-rank test at considered stage. \item \code{conditionalPowerAchieved}: The conditional power for the subsequent stage of the trial for selected sample size and effect. The effect is either estimated from the data or can be user defined with \code{thetaH1} or \code{pi1H1} and \code{pi2H1}. \item \code{trialStop}: \code{TRUE} if study should be stopped for efficacy or futility or final stage, \code{FALSE} otherwise. \item \code{hazardRatioEstimateLR}: The estimated hazard ratio, derived from the log-rank statistic. } A subset of variables is provided for \code{\link{getSimulationMeans}}, \code{\link{getSimulationRates}}, \code{\link{getSimulationMultiArmMeans}},\cr \code{\link{getSimulationMultiArmRates}}, or \code{\link{getSimulationMultiArmSurvival}}. } \examples{ results <- getSimulationSurvival(pi1 = seq(0.3,0.6,0.1), pi2 = 0.3, eventTime = 12, accrualTime = 24, plannedEvents = 40, maxNumberOfSubjects = 200, maxNumberOfIterations = 50) data <- getData(results) head(data) dim(data) } rpact/man/ParameterSet.Rd0000644000175000017500000000051614020357214015153 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_parameter_set.R \docType{class} \name{ParameterSet} \alias{ParameterSet} \title{Parameter Set} \description{ Basic class for parameter sets. } \details{ The parameter set implements basic functions for a set of parameters. } \keyword{internal} rpact/man/getPowerMeans.Rd0000644000175000017500000001407114153377720015353 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_design_sample_size_calculator.R \name{getPowerMeans} \alias{getPowerMeans} \title{Get Power Means} \usage{ getPowerMeans( design = NULL, ..., groups = 2L, normalApproximation = FALSE, meanRatio = FALSE, thetaH0 = ifelse(meanRatio, 1, 0), alternative = seq(0, 1, 0.2), stDev = 1, directionUpper = NA, maxNumberOfSubjects = NA_real_, allocationRatioPlanned = NA_real_ ) } \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{groups}{The number of treatment groups (1 or 2), default is \code{2}.} \item{normalApproximation}{The type of computation of the p-values. If \code{TRUE}, the variance is assumed to be known, default is \code{FALSE}, i.e., the calculations are performed with the t distribution.} \item{meanRatio}{If \code{TRUE}, the sample size for one-sided testing of H0: \code{mu1 / mu2 = thetaH0} is calculated, default is \code{FALSE}.} \item{thetaH0}{The null hypothesis value, default is \code{0} for the normal and the binary case (testing means and rates, respectively), it is \code{1} for the survival case (testing the hazard ratio).\cr\cr For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. That is, in case of (one-sided) testing of \itemize{ \item \emph{means}: a value \code{!= 0} (or a value \code{!= 1} for testing the mean ratio) can be specified. \item \emph{rates}: a value \code{!= 0} (or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. \item \emph{survival data}: a bound for testing H0: \code{hazard ratio = thetaH0 != 1} can be specified. } For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for defining the null hypothesis H0: \code{pi = thetaH0}.} \item{alternative}{The alternative hypothesis value for testing means. This can be a vector of assumed alternatives, default is \code{seq(0, 1, 0.2)} (power calculations) or \code{seq(0.2, 1, 0.2)} (sample size calculations).} \item{stDev}{The standard deviation under which the sample size or power calculation is performed, default is \code{1}. If \code{meanRatio = TRUE} is specified, \code{stDev} defines the coefficient of variation \code{sigma / mu2}.} \item{directionUpper}{Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values.} \item{maxNumberOfSubjects}{\code{maxNumberOfSubjects > 0} needs to be specified. For two treatment arms, it is the maximum number of subjects for both treatment arms.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} } \value{ Returns a \code{\link{TrialDesignPlan}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.TrialDesignSet]{summary}} to display a summary of the object, \item \code{\link[=plot.TrialDesignPlan]{plot}} to plot the object, \item \code{\link[=as.data.frame.TrialDesignPlan]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the power, stopping probabilities, and expected sample size for testing means in one or two samples at given sample size. } \details{ At given design the function calculates the power, stopping probabilities, and expected sample size, for testing means at given sample size. In a two treatment groups design, additionally, an allocation ratio = \code{n1 / n2} can be specified. A null hypothesis value thetaH0 != 0 for testing the difference of two means or \code{thetaH0 != 1} for testing the ratio of two means can be specified. For the specified sample size, critical bounds and stopping for futility bounds are provided at the effect scale (mean, mean difference, or mean ratio, respectively) } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Calculate the power, stopping probabilities, and expected sample size # for testing H0: mu1 - mu2 = 0 in a two-armed design against a range of # alternatives H1: mu1 - m2 = delta, delta = (0, 1, 2, 3, 4, 5), # standard deviation sigma = 8, maximum sample size N = 80 (both treatment # arms), and an allocation ratio n1/n2 = 2. The design is a three stage # O'Brien & Fleming design with non-binding futility bounds (-0.5, 0.5) # for the two interims. The computation takes into account that the t test # is used (normalApproximation = FALSE). getPowerMeans(getDesignGroupSequential(alpha = 0.025, sided = 1, futilityBounds = c(-0.5, 0.5)), groups = 2, alternative = c(0:5), stDev = 8, normalApproximation = FALSE, maxNumberOfSubjects = 80, allocationRatioPlanned = 2) } \seealso{ Other power functions: \code{\link{getPowerRates}()}, \code{\link{getPowerSurvival}()} } \concept{power functions} rpact/man/DatasetRates.Rd0000644000175000017500000000130514153377720015153 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R \docType{class} \name{DatasetRates} \alias{DatasetRates} \title{Dataset of Rates} \description{ Class for a dataset of rates. } \details{ This object cannot be created directly; better use \code{\link{getDataset}} with suitable arguments to create a dataset of rates. } \section{Fields}{ \describe{ \item{\code{groups}}{The group numbers.} \item{\code{stages}}{The stage numbers.} \item{\code{sampleSizes}}{The sample sizes.} \item{\code{events}}{The events.} \item{\code{overallSampleSizes}}{The cumulative sample sizes.} \item{\code{overallEvents}}{The cumulative events.} }} \keyword{internal} rpact/man/param_intersectionTest_Enrichment.Rd0000644000175000017500000000113714102177376021473 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_intersectionTest_Enrichment} \alias{param_intersectionTest_Enrichment} \title{Parameter Description: Intersection Test} \arguments{ \item{intersectionTest}{Defines the multiple test for the intersection hypotheses in the closed system of hypotheses. Four options are available in enrichment designs: \code{"SpiessensDebois"}, \code{"Bonferroni"}, \code{"Simes"}, and \code{"Sidak"}, default is \code{"Simes"}.} } \description{ Parameter Description: Intersection Test } \keyword{internal} rpact/man/getConditionalRejectionProbabilities.Rd0000644000175000017500000000517614153377720022120 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_analysis_base.R \name{getConditionalRejectionProbabilities} \alias{getConditionalRejectionProbabilities} \title{Get Conditional Rejection Probabilities} \usage{ getConditionalRejectionProbabilities(stageResults, ...) } \arguments{ \item{stageResults}{The results at given stage, obtained from \code{\link{getStageResults}}.} \item{...}{Further (optional) arguments to be passed: \describe{ \item{\code{iterations}}{Iterations for simulating the conditional rejection probabilities for Fisher's combination test. For checking purposes, it can be estimated via simulation with specified \code{iterations}.} \item{\code{seed}}{Seed for simulating the conditional rejection probabilities for Fisher's combination test. See above, default is a random seed.} }} } \value{ Returns a \code{\link[base]{numeric}} vector of length \code{kMax} or in case of multi-arm stage results a \code{\link[base]{matrix}} (each column represents a stage, each row a comparison) containing the conditional rejection probabilities. } \description{ Calculates the conditional rejection probabilities (CRP) for given test results. } \details{ The conditional rejection probability is the probability, under H0, to reject H0 in one of the subsequent (remaining) stages. The probability is calculated using the specified design. For testing rates and the survival design, the normal approximation is used, i.e., it is calculated with the use of the prototype case testing a mean for normally distributed data with known variance. The conditional rejection probabilities are provided up to the specified stage. For Fisher's combination test, you can check the validity of the CRP calculation via simulation. } \examples{ \donttest{ # Calculate and check CRP for a Fisher's combination test design with # two remaining stages design <- getDesignFisher(kMax = 4, informationRates = c(0.1, 0.3, 0.8, 1), alpha = 0.01) data <- getDataset(n = c(40, 40), events = c(20, 22)) sr <- getStageResults(design, data, thetaH0 = 0.4) getConditionalRejectionProbabilities(sr) getConditionalRejectionProbabilities(sr, iterations = 100000) } } \seealso{ Other analysis functions: \code{\link{getAnalysisResults}()}, \code{\link{getClosedCombinationTestResults}()}, \code{\link{getClosedConditionalDunnettTestResults}()}, \code{\link{getConditionalPower}()}, \code{\link{getFinalConfidenceInterval}()}, \code{\link{getFinalPValue}()}, \code{\link{getRepeatedConfidenceIntervals}()}, \code{\link{getRepeatedPValues}()}, \code{\link{getStageResults}()}, \code{\link{getTestActions}()} } \concept{analysis functions} rpact/man/plot.SummaryFactory.Rd0000644000175000017500000000131314041474415016523 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_summary.R \name{plot.SummaryFactory} \alias{plot.SummaryFactory} \title{Summary Factory Plotting} \usage{ \method{plot}{SummaryFactory}(x, y, ...) } \arguments{ \item{x}{The summary factory object.} \item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} \item{...}{Optional plot arguments. At the moment \code{xlim} and \code{ylim} are implemented for changing x or y axis limits without dropping data observations.} } \value{ Returns a \code{ggplot2} object. } \description{ Plots a summary factory. } \details{ Generic function to plot all kinds of summary factories. } rpact/man/Dataset_summary.Rd0000644000175000017500000000545514026043231015725 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R \name{Dataset_summary} \alias{Dataset_summary} \alias{summary.Dataset} \title{Dataset Summary} \usage{ \method{summary}{Dataset}(object, ..., type = 1, digits = NA_integer_) } \arguments{ \item{object}{A \code{\link{Dataset}} object.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{digits}{Defines how many digits are to be used for numeric values.} } \value{ Returns a \code{\link{SummaryFactory}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object } } \description{ Displays a summary of \code{\link{Dataset}} object. } \details{ Summarizes the parameters and results of a dataset. } \section{Summary options}{ The following options can be set globally: \enumerate{ \item \code{rpact.summary.output.size}: one of \code{c("small", "medium", "large")}; defines how many details will be included into the summary; default is \code{"large"}, i.e., all available details are displayed. \item \code{rpact.summary.justify}: one of \code{c("right", "left", "centre")}; shall the values be right-justified (the default), left-justified or centered. \item \code{rpact.summary.width}: defines the maximum number of characters to be used per line (default is \code{83}). \item \code{rpact.summary.intervalFormat}: defines how intervals will be displayed in the summary, default is \code{"[\%s; \%s]"}. \item \code{rpact.summary.digits}: defines how many digits are to be used for numeric values (default is \code{3}). \item \code{rpact.summary.digits.probs}: defines how many digits are to be used for numeric values (default is one more than value of \code{rpact.summary.digits}, i.e., \code{4}). \item \code{rpact.summary.trim.zeroes}: if \code{TRUE} (default) zeroes will always displayed as "0", e.g. "0.000" will become "0". } Example: \code{options("rpact.summary.intervalFormat" = "\%s - \%s")} } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \keyword{internal} rpact/man/param_plannedSubjects.Rd0000644000175000017500000000127114060361011017054 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_plannedSubjects} \alias{param_plannedSubjects} \title{Parameter Description: Planned Subjects} \arguments{ \item{plannedSubjects}{\code{plannedSubjects} is a vector of length \code{kMax} (the number of stages of the design) that determines the number of cumulated (overall) subjects when the interim stages are planned. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs, \code{plannedSubjects} refers to the number of subjects per selected active arm.} } \description{ Parameter Description: Planned Subjects } \keyword{internal} rpact/man/param_maxNumberOfIterations.Rd0000644000175000017500000000065214153377720020240 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_maxNumberOfIterations} \alias{param_maxNumberOfIterations} \title{Parameter Description: Maximum Number Of Iterations} \arguments{ \item{maxNumberOfIterations}{The number of simulation iterations, default is \code{1000}.} } \description{ Parameter Description: Maximum Number Of Iterations } \keyword{internal} rpact/man/PiecewiseSurvivalTime.Rd0000644000175000017500000000062014020357214017043 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_time.R \docType{class} \name{PiecewiseSurvivalTime} \alias{PiecewiseSurvivalTime} \title{Piecewise Exponential Survival Time} \description{ Class for the definition of piecewise survival times. } \details{ \code{PiecewiseSurvivalTime} is a class for the definition of piecewise survival times. } \keyword{internal} rpact/man/getPowerSurvival.Rd0000644000175000017500000003652014153377720016126 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_design_sample_size_calculator.R \name{getPowerSurvival} \alias{getPowerSurvival} \title{Get Power Survival} \usage{ getPowerSurvival( design = NULL, ..., typeOfComputation = c("Schoenfeld", "Freedman", "HsiehFreedman"), thetaH0 = 1, directionUpper = NA, pi1 = NA_real_, pi2 = NA_real_, lambda1 = NA_real_, lambda2 = NA_real_, median1 = NA_real_, median2 = NA_real_, kappa = 1, hazardRatio = NA_real_, piecewiseSurvivalTime = NA_real_, allocationRatioPlanned = 1, eventTime = 12L, accrualTime = c(0L, 12L), accrualIntensity = 0.1, accrualIntensityType = c("auto", "absolute", "relative"), maxNumberOfSubjects = NA_real_, maxNumberOfEvents = NA_real_, dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12L ) } \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{typeOfComputation}{Three options are available: \code{"Schoenfeld"}, \code{"Freedman"}, \code{"HsiehFreedman"}, the default is \code{"Schoenfeld"}. For details, see Hsieh (Statistics in Medicine, 1992). For non-inferiority testing (i.e., \code{thetaH0 != 1}), only Schoenfeld's formula can be used.} \item{thetaH0}{The null hypothesis value, default is \code{0} for the normal and the binary case (testing means and rates, respectively), it is \code{1} for the survival case (testing the hazard ratio).\cr\cr For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. That is, in case of (one-sided) testing of \itemize{ \item \emph{means}: a value \code{!= 0} (or a value \code{!= 1} for testing the mean ratio) can be specified. \item \emph{rates}: a value \code{!= 0} (or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. \item \emph{survival data}: a bound for testing H0: \code{hazard ratio = thetaH0 != 1} can be specified. } For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for defining the null hypothesis H0: \code{pi = thetaH0}.} \item{directionUpper}{Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values.} \item{pi1}{A numeric value or vector that represents the assumed event rate in the treatment group, default is \code{seq(0.2, 0.5, 0.1)} (power calculations and simulations) or \code{seq(0.4, 0.6, 0.1)} (sample size calculations).} \item{pi2}{A numeric value that represents the assumed event rate in the control group, default is \code{0.2}.} \item{lambda1}{The assumed hazard rate in the treatment group, there is no default. \code{lambda1} can also be used to define piecewise exponentially distributed survival times (see details).} \item{lambda2}{The assumed hazard rate in the reference group, there is no default. \code{lambda2} can also be used to define piecewise exponentially distributed survival times (see details).} \item{median1}{The assumed median survival time in the treatment group, there is no default.} \item{median2}{The assumed median survival time in the reference group, there is no default.} \item{kappa}{A numeric value > 0. A \code{kappa != 1} will be used for the specification of the shape of the Weibull distribution. Default is \code{1}, i.e., the exponential survival distribution is used instead of the Weibull distribution. Note that the Weibull distribution cannot be used for the piecewise definition of the survival time distribution, i.e., only \code{piecewiselambda} (as a single value) and \code{kappa} can be specified. This function is equivalent to \code{pweibull(t, shape = kappa, scale = 1 / lambda)} of the \code{stats} package, i.e., the scale parameter is \code{1 / 'hazard rate'}.\cr For example, \code{getPiecewiseExponentialDistribution(time = 130, piecewiseLambda = 0.01, kappa = 4.2)} and \code{pweibull(q = 130, shape = 4.2, scale = 1 / 0.01)} provide the sample result.} \item{hazardRatio}{The vector of hazard ratios under consideration. If the event or hazard rates in both treatment groups are defined, the hazard ratio needs not to be specified as it is calculated, there is no default.} \item{piecewiseSurvivalTime}{A vector that specifies the time intervals for the piecewise definition of the exponential survival time cumulative distribution function \cr (for details see \code{\link{getPiecewiseSurvivalTime}}).} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} \item{eventTime}{The assumed time under which the event rates are calculated, default is \code{12}.} \item{accrualTime}{The assumed accrual time intervals for the study, default is \code{c(0, 12)} (for details see \code{\link{getAccrualTime}}).} \item{accrualIntensity}{A vector of accrual intensities, default is the relative intensity \code{0.1} (for details see \code{\link{getAccrualTime}}).} \item{accrualIntensityType}{A character value specifying the accrual intensity input type. Must be one of \code{"auto"}, \code{"absolute"}, or \code{"relative"}; default is \code{"auto"}, i.e., if all values are < 1 the type is \code{"relative"}, otherwise it is \code{"absolute"}.} \item{maxNumberOfSubjects}{\code{maxNumberOfSubjects > 0} needs to be specified. If accrual time and accrual intensity is specified, this will be calculated.} \item{maxNumberOfEvents}{\code{maxNumberOfEvents > 0} is the maximum number of events, it determines the power of the test and needs to be specified.} \item{dropoutRate1}{The assumed drop-out rate in the treatment group, default is \code{0}.} \item{dropoutRate2}{The assumed drop-out rate in the control group, default is \code{0}.} \item{dropoutTime}{The assumed time for drop-out rates in the control and the treatment group, default is \code{12}.} } \value{ Returns a \code{\link{TrialDesignPlan}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.TrialDesignSet]{summary}} to display a summary of the object, \item \code{\link[=plot.TrialDesignPlan]{plot}} to plot the object, \item \code{\link[=as.data.frame.TrialDesignPlan]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the power, stopping probabilities, and expected sample size for testing the hazard ratio in a two treatment groups survival design. } \details{ At given design the function calculates the power, stopping probabilities, and expected sample size at given number of events and number of subjects. It also calculates the time when the required events are expected under the given assumptions (exponentially, piecewise exponentially, or Weibull distributed survival times and constant or non-constant piecewise accrual). Additionally, an allocation ratio = n1/n2 can be specified where n1 and n2 are the number of subjects in the two treatment groups. The formula of Kim & Tsiatis (Biometrics, 1990) is used to calculate the expected number of events under the alternative (see also Lakatos & Lan, Statistics in Medicine, 1992). These formulas are generalized to piecewise survival times and non-constant piecewise accrual over time.\cr } \section{Piecewise survival time}{ The first element of the vector \code{piecewiseSurvivalTime} must be equal to \code{0}. \code{piecewiseSurvivalTime} can also be a list that combines the definition of the time intervals and hazard rates in the reference group. The definition of the survival time in the treatment group is obtained by the specification of the hazard ratio (see examples for details). } \section{Staggered patient entry}{ \code{accrualTime} is the time period of subjects' accrual in a study. It can be a value that defines the end of accrual or a vector. In this case, \code{accrualTime} can be used to define a non-constant accrual over time. For this, \code{accrualTime} is a vector that defines the accrual intervals. The first element of \code{accrualTime} must be equal to \code{0} and, additionally, \code{accrualIntensity} needs to be specified. \code{accrualIntensity} itself is a value or a vector (depending on the length of \code{accrualtime}) that defines the intensity how subjects enter the trial in the intervals defined through \code{accrualTime}. \code{accrualTime} can also be a list that combines the definition of the accrual time and accrual intensity (see below and examples for details). If the length of \code{accrualTime} and the length of \code{accrualIntensity} are the same (i.e., the end of accrual is undefined), \code{maxNumberOfSubjects > 0} needs to be specified and the end of accrual is calculated. In that case, \code{accrualIntensity} is the number of subjects per time unit, i.e., the absolute accrual intensity. If the length of \code{accrualTime} equals the length of \code{accrualIntensity - 1} (i.e., the end of accrual is defined), \code{maxNumberOfSubjects} is calculated if the absolute accrual intensity is given. If all elements in \code{accrualIntensity} are smaller than 1, \code{accrualIntensity} defines the *relative* intensity how subjects enter the trial. For example, \code{accrualIntensity = c(0.1, 0.2)} specifies that in the second accrual interval the intensity is doubled as compared to the first accrual interval. The actual (absolute) accrual intensity is calculated for the calculated or given \code{maxNumberOfSubjects}. Note that the default is \code{accrualIntensity = 0.1} meaning that the *absolute* accrual intensity will be calculated. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Fixed sample size with minimum required definitions, pi1 = c(0.4,0.5,0.5) and # pi2 = 0.2 at event time 12, accrual time 12 and follow-up time 6 as default getPowerSurvival(maxNumberOfEvents = 40, maxNumberOfSubjects = 200) \donttest{ # Four stage O'Brien & Fleming group sequential design with minimum required # definitions, pi1 = c(0.4,0.5,0.5) and pi2 = 0.2 at event time 12, # accrual time 12 and follow-up time 6 as default getPowerSurvival(design = getDesignGroupSequential(kMax = 4), maxNumberOfEvents = 40, maxNumberOfSubjects = 200) # For fixed sample design, determine necessary accrual time if 200 subjects and # 30 subjects per time unit can be recruited getPowerSurvival(maxNumberOfEvents = 40, accrualTime = c(0), accrualIntensity = 30, maxNumberOfSubjects = 200) # Determine necessary accrual time if 200 subjects and if the first 6 time units # 20 subjects per time unit can be recruited, then 30 subjects per time unit getPowerSurvival(maxNumberOfEvents = 40, accrualTime = c(0, 6), accrualIntensity = c(20, 30), maxNumberOfSubjects = 200) # Determine maximum number of Subjects if the first 6 time units 20 subjects per # time unit can be recruited, and after 10 time units 30 subjects per time unit getPowerSurvival(maxNumberOfEvents = 40, accrualTime = c(0, 6, 10), accrualIntensity = c(20, 30)) # Specify accrual time as a list at <- list( "0 - <6" = 20, "6 - Inf" = 30) getPowerSurvival(maxNumberOfEvents = 40, accrualTime = at, maxNumberOfSubjects = 200) # Specify accrual time as a list, if maximum number of subjects need to be calculated at <- list( "0 - <6" = 20, "6 - <=10" = 30) getPowerSurvival(maxNumberOfEvents = 40, accrualTime = at) # Specify effect size for a two-stage group design with O'Brien & Fleming boundaries # Effect size is based on event rates at specified event time, directionUpper = FALSE # needs to be specified because it should be shown that hazard ratio < 1 getPowerSurvival(design = getDesignGroupSequential(kMax = 2), pi1 = 0.2, pi2 = 0.3, eventTime = 24, maxNumberOfEvents = 40, maxNumberOfSubjects = 200, directionUpper = FALSE) # Effect size is based on event rate at specified event time for the reference group # and hazard ratio, directionUpper = FALSE needs to be specified # because it should be shown that hazard ratio < 1 getPowerSurvival(design = getDesignGroupSequential(kMax = 2), hazardRatio = 0.5, pi2 = 0.3, eventTime = 24, maxNumberOfEvents = 40, maxNumberOfSubjects = 200, directionUpper = FALSE) # Effect size is based on hazard rate for the reference group and hazard ratio, # directionUpper = FALSE needs to be specified because it should be shown that # hazard ratio < 1 getPowerSurvival(design = getDesignGroupSequential(kMax = 2), hazardRatio = 0.5, lambda2 = 0.02, maxNumberOfEvents = 40, maxNumberOfSubjects = 200, directionUpper = FALSE) # Specification of piecewise exponential survival time and hazard ratios getPowerSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.01,0.02,0.04), hazardRatio = c(1.5, 1.8, 2), maxNumberOfEvents = 40, maxNumberOfSubjects = 200) # Specification of piecewise exponential survival time as list and hazard ratios pws <- list( "0 - <5" = 0.01, "5 - <10" = 0.02, ">=10" = 0.04) getPowerSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = pws, hazardRatio = c(1.5, 1.8, 2), maxNumberOfEvents = 40, maxNumberOfSubjects = 200) # Specification of piecewise exponential survival time for both treatment arms getPowerSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.01, 0.02, 0.04), lambda1 = c(0.015,0.03,0.06), maxNumberOfEvents = 40, maxNumberOfSubjects = 200) # Specification of piecewise exponential survival time as a list pws <- list( "0 - <5" = 0.01, "5 - <10" = 0.02, ">=10" = 0.04) getPowerSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = pws, hazardRatio = c(1.5, 1.8, 2), maxNumberOfEvents = 40, maxNumberOfSubjects = 200) # Specify effect size based on median survival times getPowerSurvival(median1 = 5, median2 = 3, maxNumberOfEvents = 40, maxNumberOfSubjects = 200, directionUpper = FALSE) # Specify effect size based on median survival times of # Weibull distribtion with kappa = 2 getPowerSurvival(median1 = 5, median2 = 3, kappa = 2, maxNumberOfEvents = 40, maxNumberOfSubjects = 200, directionUpper = FALSE) } } \seealso{ Other power functions: \code{\link{getPowerMeans}()}, \code{\link{getPowerRates}()} } \concept{power functions} rpact/man/SimulationResults.Rd0000644000175000017500000000123214107166520016265 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R \docType{class} \name{SimulationResults} \alias{SimulationResults} \title{Class for Simulation Results} \description{ A class for simulation results. } \details{ \code{SimulationResults} is the basic class for \itemize{ \item \code{\link{SimulationResultsMeans}}, \item \code{\link{SimulationResultsRates}}, \item \code{\link{SimulationResultsSurvival}}, \item \code{\link{SimulationResultsMultiArmMeans}}, \item \code{\link{SimulationResultsMultiArmRates}}, and \item \code{\link{SimulationResultsMultiArmSurvival}}. } } \keyword{internal} rpact/man/plot.Dataset.Rd0000644000175000017500000000521014046535122015121 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R \name{plot.Dataset} \alias{plot.Dataset} \title{Dataset Plotting} \usage{ \method{plot}{Dataset}( x, y, ..., main = "Dataset", xlab = "Stage", ylab = NA_character_, legendTitle = "Group", palette = "Set1", showSource = FALSE, plotSettings = NULL ) } \arguments{ \item{x}{The \code{\link{Dataset}} object to plot.} \item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} \item{...}{Optional plot arguments. At the moment \code{xlim} and \code{ylim} are implemented for changing x or y axis limits without dropping data observations.} \item{main}{The main title, default is \code{"Dataset"}.} \item{xlab}{The x-axis label, default is \code{"Stage"}.} \item{ylab}{The y-axis label.} \item{legendTitle}{The legend title, default is \code{"Group"}.} \item{palette}{The palette, default is \code{"Set1"}.} \item{showSource}{If \code{TRUE}, the parameter names of the object will be printed which were used to create the plot; that may be, e.g., useful to check the values or to create own plots with the base R \code{plot} function. Alternatively \code{showSource} can be defined as one of the following character values: \itemize{ \item \code{"commands"}: returns a character vector with plot commands \item \code{"axes"}: returns a list with the axes definitions \item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function does not stop if an error occurs) \item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function stops if an error occurs) } Note: no plot object will be returned if \code{showSource} is a character.} \item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link{getPlotSettings}}.} } \value{ Returns a \code{ggplot2} object. } \description{ Plots a dataset. } \details{ Generic function to plot all kinds of datasets. } \examples{ # Plot a dataset of means dataExample <- getDataset( n1 = c(22, 11, 22, 11), n2 = c(22, 13, 22, 13), means1 = c(1, 1.1, 1, 1), means2 = c(1.4, 1.5, 3, 2.5), stDevs1 = c(1, 2, 2, 1.3), stDevs2 = c(1, 2, 2, 1.3)) \donttest{ if (require(ggplot2)) plot(dataExample, main = "Comparison of Means") } # Plot a dataset of rates dataExample <- getDataset( n1 = c(8, 10, 9, 11), n2 = c(11, 13, 12, 13), events1 = c(3, 5, 5, 6), events2 = c(8, 10, 12, 12) ) \donttest{ if (require(ggplot2)) plot(dataExample, main = "Comparison of Rates") } } rpact/man/writeDataset.Rd0000644000175000017500000000560714020357214015225 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R \name{writeDataset} \alias{writeDataset} \title{Write Dataset} \usage{ writeDataset( dataset, file, ..., append = FALSE, quote = TRUE, sep = ",", eol = "\\n", na = "NA", dec = ".", row.names = TRUE, col.names = NA, qmethod = "double", fileEncoding = "UTF-8" ) } \arguments{ \item{dataset}{A dataset.} \item{file}{The target CSV file.} \item{...}{Further arguments to be passed to \code{\link[utils]{write.table}}.} \item{append}{Logical. Only relevant if file is a character string. If \code{TRUE}, the output is appended to the file. If \code{FALSE}, any existing file of the name is destroyed.} \item{quote}{The set of quoting characters. To disable quoting altogether, use quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only considered for columns read as character, which is all of them unless \code{colClasses} is specified.} \item{sep}{The field separator character. Values on each line of the file are separated by this character. If sep = "," (the default for \code{writeDataset}) the separator is a comma.} \item{eol}{The character(s) to print at the end of each line (row).} \item{na}{The string to use for missing values in the data.} \item{dec}{The character used in the file for decimal points.} \item{row.names}{Either a logical value indicating whether the row names of \code{dataset} are to be written along with \code{dataset}, or a character vector of row names to be written.} \item{col.names}{Either a logical value indicating whether the column names of \code{dataset} are to be written along with \code{dataset}, or a character vector of column names to be written. See the section on 'CSV files' for the meaning of \code{col.names = NA}.} \item{qmethod}{A character string specifying how to deal with embedded double quote characters when quoting strings. Must be one of "double" (default in \code{writeDataset}) or "escape".} \item{fileEncoding}{Character string: if non-empty declares the encoding used on a file (not a connection) so the character data can be re-encoded. See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'.} } \description{ Writes a dataset to a CSV file. } \details{ \code{\link{writeDataset}} is a wrapper function that coerces the dataset to a data frame and uses \cr \code{\link[utils]{write.table}} to write it to a CSV file. } \examples{ \dontrun{ datasetOfRates <- getDataset( n1 = c(11, 13, 12, 13), n2 = c(8, 10, 9, 11), events1 = c(10, 10, 12, 12), events2 = c(3, 5, 5, 6) ) writeDataset(datasetOfRates, "dataset_rates.csv") } } \seealso{ \itemize{ \item \code{\link{writeDatasets}} for writing multiple datasets, \item \code{\link{readDataset}} for reading a single dataset, \item \code{\link{readDatasets}} for reading multiple datasets. } } rpact/man/param_groups.Rd0000644000175000017500000000057214020357215015261 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_groups} \alias{param_groups} \title{Parameter Description: Number Of Treatment Groups} \arguments{ \item{groups}{The number of treatment groups (1 or 2), default is \code{2}.} } \description{ Parameter Description: Number Of Treatment Groups } \keyword{internal} rpact/man/SimulationResultsMultiArmRates.Rd0000644000175000017500000000066514020357214020744 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R \docType{class} \name{SimulationResultsMultiArmRates} \alias{SimulationResultsMultiArmRates} \title{Class for Simulation Results Multi-Arm Rates} \description{ A class for simulation results rates in multi-arm designs. } \details{ Use \code{\link{getSimulationMultiArmRates}} to create an object of this type. } \keyword{internal} rpact/man/param_pi2_rates.Rd0000644000175000017500000000067214020357215015633 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_pi2_rates} \alias{param_pi2_rates} \title{Parameter Description: Pi (2) for Rates} \arguments{ \item{pi2}{A numeric value that represents the assumed probability in the reference group if two treatment groups are considered, default is \code{0.2}.} } \description{ Parameter Description: Pi (2) for Rates } \keyword{internal} rpact/man/setOutputFormat.Rd0000644000175000017500000000755514060405737015766 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_core_output_formats.R \name{setOutputFormat} \alias{setOutputFormat} \title{Set Output Format} \usage{ setOutputFormat( parameterName = NA_character_, ..., digits = NA_integer_, nsmall = NA_integer_, trimSingleZeroes = NA, futilityProbabilityEnabled = NA, file = NA_character_, resetToDefault = FALSE, roundFunction = NA_character_ ) } \arguments{ \item{parameterName}{The name of the parameter whose output format shall be edited. Leave the default \code{NA_character_} if the output format of all parameters shall be edited.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{digits}{How many significant digits are to be used for a numeric value. The default, \code{NULL}, uses getOption("digits"). Allowed values are \code{0 <= digits <= 20}.} \item{nsmall}{The minimum number of digits to the right of the decimal point in formatting real numbers in non-scientific formats. Allowed values are \code{0 <= nsmall <= 20}.} \item{trimSingleZeroes}{If \code{TRUE} zero values will be trimmed in the output, e.g., "0.00" will displayed as "0"} \item{futilityProbabilityEnabled}{If \code{TRUE} very small value (< 1e-09) will be displayed as "0", default is \code{FALSE}.} \item{file}{An optional file name of an existing text file that contains output format definitions (see Details for more information).} \item{resetToDefault}{If \code{TRUE} all output formats will be reset to default value. Note that other settings will be executed afterwards if specified, default is \code{FALSE}.} \item{roundFunction}{A character value that specifies the R base round function to use, default is \code{NA_character_}. Allowed values are "ceiling", "floor", "trunc", "round", "signif", and \code{NA_character_}.} } \description{ With this function the format of the standard outputs of all \code{rpact} objects can be changed and set user defined respectively. } \details{ Output formats can be written to a text file (see \code{\link{getOutputFormat}}). To load your personal output formats read a formerly saved file at the beginning of your work with \code{rpact}, e.g. execute \code{setOutputFormat(file = "my_rpact_output_formats.txt")}. Note that the \code{parameterName} must not match exactly, e.g., for p-values the following parameter names will be recognized amongst others: \enumerate{ \item \code{p value} \item \code{p.values} \item \code{p-value} \item \code{pValue} \item \code{rpact.output.format.p.value} } } \examples{ # show output format of p values getOutputFormat("p.value") \donttest{ # set new p value output format setOutputFormat("p.value", digits = 5, nsmall = 5) # show sample sizes as smallest integers not less than the not rounded values setOutputFormat("sample size", digits = 0, nsmall = 0, roundFunction = "ceiling") getSampleSizeMeans() # show sample sizes as smallest integers not greater than the not rounded values setOutputFormat("sample size", digits = 0, nsmall = 0, roundFunction = "floor") getSampleSizeMeans() # set new sample size output format without round function setOutputFormat("sample size", digits = 2, nsmall = 2) getSampleSizeMeans() # reset sample size output format to default setOutputFormat("sample size") getSampleSizeMeans() getOutputFormat("sample size") # write current output format definitions to file getOutputFormat(file = "rpact_options.txt") # write default output format definitions to file getOutputFormat(file = "rpact_options.txt", default = TRUE) # load and set output format definitions from file setOutputFormat(file = "rpact_options.txt") } } \seealso{ \code{\link[base]{format}} for details on the function used internally to format the values. Other output formats: \code{\link{getOutputFormat}()} } \concept{output formats} rpact/man/getSimulationEnrichmentSurvival.Rd0000644000175000017500000002700314154651532021164 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_simulation_enrichment_survival.R \name{getSimulationEnrichmentSurvival} \alias{getSimulationEnrichmentSurvival} \title{Get Simulation Enrichment Survival} \usage{ getSimulationEnrichmentSurvival( design = NULL, ..., populations = NA_integer_, effectList = NULL, intersectionTest = c("Simes", "SpiessensDebois", "Bonferroni", "Sidak"), stratifiedAnalysis = TRUE, directionUpper = TRUE, adaptations = NA, typeOfSelection = c("best", "rBest", "epsilon", "all", "userDefined"), effectMeasure = c("effectEstimate", "testStatistic"), successCriterion = c("all", "atLeastOne"), epsilonValue = NA_real_, rValue = NA_real_, threshold = -Inf, plannedEvents = NA_real_, allocationRatioPlanned = NA_real_, minNumberOfEventsPerStage = NA_real_, maxNumberOfEventsPerStage = NA_real_, conditionalPower = NA_real_, thetaH1 = NA_real_, maxNumberOfIterations = 1000L, seed = NA_real_, calcEventsFunction = NULL, selectPopulationsFunction = NULL, showStatistics = FALSE ) } \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{populations}{The number of populations in a two-sample comparison, default is \code{3}.} \item{effectList}{List of effect sizes with columns and number of rows reflecting the different situations to consider (see examples).} \item{intersectionTest}{Defines the multiple test for the intersection hypotheses in the closed system of hypotheses. Four options are available in enrichment designs: \code{"SpiessensDebois"}, \code{"Bonferroni"}, \code{"Simes"}, and \code{"Sidak"}, default is \code{"Simes"}.} \item{stratifiedAnalysis}{For enrichment designs, typically a stratified analysis should be chosen. For testing rates, also a non-stratified analysis based on overall data can be performed. For survival data, only a stratified analysis is possible (see Brannath et al., 2009), default is \code{TRUE}.} \item{directionUpper}{Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values.} \item{adaptations}{A vector of length \code{kMax - 1} indicating whether or not an adaptation takes place at interim k, default is \code{rep(TRUE, kMax - 1)}.} \item{typeOfSelection}{The way the treatment arms or populations are selected at interim. Five options are available: \code{"best"}, \code{"rbest"}, \code{"epsilon"}, \code{"all"}, and \code{"userDefined"}, default is \code{"best"}.\cr For \code{"rbest"} (select the \code{rValue} best treatment arms/populations), the parameter \code{rValue} has to be specified, for \code{"epsilon"} (select treatment arm/population not worse than epsilon compared to the best), the parameter \code{epsilonValue} has to be specified. If \code{"userDefined"} is selected, \code{"selectArmsFunction"} or \code{"selectPopulationsFunction"} has to be specified.} \item{effectMeasure}{Criterion for treatment arm/population selection, either based on test statistic (\code{"testStatistic"}) or effect estimate (difference for means and rates or ratio for survival) (\code{"effectEstimate"}), default is \code{"effectEstimate"}.} \item{successCriterion}{Defines when the study is stopped for efficacy at interim. Two options are available: \code{"all"} stops the trial if the efficacy criterion is fulfilled for all selected treatment arms/populations, \code{"atLeastOne"} stops if at least one of the selected treatment arms/populations is shown to be superior to control at interim, default is \code{"all"}.} \item{epsilonValue}{For \code{typeOfSelection = "epsilon"} (select treatment arm / population not worse than epsilon compared to the best), the parameter \code{epsilonValue} has to be specified.} \item{rValue}{For \code{typeOfSelection = "rbest"} (select the \code{rValue} best treatment arms / populations), the parameter \code{rValue} has to be specified.} \item{threshold}{Selection criterion: treatment arm / population is selected only if \code{effectMeasure} exceeds \code{threshold}, default is \code{-Inf}. \code{threshold} can also be a vector of length \code{activeArms} referring to a separate threshold condition over the treatment arms.} \item{plannedEvents}{\code{plannedEvents} is a vector of length \code{kMax} (the number of stages of the design) that determines the number of cumulated (overall) events in survival designs when the interim stages are planned. For two treatment arms, it is the number of events for both treatment arms. For multi-arm designs, \code{plannedEvents} refers to the overall number of events for the selected arms plus control.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} \item{minNumberOfEventsPerStage}{When performing a data driven sample size recalculation, the vector \code{minNumberOfEventsPerStage} with length kMax determines the minimum number of events per stage (i.e., not cumulated), the first element is not taken into account.} \item{maxNumberOfEventsPerStage}{When performing a data driven sample size recalculation, the vector \code{maxNumberOfEventsPerStage} with length kMax determines the maximum number of events per stage (i.e., not cumulated), the first element is not taken into account.} \item{conditionalPower}{If \code{conditionalPower} together with \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (or \code{minNumberOfEventsPerStage} and \code{maxNumberOfEventsPerStage} for survival designs) is specified, a sample size recalculation based on the specified conditional power is performed. It is defined as the power for the subsequent stage given the current data. By default, the conditional power will be calculated under the observed effect size. Optionally, you can also specify \code{thetaH1} and \code{stDevH1} (for simulating means), \code{pi1H1} and \code{pi2H1} (for simulating rates), or \code{thetaH1} (for simulating hazard ratios) as parameters under which it is calculated and the sample size recalculation is performed.} \item{thetaH1}{If specified, the value of the alternative under which the conditional power or sample size recalculation calculation is performed.} \item{maxNumberOfIterations}{The number of simulation iterations, default is \code{1000}.} \item{seed}{The seed to reproduce the simulation, default is a random seed.} \item{calcEventsFunction}{Optionally, a function can be entered that defines the way of performing the sample size recalculation. By default, sample size recalculation is performed with conditional power with specified \code{minNumberOfEventsPerStage} and \code{maxNumberOfEventsPerStage} (see details and examples).} \item{selectPopulationsFunction}{Optionally, a function can be entered that defines the way of how populations are selected. This function is allowed to depend on \code{effectVector} with length \code{populations} and \code{stage} (see examples).} \item{showStatistics}{If \code{TRUE}, summary statistics of the simulated data are displayed for the \code{print} command, otherwise the output is suppressed, default is \code{FALSE}.} } \value{ Returns a \code{\link{SimulationResults}} object. The following generics (R generic functions) are available for this object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.SimulationResults]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the simulated power, stopping and selection probabilities, conditional power, and expected sample size for testing hazard ratios in an enrichment design testing situation. In contrast to \code{getSimulationSurvival()} (where survival times are simulated), normally distributed logrank test statistics are simulated. } \details{ At given design the function simulates the power, stopping probabilities, selection probabilities, and expected event number at given number of events, parameter configuration, and population selection rule in the enrichment situation. An allocation ratio can be specified referring to the ratio of number of subjects in the active treatment group as compared to the control group. The definition of \code{thetaH1} makes only sense if \code{kMax} > 1 and if \code{conditionalPower}, \code{minNumberOfEventsPerStage}, and \code{maxNumberOfEventsPerStage} (or \code{calcEventsFunction}) are defined. \code{calcEventsFunction}\cr This function returns the number of events at given conditional power and conditional critical value for specified testing situation. The function might depend on the variables \code{stage}, \code{selectedPopulations}, \code{plannedEvents}, \code{directionUpper}, \code{allocationRatioPlanned}, \code{minNumberOfEventsPerStage}, \code{maxNumberOfEventsPerStage}, \code{conditionalPower}, \code{conditionalCriticalValue}, and \code{overallEffects}. The function has to contain the three-dots argument '...' (see examples). } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ \donttest{ # Assess a population selection strategy with one subset population and # a survival endpoint. The considered situations are defined through the # event rates yielding a range of hazard ratios in the subsets. Design # with O'Brien and Fleming alpha spending and a reassessment of event # number in the first interim based on conditional power and assumed # hazard ratio using weighted inverse normal combination test. subGroups <- c("S", "R") prevalences <- c(0.40, 0.60) p2 <- c(0.3, 0.4) range1 <- p2[1] + seq(0, 0.3, 0.05) p1 <- c() for (x1 in range1){ p1 <- c(p1, x1, p2[2] + 0.1) } hazardRatios <- log(matrix(1 - p1, byrow = TRUE, ncol = 2)) / matrix(log(1 - p2), byrow = TRUE, ncol = 2, nrow = length(range1)) effectList <- list(subGroups=subGroups, prevalences=prevalences, hazardRatios = hazardRatios) ds <- getDesignInverseNormal(informationRates = c(0.3, 0.7, 1), typeOfDesign = "asOF") simResultsPE <- getSimulationEnrichmentSurvival(ds, plannedEvents = c(40, 90, 120), effectList = effectList, typeOfSelection = "rbest", rValue = 2, conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA,50,30), maxNumberOfEventsPerStage = c(NA,150,30), thetaH1 = 4/3, maxNumberOfIterations = 100) print(simResultsPE) } } rpact/man/TrialDesignSet_names.Rd0000644000175000017500000000136414020357214016625 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_set.R \name{TrialDesignSet_names} \alias{TrialDesignSet_names} \alias{names.TrialDesignSet} \title{Names of a Trial Design Set Object} \usage{ \method{names}{TrialDesignSet}(x) } \arguments{ \item{x}{A \code{\link{TrialDesignSet}} object.} } \value{ Returns a \code{\link[base]{character}} vector containing the names of the \code{\link{AnalysisResults}} object. } \description{ Function to get the names of a \code{\link{TrialDesignSet}} object. } \details{ Returns the names of a design set that can be accessed by the user. } \examples{ designSet <- getDesignSet(design = getDesignGroupSequential(), alpha = c(0.01, 0.05)) names(designSet) } \keyword{internal} rpact/man/dataEnrichmentMeansStratified.Rd0000644000175000017500000000107514102177375020522 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{dataEnrichmentMeansStratified} \alias{dataEnrichmentMeansStratified} \title{Stratified Enrichment Dataset of Means} \format{ A \code{\link[base]{data.frame}} object. } \usage{ dataEnrichmentMeansStratified } \description{ A dataset containing the sample sizes, means, and standard deviations of two groups. Use \code{getDataset(dataEnrichmentMeansStratified)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. } \keyword{datasets} rpact/man/FrameSet_as.matrix.Rd0000644000175000017500000000175514046540575016275 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_parameter_set.R \name{FrameSet_as.matrix} \alias{FrameSet_as.matrix} \alias{as.matrix.FieldSet} \title{Coerce Frame Set to a Matrix} \usage{ \method{as.matrix}{FieldSet}(x, ..., enforceRowNames = TRUE, niceColumnNamesEnabled = TRUE) } \arguments{ \item{x}{A \code{\link{FieldSet}} object.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{enforceRowNames}{If \code{TRUE}, row names will be created depending on the object type, default is \code{TRUE}.} \item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column names will be used; syntactic names (variable names) otherwise (see \code{\link[base]{make.names}}).} } \value{ Returns a \code{\link[base]{matrix}}. } \description{ Returns the \code{FrameSet} as matrix. } \details{ Coerces the frame set to a matrix. } \keyword{internal} rpact/man/param_successCriterion.Rd0000644000175000017500000000126014102177376017275 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_successCriterion} \alias{param_successCriterion} \title{Parameter Description: Success Criterion} \arguments{ \item{successCriterion}{Defines when the study is stopped for efficacy at interim. Two options are available: \code{"all"} stops the trial if the efficacy criterion is fulfilled for all selected treatment arms/populations, \code{"atLeastOne"} stops if at least one of the selected treatment arms/populations is shown to be superior to control at interim, default is \code{"all"}.} } \description{ Parameter Description: Success Criterion } \keyword{internal} rpact/man/param_alternative.Rd0000644000175000017500000000077514051453525016272 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_alternative} \alias{param_alternative} \title{Parameter Description: Alternative} \arguments{ \item{alternative}{The alternative hypothesis value for testing means. This can be a vector of assumed alternatives, default is \code{seq(0, 1, 0.2)} (power calculations) or \code{seq(0.2, 1, 0.2)} (sample size calculations).} } \description{ Parameter Description: Alternative } \keyword{internal} rpact/man/DatasetMeans.Rd0000644000175000017500000000117614020357214015133 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R \docType{class} \name{DatasetMeans} \alias{DatasetMeans} \title{Dataset of Means} \description{ Class for a dataset of means. } \details{ This object cannot be created directly; better use \code{\link{getDataset}} with suitable arguments to create a dataset of means. } \section{Fields}{ \describe{ \item{\code{groups}}{The group numbers.} \item{\code{stages}}{The stage numbers.} \item{\code{sampleSizes}}{The sample sizes.} \item{\code{means}}{The means.} \item{\code{stDevs}}{The standard deviations.} }} \keyword{internal} rpact/man/getWideFormat.Rd0000644000175000017500000000125714051425051015322 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_analysis_utilities.R \name{getWideFormat} \alias{getWideFormat} \title{Get Wide Format} \usage{ getWideFormat(dataInput) } \value{ A \code{\link[base]{data.frame}} will be returned. } \description{ Returns the specified dataset as a \code{\link[base]{data.frame}} in so-called wide format. } \details{ In the wide format (unstacked), the data are presented with each different data variable in a separate column, i.e., the different groups are in separate columns. } \seealso{ \code{\link{getLongFormat}} for returning the dataset as a \code{\link[base]{data.frame}} in long format. } \keyword{internal} rpact/man/AnalysisResultsMultiArmFisher.Rd0000644000175000017500000000151614020357214020541 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsMultiArmFisher} \alias{AnalysisResultsMultiArmFisher} \alias{AnalysisResultsEnrichmentFisher} \title{Analysis Results Multi-Arm Fisher} \description{ Class for multi-arm analysis results based on a Fisher combination test design. Class for multi-arm analysis results based on a Fisher combination test design. } \details{ This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. } \keyword{internal} rpact/man/param_nMax.Rd0000644000175000017500000000044514020357215014644 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_nMax} \alias{param_nMax} \title{Parameter Description: N_max} \arguments{ \item{nMax}{The maximum sample size.} } \description{ Parameter Description: N_max } \keyword{internal} rpact/man/getObservedInformationRates.Rd0000644000175000017500000000453414153377720020254 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_analysis_utilities.R \name{getObservedInformationRates} \alias{getObservedInformationRates} \title{Get Observed Information Rates} \usage{ getObservedInformationRates( dataInput, ..., maxInformation = NULL, informationEpsilon = NULL, stage = NA_integer_ ) } \arguments{ \item{dataInput}{The dataset for which the information rates shall be recalculated.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{maxInformation}{Positive integer value specifying the maximum information.} \item{informationEpsilon}{Positive integer value specifying the absolute information epsilon, which defines the maximum distance from the observed information to the maximum information that causes the final analysis. Updates at the final analysis in case the observed information at the final analysis is smaller ("under-running") than the planned maximum information \code{maxInformation}, default is 0. Alternatively, a floating-point number > 0 and < 1 can be specified to define a relative information epsilon.} \item{stage}{The stage number (optional). Default: total number of existing stages in the data input.} } \description{ Recalculates the observed information rates from the specified dataset. } \details{ For means and rates the maximum information is the maximum number of subjects or the relative proportion if \code{informationEpsilon} < 1; for survival data it is the maximum number of events or the relative proportion if \code{informationEpsilon} < 1. } \examples{ # Absolute information epsilon: # decision rule 45 >= 46 - 1, i.e., under-running data <- getDataset ( overallN = c(22, 45), overallEvents = c(11, 28)) getObservedInformationRates (data, maxInformation = 46, informationEpsilon = 1) # Relative information epsilon: # last information rate = 45/46 = 0.9783, # is > 1 - 0.03 = 0.97, i.e., under-running data <- getDataset ( overallN = c(22, 45), overallEvents = c(11, 28)) getObservedInformationRates (data, maxInformation = 46, informationEpsilon = 0.03) } \seealso{ \itemize{ \item \code{\link{getAnalysisResults}} for using \code{getObservedInformationRates} implicit, \item https://www.rpact.com/vignettes/rpact_boundary_update_example } } rpact/man/param_theta.Rd0000644000175000017500000000055114020357215015044 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_theta} \alias{param_theta} \title{Parameter Description: Theta} \arguments{ \item{theta}{A vector of standardized effect sizes (theta values), default is a sequence from -1 to 1.} } \description{ Parameter Description: Theta } \keyword{internal} rpact/man/TrialDesignInverseNormal.Rd0000644000175000017500000000101414020357214017463 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R \docType{class} \name{TrialDesignInverseNormal} \alias{TrialDesignInverseNormal} \title{Inverse Normal Design} \description{ Trial design for inverse normal method. } \details{ This object should not be created directly; use \code{\link{getDesignInverseNormal}} with suitable arguments to create a inverse normal design. } \seealso{ \code{\link{getDesignInverseNormal}} for creating a inverse normal design. } \keyword{internal} rpact/man/param_allocationRatioPlanned_sampleSize.Rd0000644000175000017500000000122314020357215022556 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_allocationRatioPlanned_sampleSize} \alias{param_allocationRatioPlanned_sampleSize} \title{Parameter Description: Allocation Ratio Planned With Optimum Option} \arguments{ \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. If \code{allocationRatioPlanned = 0} is entered, the optimal allocation ratio yielding the smallest overall sample size is determined.} } \description{ Parameter Description: Allocation Ratio Planned With Optimum Option } \keyword{internal} rpact/man/TrialDesignCharacteristics_as.data.frame.Rd0000644000175000017500000000261414020357214022505 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R \name{TrialDesignCharacteristics_as.data.frame} \alias{TrialDesignCharacteristics_as.data.frame} \alias{as.data.frame.TrialDesignCharacteristics} \title{Coerce TrialDesignCharacteristics to a Data Frame} \usage{ \method{as.data.frame}{TrialDesignCharacteristics}( x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ... ) } \arguments{ \item{x}{A \code{\link{TrialDesignCharacteristics}} object.} \item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column names will be used; syntactic names (variable names) otherwise (see \code{\link[base]{make.names}}).} \item{includeAllParameters}{Logical. If \code{TRUE}, all available parameters will be included in the data frame; a meaningful parameter selection otherwise, default is \code{FALSE}.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} } \value{ Returns a \code{\link[base]{data.frame}}. } \description{ Returns the \code{TrialDesignCharacteristics} as data frame. } \details{ Each element of the \code{\link{TrialDesignCharacteristics}} is converted to a column in the data frame. } \examples{ as.data.frame(getDesignCharacteristics(getDesignGroupSequential())) } \keyword{internal} rpact/man/getSimulationMultiArmSurvival.Rd0000644000175000017500000003200014153377720020616 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_simulation_multiarm_survival.R \name{getSimulationMultiArmSurvival} \alias{getSimulationMultiArmSurvival} \title{Get Simulation Multi-Arm Survival} \usage{ getSimulationMultiArmSurvival( design = NULL, ..., activeArms = 3L, effectMatrix = NULL, typeOfShape = c("linear", "sigmoidEmax", "userDefined"), omegaMaxVector = seq(1, 2.6, 0.4), gED50 = NA_real_, slope = 1, intersectionTest = c("Dunnett", "Bonferroni", "Simes", "Sidak", "Hierarchical"), directionUpper = TRUE, adaptations = NA, typeOfSelection = c("best", "rBest", "epsilon", "all", "userDefined"), effectMeasure = c("effectEstimate", "testStatistic"), successCriterion = c("all", "atLeastOne"), correlationComputation = c("alternative", "null"), epsilonValue = NA_real_, rValue = NA_real_, threshold = -Inf, plannedEvents = NA_real_, allocationRatioPlanned = NA_real_, minNumberOfEventsPerStage = NA_real_, maxNumberOfEventsPerStage = NA_real_, conditionalPower = NA_real_, thetaH1 = NA_real_, maxNumberOfIterations = 1000L, seed = NA_real_, calcEventsFunction = NULL, selectArmsFunction = NULL, showStatistics = FALSE ) } \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{activeArms}{The number of active treatment arms to be compared with control, default is \code{3}.} \item{effectMatrix}{Matrix of effect sizes with \code{activeArms} columns and number of rows reflecting the different situations to consider.} \item{typeOfShape}{The shape of the dose-response relationship over the treatment groups. This can be either \code{"linear"}, \code{"sigmoidEmax"}, or \code{"userDefined"}. If \code{"sigmoidEmax"} is selected, \code{"gED50"} and \code{"slope"} has to be entered to specify the ED50 and the slope of the sigmoid Emax model. For \code{"linear"} and \code{"sigmoidEmax"}, \code{"muMaxVector"} specifies the range of effect sizes for the treatment group with highest response. If \code{"userDefined"} is selected, \code{"effectMatrix"} has to be entered.} \item{omegaMaxVector}{Range of hazard ratios with highest response for \code{"linear"} and \code{"sigmoidEmax"} model, default is \code{seq(1, 2.6, 0.4)}.} \item{gED50}{If \code{typeOfShape = "sigmoidEmax"} is selected, \code{"gED50"} has to be entered to specify the ED50 of the sigmoid Emax model.} \item{slope}{If \code{typeOfShape = "sigmoidEmax"} is selected, \code{"slope"} can be entered to specify the slope of the sigmoid Emax model, default is 1.} \item{intersectionTest}{Defines the multiple test for the intersection hypotheses in the closed system of hypotheses. Five options are available in multi-arm designs: \code{"Dunnett"}, \code{"Bonferroni"}, \code{"Simes"}, \code{"Sidak"}, and \code{"Hierarchical"}, default is \code{"Dunnett"}.} \item{directionUpper}{Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values.} \item{adaptations}{A vector of length \code{kMax - 1} indicating whether or not an adaptation takes place at interim k, default is \code{rep(TRUE, kMax - 1)}.} \item{typeOfSelection}{The way the treatment arms or populations are selected at interim. Five options are available: \code{"best"}, \code{"rbest"}, \code{"epsilon"}, \code{"all"}, and \code{"userDefined"}, default is \code{"best"}.\cr For \code{"rbest"} (select the \code{rValue} best treatment arms/populations), the parameter \code{rValue} has to be specified, for \code{"epsilon"} (select treatment arm/population not worse than epsilon compared to the best), the parameter \code{epsilonValue} has to be specified. If \code{"userDefined"} is selected, \code{"selectArmsFunction"} or \code{"selectPopulationsFunction"} has to be specified.} \item{effectMeasure}{Criterion for treatment arm/population selection, either based on test statistic (\code{"testStatistic"}) or effect estimate (difference for means and rates or ratio for survival) (\code{"effectEstimate"}), default is \code{"effectEstimate"}.} \item{successCriterion}{Defines when the study is stopped for efficacy at interim. Two options are available: \code{"all"} stops the trial if the efficacy criterion is fulfilled for all selected treatment arms/populations, \code{"atLeastOne"} stops if at least one of the selected treatment arms/populations is shown to be superior to control at interim, default is \code{"all"}.} \item{correlationComputation}{If \code{correlationComputation = "alternative"}, for simulating log-rank statistics in the many-to-one design, a correlation matrix according to Deng et al. (Biometrics, 2019) accounting for the respective alternative is used; if \code{correlationComputation = "null"}, a constant correlation matrix valid under the null, i.e., not accounting for the alternative is used, default is \code{"alternative"}.} \item{epsilonValue}{For \code{typeOfSelection = "epsilon"} (select treatment arm / population not worse than epsilon compared to the best), the parameter \code{epsilonValue} has to be specified.} \item{rValue}{For \code{typeOfSelection = "rbest"} (select the \code{rValue} best treatment arms / populations), the parameter \code{rValue} has to be specified.} \item{threshold}{Selection criterion: treatment arm / population is selected only if \code{effectMeasure} exceeds \code{threshold}, default is \code{-Inf}. \code{threshold} can also be a vector of length \code{activeArms} referring to a separate threshold condition over the treatment arms.} \item{plannedEvents}{\code{plannedEvents} is a vector of length \code{kMax} (the number of stages of the design) that determines the number of cumulated (overall) events in survival designs when the interim stages are planned. For two treatment arms, it is the number of events for both treatment arms. For multi-arm designs, \code{plannedEvents} refers to the overall number of events for the selected arms plus control.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} \item{minNumberOfEventsPerStage}{When performing a data driven sample size recalculation, the vector \code{minNumberOfEventsPerStage} with length kMax determines the minimum number of events per stage (i.e., not cumulated), the first element is not taken into account.} \item{maxNumberOfEventsPerStage}{When performing a data driven sample size recalculation, the vector \code{maxNumberOfEventsPerStage} with length kMax determines the maximum number of events per stage (i.e., not cumulated), the first element is not taken into account.} \item{conditionalPower}{If \code{conditionalPower} together with \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (or \code{minNumberOfEventsPerStage} and \code{maxNumberOfEventsPerStage} for survival designs) is specified, a sample size recalculation based on the specified conditional power is performed. It is defined as the power for the subsequent stage given the current data. By default, the conditional power will be calculated under the observed effect size. Optionally, you can also specify \code{thetaH1} and \code{stDevH1} (for simulating means), \code{pi1H1} and \code{pi2H1} (for simulating rates), or \code{thetaH1} (for simulating hazard ratios) as parameters under which it is calculated and the sample size recalculation is performed.} \item{thetaH1}{If specified, the value of the alternative under which the conditional power or sample size recalculation calculation is performed.} \item{maxNumberOfIterations}{The number of simulation iterations, default is \code{1000}.} \item{seed}{The seed to reproduce the simulation, default is a random seed.} \item{calcEventsFunction}{Optionally, a function can be entered that defines the way of performing the sample size recalculation. By default, sample size recalculation is performed with conditional power with specified \code{minNumberOfEventsPerStage} and \code{maxNumberOfEventsPerStage} (see details and examples).} \item{selectArmsFunction}{Optionally, a function can be entered that defines the way of how treatment arms are selected. This function is allowed to depend on \code{effectVector} with length \code{activeArms} and \code{stage} (see examples).} \item{showStatistics}{If \code{TRUE}, summary statistics of the simulated data are displayed for the \code{print} command, otherwise the output is suppressed, default is \code{FALSE}.} } \value{ Returns a \code{\link{SimulationResults}} object. The following generics (R generic functions) are available for this object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.SimulationResults]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the simulated power, stopping and selection probabilities, conditional power, and expected sample size for testing hazard ratios in a multi-arm treatment groups testing situation. In contrast to \code{getSimulationSurvival()} (where survival times are simulated), normally distributed logrank test statistics are simulated. } \details{ At given design the function simulates the power, stopping probabilities, selection probabilities, and expected sample size at given number of subjects, parameter configuration, and treatment arm selection rule in the multi-arm situation. An allocation ratio can be specified referring to the ratio of number of subjects in the active treatment groups as compared to the control group. The definition of \code{thetaH1} makes only sense if \code{kMax} > 1 and if \code{conditionalPower}, \code{minNumberOfEventsPerStage}, and \code{maxNumberOfEventsPerStage} (or \code{calcEventsFunction}) are defined. \code{calcEventsFunction}\cr This function returns the number of events at given conditional power and conditional critical value for specified testing situation. The function might depend on the variables \code{stage}, \code{selectedArms}, \code{plannedEvents}, \code{directionUpper}, \code{allocationRatioPlanned}, \code{minNumberOfEventsPerStage}, \code{maxNumberOfEventsPerStage}, \code{conditionalPower}, \code{conditionalCriticalValue}, and \code{overallEffects}. The function has to contain the three-dots argument '...' (see examples). } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ \donttest{ # Assess different selection rules for a two-stage survival design with # O'Brien & Fleming alpha spending boundaries and (non-binding) stopping # for futility if the test statistic is negative. # Number of events at the second stage is adjusted based on conditional # power 80\% and specified minimum and maximum number of Events. maxNumberOfIterations <- 50 design <- getDesignInverseNormal(typeOfDesign = "asOF", futilityBounds = 0) y1 <- getSimulationMultiArmSurvival(design = design, activeArms = 4, intersectionTest = "Simes", typeOfShape = "sigmoidEmax", omegaMaxVector = seq(1, 2, 0.5), gED50 = 2, slope = 4, typeOfSelection = "best", conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA_real_, 30), maxNumberOfEventsPerStage = c(NA_real_, 90), maxNumberOfIterations = maxNumberOfIterations, plannedEvents = c(75, 120)) y2 <- getSimulationMultiArmSurvival(design = design, activeArms = 4, intersectionTest = "Simes", typeOfShape = "sigmoidEmax", omegaMaxVector = seq(1,2,0.5), gED50 = 2, slope = 4, typeOfSelection = "epsilon", epsilonValue = 0.2, effectMeasure = "effectEstimate", conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA_real_, 30), maxNumberOfEventsPerStage = c(NA_real_, 90), maxNumberOfIterations = maxNumberOfIterations, plannedEvents = c(75, 120)) y1$effectMatrix y1$rejectAtLeastOne y2$rejectAtLeastOne y1$selectedArms y2$selectedArms } } rpact/man/param_kMax.Rd0000644000175000017500000000102214026041554014633 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_kMax} \alias{param_kMax} \title{Parameter Description: Maximum Number of Stages} \arguments{ \item{kMax}{The maximum number of stages \code{K}. \code{K = 1, 2, 3, ...} (default is \code{3}). The maximum selectable \code{kMax} is \code{20} for group sequential or inverse normal and \code{6} for Fisher combination test designs.} } \description{ Parameter Description: Maximum Number of Stages } \keyword{internal} rpact/man/getSimulationSurvival.Rd0000644000175000017500000006350314153377720017157 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_simulation_base_survival.R \name{getSimulationSurvival} \alias{getSimulationSurvival} \title{Get Simulation Survival} \usage{ getSimulationSurvival( design = NULL, ..., thetaH0 = 1, directionUpper = TRUE, pi1 = NA_real_, pi2 = NA_real_, lambda1 = NA_real_, lambda2 = NA_real_, median1 = NA_real_, median2 = NA_real_, hazardRatio = NA_real_, kappa = 1, piecewiseSurvivalTime = NA_real_, allocation1 = 1, allocation2 = 1, eventTime = 12L, accrualTime = c(0L, 12L), accrualIntensity = 0.1, accrualIntensityType = c("auto", "absolute", "relative"), dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12L, maxNumberOfSubjects = NA_real_, plannedEvents = NA_real_, minNumberOfEventsPerStage = NA_real_, maxNumberOfEventsPerStage = NA_real_, conditionalPower = NA_real_, thetaH1 = NA_real_, maxNumberOfIterations = 1000L, maxNumberOfRawDatasetsPerStage = 0, longTimeSimulationAllowed = FALSE, seed = NA_real_, showStatistics = FALSE ) } \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{thetaH0}{The null hypothesis value, default is \code{0} for the normal and the binary case (testing means and rates, respectively), it is \code{1} for the survival case (testing the hazard ratio).\cr\cr For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. That is, in case of (one-sided) testing of \itemize{ \item \emph{means}: a value \code{!= 0} (or a value \code{!= 1} for testing the mean ratio) can be specified. \item \emph{rates}: a value \code{!= 0} (or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. \item \emph{survival data}: a bound for testing H0: \code{hazard ratio = thetaH0 != 1} can be specified. } For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for defining the null hypothesis H0: \code{pi = thetaH0}.} \item{directionUpper}{Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values.} \item{pi1}{A numeric value or vector that represents the assumed event rate in the treatment group, default is \code{seq(0.2, 0.5, 0.1)} (power calculations and simulations) or \code{seq(0.4, 0.6, 0.1)} (sample size calculations).} \item{pi2}{A numeric value that represents the assumed event rate in the control group, default is \code{0.2}.} \item{lambda1}{The assumed hazard rate in the treatment group, there is no default. \code{lambda1} can also be used to define piecewise exponentially distributed survival times (see details).} \item{lambda2}{The assumed hazard rate in the reference group, there is no default. \code{lambda2} can also be used to define piecewise exponentially distributed survival times (see details).} \item{median1}{The assumed median survival time in the treatment group, there is no default.} \item{median2}{The assumed median survival time in the reference group, there is no default.} \item{hazardRatio}{The vector of hazard ratios under consideration. If the event or hazard rates in both treatment groups are defined, the hazard ratio needs not to be specified as it is calculated, there is no default.} \item{kappa}{A numeric value > 0. A \code{kappa != 1} will be used for the specification of the shape of the Weibull distribution. Default is \code{1}, i.e., the exponential survival distribution is used instead of the Weibull distribution. Note that the Weibull distribution cannot be used for the piecewise definition of the survival time distribution, i.e., only \code{piecewiselambda} (as a single value) and \code{kappa} can be specified. This function is equivalent to \code{pweibull(t, shape = kappa, scale = 1 / lambda)} of the \code{stats} package, i.e., the scale parameter is \code{1 / 'hazard rate'}.\cr For example, \code{getPiecewiseExponentialDistribution(time = 130, piecewiseLambda = 0.01, kappa = 4.2)} and \code{pweibull(q = 130, shape = 4.2, scale = 1 / 0.01)} provide the sample result.} \item{piecewiseSurvivalTime}{A vector that specifies the time intervals for the piecewise definition of the exponential survival time cumulative distribution function \cr (for details see \code{\link{getPiecewiseSurvivalTime}}).} \item{allocation1}{The number how many subjects are assigned to treatment 1 in a subsequent order, default is \code{1}} \item{allocation2}{The number how many subjects are assigned to treatment 2 in a subsequent order, default is \code{1}} \item{eventTime}{The assumed time under which the event rates are calculated, default is \code{12}.} \item{accrualTime}{The assumed accrual time intervals for the study, default is \code{c(0, 12)} (for details see \code{\link{getAccrualTime}}).} \item{accrualIntensity}{A vector of accrual intensities, default is the relative intensity \code{0.1} (for details see \code{\link{getAccrualTime}}).} \item{accrualIntensityType}{A character value specifying the accrual intensity input type. Must be one of \code{"auto"}, \code{"absolute"}, or \code{"relative"}; default is \code{"auto"}, i.e., if all values are < 1 the type is \code{"relative"}, otherwise it is \code{"absolute"}.} \item{dropoutRate1}{The assumed drop-out rate in the treatment group, default is \code{0}.} \item{dropoutRate2}{The assumed drop-out rate in the control group, default is \code{0}.} \item{dropoutTime}{The assumed time for drop-out rates in the control and the treatment group, default is \code{12}.} \item{maxNumberOfSubjects}{\code{maxNumberOfSubjects > 0} needs to be specified. If accrual time and accrual intensity is specified, this will be calculated.} \item{plannedEvents}{\code{plannedEvents} is a vector of length \code{kMax} (the number of stages of the design) that determines the number of cumulated (overall) events in survival designs when the interim stages are planned. For two treatment arms, it is the number of events for both treatment arms. For multi-arm designs, \code{plannedEvents} refers to the overall number of events for the selected arms plus control.} \item{minNumberOfEventsPerStage}{When performing a data driven sample size recalculation, the vector \code{minNumberOfEventsPerStage} with length kMax determines the minimum number of events per stage (i.e., not cumulated), the first element is not taken into account.} \item{maxNumberOfEventsPerStage}{When performing a data driven sample size recalculation, the vector \code{maxNumberOfEventsPerStage} with length kMax determines the maximum number of events per stage (i.e., not cumulated), the first element is not taken into account.} \item{conditionalPower}{If \code{conditionalPower} together with \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (or \code{minNumberOfEventsPerStage} and \code{maxNumberOfEventsPerStage} for survival designs) is specified, a sample size recalculation based on the specified conditional power is performed. It is defined as the power for the subsequent stage given the current data. By default, the conditional power will be calculated under the observed effect size. Optionally, you can also specify \code{thetaH1} and \code{stDevH1} (for simulating means), \code{pi1H1} and \code{pi2H1} (for simulating rates), or \code{thetaH1} (for simulating hazard ratios) as parameters under which it is calculated and the sample size recalculation is performed.} \item{thetaH1}{If specified, the value of the alternative under which the conditional power or sample size recalculation calculation is performed.} \item{maxNumberOfIterations}{The number of simulation iterations, default is \code{1000}.} \item{maxNumberOfRawDatasetsPerStage}{The number of raw datasets per stage that shall be extracted and saved as \code{\link[base]{data.frame}}, default is \code{0}. \code{\link{getRawData}} can be used to get the extracted raw data from the object.} \item{longTimeSimulationAllowed}{Logical that indicates whether long time simulations that consumes more than 30 seconds are allowed or not, default is \code{FALSE}.} \item{seed}{The seed to reproduce the simulation, default is a random seed.} \item{showStatistics}{If \code{TRUE}, summary statistics of the simulated data are displayed for the \code{print} command, otherwise the output is suppressed, default is \code{FALSE}.} } \value{ Returns a \code{\link{SimulationResults}} object. The following generics (R generic functions) are available for this object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.SimulationResults]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the analysis times, power, stopping probabilities, conditional power, and expected sample size for testing the hazard ratio in a two treatment groups survival design. } \details{ At given design the function simulates the power, stopping probabilities, conditional power, and expected sample size at given number of events, number of subjects, and parameter configuration. It also simulates the time when the required events are expected under the given assumptions (exponentially, piecewise exponentially, or Weibull distributed survival times and constant or non-constant piecewise accrual). Additionally, integers \code{allocation1} and \code{allocation2} can be specified that determine the number allocated to treatment group 1 and treatment group 2, respectively. \code{conditionalPower}\cr The definition of \code{thetaH1} makes only sense if \code{kMax} > 1 and if \code{conditionalPower}, \code{minNumberOfEventsPerStage}, and \code{maxNumberOfEventsPerStage} are defined. Note that \code{numberOfSubjects}, \code{numberOfSubjects1}, and \code{numberOfSubjects2} in the output are expected number of subjects. } \section{Piecewise survival time}{ The first element of the vector \code{piecewiseSurvivalTime} must be equal to \code{0}. \code{piecewiseSurvivalTime} can also be a list that combines the definition of the time intervals and hazard rates in the reference group. The definition of the survival time in the treatment group is obtained by the specification of the hazard ratio (see examples for details). } \section{Staggered patient entry}{ \code{accrualTime} is the time period of subjects' accrual in a study. It can be a value that defines the end of accrual or a vector. In this case, \code{accrualTime} can be used to define a non-constant accrual over time. For this, \code{accrualTime} is a vector that defines the accrual intervals. The first element of \code{accrualTime} must be equal to \code{0} and, additionally, \code{accrualIntensity} needs to be specified. \code{accrualIntensity} itself is a value or a vector (depending on the length of \code{accrualtime}) that defines the intensity how subjects enter the trial in the intervals defined through \code{accrualTime}. \code{accrualTime} can also be a list that combines the definition of the accrual time and accrual intensity (see below and examples for details). If the length of \code{accrualTime} and the length of \code{accrualIntensity} are the same (i.e., the end of accrual is undefined), \code{maxNumberOfSubjects > 0} needs to be specified and the end of accrual is calculated. In that case, \code{accrualIntensity} is the number of subjects per time unit, i.e., the absolute accrual intensity. If the length of \code{accrualTime} equals the length of \code{accrualIntensity - 1} (i.e., the end of accrual is defined), \code{maxNumberOfSubjects} is calculated if the absolute accrual intensity is given. If all elements in \code{accrualIntensity} are smaller than 1, \code{accrualIntensity} defines the *relative* intensity how subjects enter the trial. For example, \code{accrualIntensity = c(0.1, 0.2)} specifies that in the second accrual interval the intensity is doubled as compared to the first accrual interval. The actual (absolute) accrual intensity is calculated for the calculated or given \code{maxNumberOfSubjects}. Note that the default is \code{accrualIntensity = 0.1} meaning that the *absolute* accrual intensity will be calculated. } \section{Simulation Data}{ The summary statistics "Simulated data" contains the following parameters: median [range]; mean +/-sd\cr \code{$show(showStatistics = FALSE)} or \code{$setShowStatistics(FALSE)} can be used to disable the output of the aggregated simulated data.\cr Example 1: \cr \code{simulationResults <- getSimulationSurvival(maxNumberOfSubjects = 100, plannedEvents = 30)} \cr \code{simulationResults$show(showStatistics = FALSE)}\cr Example 2: \cr \code{simulationResults <- getSimulationSurvival(maxNumberOfSubjects = 100, plannedEvents = 30)} \cr \code{simulationResults$setShowStatistics(FALSE)}\cr \code{simulationResults}\cr \code{\link{getData}} can be used to get the aggregated simulated data from the object as \code{\link[base]{data.frame}}. The data frame contains the following columns: \enumerate{ \item \code{iterationNumber}: The number of the simulation iteration. \item \code{stageNumber}: The stage. \item \code{pi1}: The assumed or derived event rate in the treatment group. \item \code{pi2}: The assumed or derived event rate in the control group. \item \code{hazardRatio}: The hazard ratio under consideration (if available). \item \code{analysisTime}: The analysis time. \item \code{numberOfSubjects}: The number of subjects under consideration when the (interim) analysis takes place. \item \code{eventsPerStage1}: The observed number of events per stage in treatment group 1. \item \code{eventsPerStage2}: The observed number of events per stage in treatment group 2. \item \code{eventsPerStage}: The observed number of events per stage in both treatment groups. \item \code{rejectPerStage}: 1 if null hypothesis can be rejected, 0 otherwise. \item \code{futilityPerStage}: 1 if study should be stopped for futility, 0 otherwise. \item \code{eventsNotAchieved}: 1 if number of events could not be reached with observed number of subjects, 0 otherwise. \item \code{testStatistic}: The test statistic that is used for the test decision, depends on which design was chosen (group sequential, inverse normal, or Fisher combination test)' \item \code{logRankStatistic}: Z-score statistic which corresponds to a one-sided log-rank test at considered stage. \item \code{hazardRatioEstimateLR}: The estimated hazard ratio, derived from the log-rank statistic. \item \code{trialStop}: \code{TRUE} if study should be stopped for efficacy or futility or final stage, \code{FALSE} otherwise. \item \code{conditionalPowerAchieved}: The conditional power for the subsequent stage of the trial for selected sample size and effect. The effect is either estimated from the data or can be user defined with \code{thetaH1}. } } \section{Raw Data}{ \code{\link{getRawData}} can be used to get the simulated raw data from the object as \code{\link[base]{data.frame}}. Note that \code{getSimulationSurvival} must called before with \code{maxNumberOfRawDatasetsPerStage} > 0. The data frame contains the following columns: \enumerate{ \item \code{iterationNumber}: The number of the simulation iteration. \item \code{stopStage}: The stage of stopping. \item \code{subjectId}: The subject id (increasing number 1, 2, 3, ...) \item \code{accrualTime}: The accrual time, i.e., the time when the subject entered the trial. \item \code{treatmentGroup}: The treatment group number (1 or 2). \item \code{survivalTime}: The survival time of the subject. \item \code{dropoutTime}: The dropout time of the subject (may be \code{NA}). \item \code{observationTime}: The specific observation time. \item \code{timeUnderObservation}: The time under observation is defined as follows:\cr if (event == TRUE) {\cr timeUnderObservation <- survivalTime;\cr } else if (dropoutEvent == TRUE) {\cr timeUnderObservation <- dropoutTime;\cr } else {\cr timeUnderObservation <- observationTime - accrualTime;\cr } \item \code{event}: \code{TRUE} if an event occurred; \code{FALSE} otherwise. \item \code{dropoutEvent}: \code{TRUE} if an dropout event occurred; \code{FALSE} otherwise. } } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Fixed sample size with minimum required definitions, pi1 = (0.3,0.4,0.5,0.6) and # pi2 = 0.3 at event time 12, and accrual time 24 getSimulationSurvival(pi1 = seq(0.3,0.6,0.1), pi2 = 0.3, eventTime = 12, accrualTime = 24, plannedEvents = 40, maxNumberOfSubjects = 200, maxNumberOfIterations = 10) \donttest{ # Increase number of simulation iterations getSimulationSurvival(pi1 = seq(0.3,0.6,0.1), pi2 = 0.3, eventTime = 12, accrualTime = 24, plannedEvents = 40, maxNumberOfSubjects = 200, maxNumberOfIterations = 50) # Determine necessary accrual time with default settings if 200 subjects and # 30 subjects per time unit can be recruited getSimulationSurvival(plannedEvents = 40, accrualTime = 0, accrualIntensity = 30, maxNumberOfSubjects = 200, maxNumberOfIterations = 50) # Determine necessary accrual time with default settings if 200 subjects and # if the first 6 time units 20 subjects per time unit can be recruited, # then 30 subjects per time unit getSimulationSurvival(plannedEvents = 40, accrualTime = c(0, 6), accrualIntensity = c(20, 30), maxNumberOfSubjects = 200, maxNumberOfIterations = 50) # Determine maximum number of Subjects with default settings if the first # 6 time units 20 subjects per time unit can be recruited, and after # 10 time units 30 subjects per time unit getSimulationSurvival(plannedEvents = 40, accrualTime = c(0, 6, 10), accrualIntensity = c(20, 30), maxNumberOfIterations = 50) # Specify accrual time as a list at <- list( "0 - <6" = 20, "6 - Inf" = 30) getSimulationSurvival(plannedEvents = 40, accrualTime = at, maxNumberOfSubjects = 200, maxNumberOfIterations = 50) # Specify accrual time as a list, if maximum number of subjects need to be calculated at <- list( "0 - <6" = 20, "6 - <=10" = 30) getSimulationSurvival(plannedEvents = 40, accrualTime = at, maxNumberOfIterations = 50) # Specify effect size for a two-stage group sequential design with # O'Brien & Fleming boundaries. Effect size is based on event rates # at specified event time, directionUpper = FALSE needs to be specified # because it should be shown that hazard ratio < 1 getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), pi1 = 0.2, pi2 = 0.3, eventTime = 24, plannedEvents = c(20, 40), maxNumberOfSubjects = 200, directionUpper = FALSE, maxNumberOfIterations = 50) # As above, but with a three-stage O'Brien and Fleming design with # specified information rates, note that planned events consists of integer values d3 <- getDesignGroupSequential(informationRates = c(0.4, 0.7, 1)) getSimulationSurvival(design = d3, pi1 = 0.2, pi2 = 0.3, eventTime = 24, plannedEvents = round(d3$informationRates * 40), maxNumberOfSubjects = 200, directionUpper = FALSE, maxNumberOfIterations = 50) # Effect size is based on event rate at specified event time for the reference # group and hazard ratio, directionUpper = FALSE needs to be specified because # it should be shown that hazard ratio < 1 getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), hazardRatio = 0.5, pi2 = 0.3, eventTime = 24, plannedEvents = c(20, 40), maxNumberOfSubjects = 200, directionUpper = FALSE, maxNumberOfIterations = 50) # Effect size is based on hazard rate for the reference group and # hazard ratio, directionUpper = FALSE needs to be specified because # it should be shown that hazard ratio < 1 getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), hazardRatio = 0.5, lambda2 = 0.02, plannedEvents = c(20, 40), maxNumberOfSubjects = 200, directionUpper = FALSE, maxNumberOfIterations = 50) # Specification of piecewise exponential survival time and hazard ratios, # note that in getSimulationSurvival only on hazard ratio is used # in the case that the survival time is piecewise expoential getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.01, 0.02, 0.04), hazardRatio = 1.5, plannedEvents = c(20, 40), maxNumberOfSubjects = 200, maxNumberOfIterations = 50) pws <- list( "0 - <5" = 0.01, "5 - <10" = 0.02, ">=10" = 0.04) getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = pws, hazardRatio = c(1.5), plannedEvents = c(20, 40), maxNumberOfSubjects = 200, maxNumberOfIterations = 50) # Specification of piecewise exponential survival time for both treatment arms getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.01, 0.02, 0.04), lambda1 = c(0.015, 0.03, 0.06), plannedEvents = c(20, 40), maxNumberOfSubjects = 200, maxNumberOfIterations = 50) # Specification of piecewise exponential survival time as a list, # note that in getSimulationSurvival only on hazard ratio # (not a vector) can be used pws <- list( "0 - <5" = 0.01, "5 - <10" = 0.02, ">=10" = 0.04) getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = pws, hazardRatio = 1.5, plannedEvents = c(20, 40), maxNumberOfSubjects = 200, maxNumberOfIterations = 50) # Specification of piecewise exponential survival time and delayed effect # (response after 5 time units) getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.01, 0.02, 0.04), lambda1 = c(0.01, 0.02, 0.06), plannedEvents = c(20, 40), maxNumberOfSubjects = 200, maxNumberOfIterations = 50) # Specify effect size based on median survival times getSimulationSurvival(median1 = 5, median2 = 3, plannedEvents = 40, maxNumberOfSubjects = 200, directionUpper = FALSE, maxNumberOfIterations = 50) # Specify effect size based on median survival # times of Weibull distribtion with kappa = 2 getSimulationSurvival(median1 = 5, median2 = 3, kappa = 2, plannedEvents = 40, maxNumberOfSubjects = 200, directionUpper = FALSE, maxNumberOfIterations = 50) # Perform recalculation of number of events based on conditional power for a # three-stage design with inverse normal combination test, where the conditional power # is calculated under the specified effect size thetaH1 = 1.3 and up to a four-fold # increase in originally planned sample size (number of events) is allowed # Note that the first value in minNumberOfEventsPerStage and # maxNumberOfEventsPerStage is arbitrary, i.e., it has no effect. dIN <- getDesignInverseNormal(informationRates = c(0.4, 0.7, 1)) resultsWithSSR1 <- getSimulationSurvival(design = dIN, hazardRatio = seq(1, 1.6, 0.1), pi2 = 0.3, conditionalPower = 0.8, thetaH1 = 1.3, plannedEvents = c(58, 102, 146), minNumberOfEventsPerStage = c(NA, 44, 44), maxNumberOfEventsPerStage = 4 * c(NA, 44, 44), maxNumberOfSubjects = 800, maxNumberOfIterations = 50) resultsWithSSR1 # If thetaH1 is unspecified, the observed hazard ratio estimate # (calculated from the log-rank statistic) is used for performing the # recalculation of the number of events resultsWithSSR2 <- getSimulationSurvival(design = dIN, hazardRatio = seq(1, 1.6, 0.1), pi2 = 0.3, conditionalPower = 0.8, plannedEvents = c(58, 102, 146), minNumberOfEventsPerStage = c(NA, 44, 44), maxNumberOfEventsPerStage = 4 * c(NA, 44, 44), maxNumberOfSubjects = 800, maxNumberOfIterations = 50) resultsWithSSR2 # Compare it with design without event size recalculation resultsWithoutSSR <- getSimulationSurvival(design = dIN, hazardRatio = seq(1, 1.6, 0.1), pi2 = 0.3, plannedEvents = c(58, 102, 145), maxNumberOfSubjects = 800, maxNumberOfIterations = 50) resultsWithoutSSR$overallReject resultsWithSSR1$overallReject resultsWithSSR2$overallReject # Confirm that event size racalcuation increases the Type I error rate, # i.e., you have to use the combination test dGS <- getDesignGroupSequential(informationRates = c(0.4, 0.7, 1)) resultsWithSSRGS <- getSimulationSurvival(design = dGS, hazardRatio = seq(1), pi2 = 0.3, conditionalPower = 0.8, plannedEvents = c(58, 102, 145), minNumberOfEventsPerStage = c(NA, 44, 44), maxNumberOfEventsPerStage = 4 * c(NA, 44, 44), maxNumberOfSubjects = 800, maxNumberOfIterations = 50) resultsWithSSRGS$overallReject # Set seed to get reproduceable results identical( getSimulationSurvival(plannedEvents = 40, maxNumberOfSubjects = 200, seed = 99)$analysisTime, getSimulationSurvival(plannedEvents = 40, maxNumberOfSubjects = 200, seed = 99)$analysisTime ) } } rpact/man/getSimulationMeans.Rd0000644000175000017500000003305214153377720016403 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_simulation_base_means.R \name{getSimulationMeans} \alias{getSimulationMeans} \title{Get Simulation Means} \usage{ getSimulationMeans( design = NULL, ..., groups = 2L, normalApproximation = TRUE, meanRatio = FALSE, thetaH0 = ifelse(meanRatio, 1, 0), alternative = seq(0, 1, 0.2), stDev = 1, plannedSubjects = NA_real_, directionUpper = TRUE, allocationRatioPlanned = NA_real_, minNumberOfSubjectsPerStage = NA_real_, maxNumberOfSubjectsPerStage = NA_real_, conditionalPower = NA_real_, thetaH1 = NA_real_, stDevH1 = NA_real_, maxNumberOfIterations = 1000L, seed = NA_real_, calcSubjectsFunction = NULL, showStatistics = FALSE ) } \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{groups}{The number of treatment groups (1 or 2), default is \code{2}.} \item{normalApproximation}{The type of computation of the p-values. Default is \code{TRUE}, i.e., normally distributed test statistics are generated. If \code{FALSE}, the t test is used for calculating the p-values, i.e., t distributed test statistics are generated.} \item{meanRatio}{If \code{TRUE}, the design characteristics for one-sided testing of H0: \code{mu1 / mu2 = thetaH0} are simulated, default is \code{FALSE}.} \item{thetaH0}{The null hypothesis value, default is \code{0} for the normal and the binary case (testing means and rates, respectively), it is \code{1} for the survival case (testing the hazard ratio).\cr\cr For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. That is, in case of (one-sided) testing of \itemize{ \item \emph{means}: a value \code{!= 0} (or a value \code{!= 1} for testing the mean ratio) can be specified. \item \emph{rates}: a value \code{!= 0} (or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. \item \emph{survival data}: a bound for testing H0: \code{hazard ratio = thetaH0 != 1} can be specified. } For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for defining the null hypothesis H0: \code{pi = thetaH0}.} \item{alternative}{The alternative hypothesis value for testing means under which the data is simulated. This can be a vector of assumed alternatives, default is \code{seq(0, 1, 0.2)}.} \item{stDev}{The standard deviation under which the data is simulated, default is \code{1}. If \code{meanRatio = TRUE} is specified, \code{stDev} defines the coefficient of variation \code{sigma / mu2}.} \item{plannedSubjects}{\code{plannedSubjects} is a vector of length \code{kMax} (the number of stages of the design) that determines the number of cumulated (overall) subjects when the interim stages are planned. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs, \code{plannedSubjects} refers to the number of subjects per selected active arm.} \item{directionUpper}{Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} \item{minNumberOfSubjectsPerStage}{When performing a data driven sample size recalculation, the vector \code{minNumberOfSubjectsPerStage} with length kMax determines the minimum number of subjects per stage (i.e., not cumulated), the first element is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs \code{minNumberOfSubjectsPerStage} refers to the minimum number of subjects per selected active arm.} \item{maxNumberOfSubjectsPerStage}{When performing a data driven sample size recalculation, the vector \code{maxNumberOfSubjectsPerStage} with length kMax determines the maximum number of subjects per stage (i.e., not cumulated), the first element is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs \code{maxNumberOfSubjectsPerStage} refers to the maximum number of subjects per selected active arm.} \item{conditionalPower}{If \code{conditionalPower} together with \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (or \code{minNumberOfEventsPerStage} and \code{maxNumberOfEventsPerStage} for survival designs) is specified, a sample size recalculation based on the specified conditional power is performed. It is defined as the power for the subsequent stage given the current data. By default, the conditional power will be calculated under the observed effect size. Optionally, you can also specify \code{thetaH1} and \code{stDevH1} (for simulating means), \code{pi1H1} and \code{pi2H1} (for simulating rates), or \code{thetaH1} (for simulating hazard ratios) as parameters under which it is calculated and the sample size recalculation is performed.} \item{thetaH1}{If specified, the value of the alternative under which the conditional power or sample size recalculation calculation is performed.} \item{stDevH1}{If specified, the value of the standard deviation under which the conditional power or sample size recalculation calculation is performed, default is the value of \code{stDev}.} \item{maxNumberOfIterations}{The number of simulation iterations, default is \code{1000}.} \item{seed}{The seed to reproduce the simulation, default is a random seed.} \item{calcSubjectsFunction}{Optionally, a function can be entered that defines the way of performing the sample size recalculation. By default, sample size recalculation is performed with conditional power with specified \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (see details and examples).} \item{showStatistics}{If \code{TRUE}, summary statistics of the simulated data are displayed for the \code{print} command, otherwise the output is suppressed, default is \code{FALSE}.} } \value{ Returns a \code{\link{SimulationResults}} object. The following generics (R generic functions) are available for this object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.SimulationResults]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the simulated power, stopping probabilities, conditional power, and expected sample size for testing means in a one or two treatment groups testing situation. } \details{ At given design the function simulates the power, stopping probabilities, conditional power, and expected sample size at given number of subjects and parameter configuration. Additionally, an allocation ratio = n1/n2 can be specified where n1 and n2 are the number of subjects in the two treatment groups. The definition of \code{thetaH1} makes only sense if \code{kMax} > 1 and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and \code{maxNumberOfSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. \code{calcSubjectsFunction}\cr This function returns the number of subjects at given conditional power and conditional critical value for specified testing situation. The function might depend on variables \code{stage}, \code{meanRatio}, \code{thetaH0}, \code{groups}, \code{plannedSubjects}, \code{sampleSizesPerStage}, \code{directionUpper}, \code{allocationRatioPlanned}, \code{minNumberOfSubjectsPerStage}, \code{maxNumberOfSubjectsPerStage}, \code{conditionalPower}, \code{conditionalCriticalValue}, \code{thetaH1}, and \code{stDevH1}. The function has to contain the three-dots argument '...' (see examples). } \section{Simulation Data}{ The summary statistics "Simulated data" contains the following parameters: median [range]; mean +/-sd\cr \code{$show(showStatistics = FALSE)} or \code{$setShowStatistics(FALSE)} can be used to disable the output of the aggregated simulated data.\cr Example 1: \cr \code{simulationResults <- getSimulationMeans(plannedSubjects = 40)} \cr \code{simulationResults$show(showStatistics = FALSE)}\cr Example 2: \cr \code{simulationResults <- getSimulationMeans(plannedSubjects = 40)} \cr \code{simulationResults$setShowStatistics(FALSE)}\cr \code{simulationResults}\cr \code{\link{getData}} can be used to get the aggregated simulated data from the object as \code{\link[base]{data.frame}}. The data frame contains the following columns: \enumerate{ \item \code{iterationNumber}: The number of the simulation iteration. \item \code{stageNumber}: The stage. \item \code{alternative}: The alternative hypothesis value. \item \code{numberOfSubjects}: The number of subjects under consideration when the (interim) analysis takes place. \item \code{rejectPerStage}: 1 if null hypothesis can be rejected, 0 otherwise. \item \code{futilityPerStage}: 1 if study should be stopped for futility, 0 otherwise. \item \code{testStatistic}: The test statistic that is used for the test decision, depends on which design was chosen (group sequential, inverse normal, or Fisher's combination test). \item \code{testStatisticsPerStage}: The test statistic for each stage if only data from the considered stage is taken into account. \item \code{effectEstimate}: Overall simulated standardized effect estimate. \item \code{trialStop}: \code{TRUE} if study should be stopped for efficacy or futility or final stage, \code{FALSE} otherwise. \item \code{conditionalPowerAchieved}: The conditional power for the subsequent stage of the trial for selected sample size and effect. The effect is either estimated from the data or can be user defined with \code{thetaH1}. } } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Fixed sample size design with two groups, total sample size 40, # alternative = c(0, 0.2, 0.4, 0.8, 1), and standard deviation = 1 (the default) getSimulationMeans(plannedSubjects = 40, maxNumberOfIterations = 10) \donttest{ # Increase number of simulation iterations and compare results # with power calculator using normal approximation getSimulationMeans(alternative = 0:4, stDev = 5, plannedSubjects = 40, maxNumberOfIterations = 1000) getPowerMeans(alternative = 0:4, stDev = 5, maxNumberOfSubjects = 40, normalApproximation = TRUE) # Do the same for a three-stage O'Brien&Fleming inverse # normal group sequential design with non-binding futility stops designIN <- getDesignInverseNormal(typeOfDesign = "OF", futilityBounds = c(0, 0)) x <- getSimulationMeans(designIN, alternative = c(0:4), stDev = 5, plannedSubjects = c(20, 40, 60), maxNumberOfIterations = 1000) getPowerMeans(designIN, alternative = 0:4, stDev = 5, maxNumberOfSubjects = 60, normalApproximation = TRUE) # Assess power and average sample size if a sample size increase is foreseen # at conditional power 80\% for each subsequent stage based on observed overall # effect and specified minNumberOfSubjectsPerStage and # maxNumberOfSubjectsPerStage getSimulationMeans(designIN, alternative = 0:4, stDev = 5, plannedSubjects = c(20, 40, 60), minNumberOfSubjectsPerStage = c(NA, 20, 20), maxNumberOfSubjectsPerStage = c(NA, 80, 80), conditionalPower = 0.8, maxNumberOfIterations = 50) # Do the same under the assumption that a sample size increase only takes # place at the first interim. The sample size for the third stage is set equal # to the second stage sample size. mySampleSizeCalculationFunction <- function(..., stage, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage, sampleSizesPerStage, conditionalPower, conditionalCriticalValue, thetaH1) { if (stage == 2) { stageSubjects <- 4 * (max(0, conditionalCriticalValue + stats::qnorm(conditionalPower)))^2 / (max(1e-12, thetaH1))^2 stageSubjects <- min(max(minNumberOfSubjectsPerStage[stage], stageSubjects), maxNumberOfSubjectsPerStage[stage]) } else { stageSubjects <- sampleSizesPerStage[stage - 1] } return(stageSubjects) } getSimulationMeans(designIN, alternative = 2:4, stDev = 5, plannedSubjects = c(20, 40, 60), minNumberOfSubjectsPerStage = c(NA, 20, 20), maxNumberOfSubjectsPerStage = c(NA, 160, 160), conditionalPower = 0.8, calcSubjectsFunction = mySampleSizeCalculationFunction, maxNumberOfIterations = 50) } } rpact/man/param_dropoutRate1.Rd0000644000175000017500000000060114020357215016324 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_dropoutRate1} \alias{param_dropoutRate1} \title{Parameter Description: Dropout Rate (1)} \arguments{ \item{dropoutRate1}{The assumed drop-out rate in the treatment group, default is \code{0}.} } \description{ Parameter Description: Dropout Rate (1) } \keyword{internal} rpact/man/SimulationResultsMultiArmSurvival.Rd0000644000175000017500000000070414020357214021473 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R \docType{class} \name{SimulationResultsMultiArmSurvival} \alias{SimulationResultsMultiArmSurvival} \title{Class for Simulation Results Multi-Arm Survival} \description{ A class for simulation results survival in multi-arm designs. } \details{ Use \code{\link{getSimulationMultiArmSurvival}} to create an object of this type. } \keyword{internal} rpact/man/plot.AnalysisResults.Rd0000644000175000017500000001352014055345235016710 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \name{plot.AnalysisResults} \alias{plot.AnalysisResults} \title{Analysis Results Plotting} \usage{ \method{plot}{AnalysisResults}( x, y, ..., type = 1L, nPlanned = NA_real_, allocationRatioPlanned = NA_real_, main = NA_character_, xlab = NA_character_, ylab = NA_character_, legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, showSource = FALSE, grid = 1, plotSettings = NULL ) } \arguments{ \item{x}{The analysis results at given stage, obtained from \code{\link{getAnalysisResults}}.} \item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} \item{...}{Optional \link[=param_three_dots_plot]{plot arguments}. Furthermore the following arguments can be defined: \itemize{ \item \code{thetaRange}: A range of assumed effect sizes if testing means or a survival design was specified. Additionally, if testing means was selected, \code{assumedStDev} (assumed standard deviation) can be specified (default is \code{1}). \item \code{piTreatmentRange}: A range of assumed rates pi1 to calculate the conditional power. Additionally, if a two-sample comparison was selected, \code{pi2} can be specified (default is the value from \code{getAnalysisResults}). \item \code{directionUpper}: Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. \item \code{\link[=param_thetaH0]{thetaH0}}: The null hypothesis value, default is \code{0} for the normal and the binary case, it is \code{1} for the survival case. For testing a rate in one sample, a value thetaH0 in (0, 1) has to be specified for defining the null hypothesis H0: \code{pi = thetaH0}. }} \item{type}{The plot type (default = 1). Note that at the moment only one type (the conditional power plot) is available.} \item{nPlanned}{The additional (i.e., "new" and not cumulative) sample size planned for each of the subsequent stages. The argument must be a vector with length equal to the number of remaining stages and contain the combined sample size from both treatment groups if two groups are considered. For survival outcomes, it should contain the planned number of additional events. For multi-arm designs, it is the per-comparison (combined) sample size. For enrichment designs, it is the (combined) sample size for the considered sub-population.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} \item{main}{The main title, default is \code{"Dataset"}.} \item{xlab}{The x-axis label, default is \code{"Stage"}.} \item{ylab}{The y-axis label.} \item{legendTitle}{The legend title, default is \code{""}.} \item{palette}{The palette, default is \code{"Set1"}.} \item{legendPosition}{The position of the legend. By default (\code{NA_integer_}) the algorithm tries to find a suitable position. Choose one of the following values to specify the position manually: \itemize{ \item \code{-1}: no legend will be shown \item \code{NA}: the algorithm tries to find a suitable position \item \code{0}: legend position outside plot \item \code{1}: legend position left top \item \code{2}: legend position left center \item \code{3}: legend position left bottom \item \code{4}: legend position right top \item \code{5}: legend position right center \item \code{6}: legend position right bottom }} \item{showSource}{If \code{TRUE}, the parameter names of the object will be printed which were used to create the plot; that may be, e.g., useful to check the values or to create own plots with the base R \code{plot} function. Alternatively \code{showSource} can be defined as one of the following character values: \itemize{ \item \code{"commands"}: returns a character vector with plot commands \item \code{"axes"}: returns a list with the axes definitions \item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function does not stop if an error occurs) \item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function stops if an error occurs) } Note: no plot object will be returned if \code{showSource} is a character.} \item{grid}{An integer value specifying the output of multiple plots. By default (\code{1}) a list of \code{ggplot} objects will be returned. If a \code{grid} value > 1 was specified, a grid plot will be returned if the number of plots is <= specified \code{grid} value; a list of \code{ggplot} objects will be returned otherwise. If \code{grid = 0} is specified, all plots will be created using \code{\link[base]{print}} command and a list of \code{ggplot} objects will be returned invisible. Note that one of the following packages must be installed to create a grid plot: 'ggpubr', 'gridExtra', or 'cowplot'.} \item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link{getPlotSettings}}.} } \value{ Returns a \code{ggplot2} object. } \description{ Plots the conditional power together with the likelihood function. } \details{ The conditional power is calculated only if effect size and sample size is specified. } \examples{ \donttest{ design <- getDesignGroupSequential(kMax = 2) dataExample <- getDataset( n = c(20, 30), means = c(50, 51), stDevs = c(130, 140) ) result <- getAnalysisResults(design = design, dataInput = dataExample, thetaH0 = 20, nPlanned = c(30), thetaH1 = 1.5, stage = 1) if (require(ggplot2)) plot(result, thetaRange = c(0, 100)) } } rpact/man/utilitiesForSurvivalTrials.Rd0000644000175000017500000000405314060361011020146 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_design_utilities.R \name{utilitiesForSurvivalTrials} \alias{utilitiesForSurvivalTrials} \alias{getLambdaByPi} \alias{getLambdaByMedian} \alias{getHazardRatioByPi} \alias{getPiByLambda} \alias{getPiByMedian} \alias{getMedianByLambda} \alias{getMedianByPi} \title{Survival Helper Functions for Conversion of Pi, Lambda, Median} \usage{ getLambdaByPi(piValue, eventTime = 12L, kappa = 1) getLambdaByMedian(median, kappa = 1) getHazardRatioByPi(pi1, pi2, eventTime = 12L, kappa = 1) getPiByLambda(lambda, eventTime = 12L, kappa = 1) getPiByMedian(median, eventTime = 12L, kappa = 1) getMedianByLambda(lambda, kappa = 1) getMedianByPi(piValue, eventTime = 12L, kappa = 1) } \arguments{ \item{piValue, pi1, pi2, lambda, median}{Value that shall be converted.} \item{eventTime}{The assumed time under which the event rates are calculated, default is \code{12}.} \item{kappa}{A numeric value > 0. A \code{kappa != 1} will be used for the specification of the shape of the Weibull distribution. Default is \code{1}, i.e., the exponential survival distribution is used instead of the Weibull distribution. Note that the Weibull distribution cannot be used for the piecewise definition of the survival time distribution, i.e., only \code{piecewiselambda} (as a single value) and \code{kappa} can be specified. This function is equivalent to \code{pweibull(t, shape = kappa, scale = 1 / lambda)} of the \code{stats} package, i.e., the scale parameter is \code{1 / 'hazard rate'}.\cr For example, \code{getPiecewiseExponentialDistribution(time = 130, piecewiseLambda = 0.01, kappa = 4.2)} and \code{pweibull(q = 130, shape = 4.2, scale = 1 / 0.01)} provide the sample result.} } \value{ Returns a \code{\link[base]{numeric}} value or vector will be returned. } \description{ Functions to convert pi, lambda and median values into each other. } \details{ Can be used, e.g., to convert median values into pi or lambda values for usage in \code{\link{getSampleSizeSurvival}} or \code{\link{getPowerSurvival}}. } rpact/man/dataEnrichmentSurvivalStratified.Rd0000644000175000017500000000112714102177375021270 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{dataEnrichmentSurvivalStratified} \alias{dataEnrichmentSurvivalStratified} \title{Stratified Enrichment Dataset of Survival Data} \format{ A \code{\link[base]{data.frame}} object. } \usage{ dataEnrichmentSurvivalStratified } \description{ A dataset containing the log-rank statistics, events, and allocation ratios of two groups. Use \code{getDataset(dataEnrichmentSurvivalStratified)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. } \keyword{datasets} rpact/man/plot.EventProbabilities.Rd0000644000175000017500000000646614046535122017344 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_event_probabilities.R \name{plot.EventProbabilities} \alias{plot.EventProbabilities} \title{Event Probabilities Plotting} \usage{ \method{plot}{EventProbabilities}( x, y, ..., allocationRatioPlanned = x$allocationRatioPlanned, main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, legendTitle = NA_character_, palette = "Set1", plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, plotSettings = NULL ) } \arguments{ \item{x}{The object that inherits from \code{\link{EventProbabilities}}.} \item{y}{An optional object that inherits from \code{\link{NumberOfSubjects}}.} \item{...}{Optional plot arguments. At the moment \code{xlim} and \code{ylim} are implemented for changing x or y axis limits without dropping data observations.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} \item{main}{The main title.} \item{xlab}{The x-axis label.} \item{ylab}{The y-axis label.} \item{type}{The plot type (default = 1). Note that at the moment only one type is available.} \item{legendTitle}{The legend title, default is \code{""}.} \item{palette}{The palette, default is \code{"Set1"}.} \item{plotPointsEnabled}{If \code{TRUE}, additional points will be plotted.} \item{legendPosition}{The position of the legend. By default (\code{NA_integer_}) the algorithm tries to find a suitable position. Choose one of the following values to specify the position manually: \itemize{ \item \code{-1}: no legend will be shown \item \code{NA}: the algorithm tries to find a suitable position \item \code{0}: legend position outside plot \item \code{1}: legend position left top \item \code{2}: legend position left center \item \code{3}: legend position left bottom \item \code{4}: legend position right top \item \code{5}: legend position right center \item \code{6}: legend position right bottom }} \item{showSource}{If \code{TRUE}, the parameter names of the object will be printed which were used to create the plot; that may be, e.g., useful to check the values or to create own plots with the base R \code{plot} function. Alternatively \code{showSource} can be defined as one of the following character values: \itemize{ \item \code{"commands"}: returns a character vector with plot commands \item \code{"axes"}: returns a list with the axes definitions \item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function does not stop if an error occurs) \item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function stops if an error occurs) } Note: no plot object will be returned if \code{showSource} is a character.} \item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link{getPlotSettings}}.} } \value{ Returns a \code{ggplot2} object. } \description{ Plots an object that inherits from class \code{\link{EventProbabilities}}. } \details{ Generic function to plot an event probabilities object. Generic function to plot a parameter set. } rpact/man/plot.TrialDesignPlan.Rd0000644000175000017500000001153414046535122016562 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_plan.R \name{plot.TrialDesignPlan} \alias{plot.TrialDesignPlan} \title{Trial Design Plan Plotting} \usage{ \method{plot}{TrialDesignPlan}( x, y, ..., main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = ifelse(x$.design$kMax == 1, 5L, 1L), palette = "Set1", theta = seq(-1, 1, 0.01), plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, grid = 1, plotSettings = NULL ) } \arguments{ \item{x}{The trial design plan, obtained from \cr \code{\link{getSampleSizeMeans}}, \cr \code{\link{getSampleSizeRates}}, \cr \code{\link{getSampleSizeSurvival}}, \cr \code{\link{getPowerMeans}}, \cr \code{\link{getPowerRates}} or \cr \code{\link{getPowerSurvival}}.} \item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} \item{...}{Optional plot arguments. At the moment \code{xlim} and \code{ylim} are implemented for changing x or y axis limits without dropping data observations.} \item{main}{The main title.} \item{xlab}{The x-axis label.} \item{ylab}{The y-axis label.} \item{type}{The plot type (default = \code{1}). The following plot types are available: \itemize{ \item \code{1}: creates a 'Boundaries' plot \item \code{2}: creates a 'Boundaries Effect Scale' plot \item \code{3}: creates a 'Boundaries p Values Scale' plot \item \code{4}: creates a 'Error Spending' plot \item \code{5}: creates a 'Sample Size' or 'Overall Power and Early Stopping' plot \item \code{6}: creates a 'Number of Events' or 'Sample Size' plot \item \code{7}: creates an 'Overall Power' plot \item \code{8}: creates an 'Overall Early Stopping' plot \item \code{9}: creates an 'Expected Number of Events' or 'Expected Sample Size' plot \item \code{10}: creates a 'Study Duration' plot \item \code{11}: creates an 'Expected Number of Subjects' plot \item \code{12}: creates an 'Analysis Times' plot \item \code{13}: creates a 'Cumulative Distribution Function' plot \item \code{14}: creates a 'Survival Function' plot \item \code{"all"}: creates all available plots and returns it as a grid plot or list }} \item{palette}{The palette, default is \code{"Set1"}.} \item{theta}{A vector of standardized effect sizes (theta values), default is a sequence from -1 to 1.} \item{plotPointsEnabled}{If \code{TRUE}, additional points will be plotted.} \item{legendPosition}{The position of the legend. By default (\code{NA_integer_}) the algorithm tries to find a suitable position. Choose one of the following values to specify the position manually: \itemize{ \item \code{-1}: no legend will be shown \item \code{NA}: the algorithm tries to find a suitable position \item \code{0}: legend position outside plot \item \code{1}: legend position left top \item \code{2}: legend position left center \item \code{3}: legend position left bottom \item \code{4}: legend position right top \item \code{5}: legend position right center \item \code{6}: legend position right bottom }} \item{showSource}{If \code{TRUE}, the parameter names of the object will be printed which were used to create the plot; that may be, e.g., useful to check the values or to create own plots with the base R \code{plot} function. Alternatively \code{showSource} can be defined as one of the following character values: \itemize{ \item \code{"commands"}: returns a character vector with plot commands \item \code{"axes"}: returns a list with the axes definitions \item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function does not stop if an error occurs) \item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function stops if an error occurs) } Note: no plot object will be returned if \code{showSource} is a character.} \item{grid}{An integer value specifying the output of multiple plots. By default (\code{1}) a list of \code{ggplot} objects will be returned. If a \code{grid} value > 1 was specified, a grid plot will be returned if the number of plots is <= specified \code{grid} value; a list of \code{ggplot} objects will be returned otherwise. If \code{grid = 0} is specified, all plots will be created using \code{\link[base]{print}} command and a list of \code{ggplot} objects will be returned invisible. Note that one of the following packages must be installed to create a grid plot: 'ggpubr', 'gridExtra', or 'cowplot'.} \item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link{getPlotSettings}}.} } \value{ Returns a \code{ggplot2} object. } \description{ Plots a trial design plan. } \details{ Generic function to plot all kinds of trial design plans. } \examples{ \donttest{ if (require(ggplot2)) plot(getSampleSizeMeans()) } } rpact/man/Dataset.Rd0000644000175000017500000000116714020357214014147 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R \docType{class} \name{Dataset} \alias{Dataset} \title{Dataset} \description{ Basic class for datasets. } \details{ \code{Dataset} is the basic class for \itemize{ \item \code{\link{DatasetMeans}}, \item \code{\link{DatasetRates}}, and \item \code{\link{DatasetSurvival}}. } This basic class contains the fields \code{stages} and \code{groups} and several commonly used functions. } \section{Fields}{ \describe{ \item{\code{stages}}{The stage numbers.} \item{\code{groups}}{The group numbers.} }} \keyword{internal} rpact/man/readDatasets.Rd0000644000175000017500000000437314020357214015170 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R \name{readDatasets} \alias{readDatasets} \title{Read Multiple Datasets} \usage{ readDatasets( file, ..., header = TRUE, sep = ",", quote = "\\"", dec = ".", fill = TRUE, comment.char = "", fileEncoding = "UTF-8" ) } \arguments{ \item{file}{A CSV file (see \code{\link[utils]{read.table}}).} \item{...}{Further arguments to be passed to \code{\link[utils]{read.table}}.} \item{header}{A logical value indicating whether the file contains the names of the variables as its first line.} \item{sep}{The field separator character. Values on each line of the file are separated by this character. If sep = "," (the default for \code{readDatasets}) the separator is a comma.} \item{quote}{The set of quoting characters. To disable quoting altogether, use quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only considered for columns read as character, which is all of them unless \code{colClasses} is specified.} \item{dec}{The character used in the file for decimal points.} \item{fill}{logical. If \code{TRUE} then in case the rows have unequal length, blank fields are implicitly added.} \item{comment.char}{character: a character vector of length one containing a single character or an empty string. Use "" to turn off the interpretation of comments altogether.} \item{fileEncoding}{character string: if non-empty declares the encoding used on a file (not a connection) so the character data can be re-encoded. See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'.} } \value{ Returns a \code{\link[base]{list}} of \code{\link{Dataset}} objects. } \description{ Reads a data file and returns it as a list of dataset objects. } \details{ Reads a file that was written by \code{\link{writeDatasets}} before. } \examples{ dataFile <- system.file("extdata", "datasets_rates.csv", package = "rpact") if (dataFile != "") { datasets <- readDatasets(dataFile) datasets } } \seealso{ \itemize{ \item \code{\link{readDataset}} for reading a single dataset, \item \code{\link{writeDatasets}} for writing multiple datasets, \item \code{\link{writeDataset}} for writing a single dataset. } } rpact/man/param_plannedEvents.Rd0000644000175000017500000000131414060361011016534 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_plannedEvents} \alias{param_plannedEvents} \title{Parameter Description: Planned Events} \arguments{ \item{plannedEvents}{\code{plannedEvents} is a vector of length \code{kMax} (the number of stages of the design) that determines the number of cumulated (overall) events in survival designs when the interim stages are planned. For two treatment arms, it is the number of events for both treatment arms. For multi-arm designs, \code{plannedEvents} refers to the overall number of events for the selected arms plus control.} } \description{ Parameter Description: Planned Events } \keyword{internal} rpact/man/SimulationResultsEnrichmentRates.Rd0000644000175000017500000000067514117626572021324 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R \docType{class} \name{SimulationResultsEnrichmentRates} \alias{SimulationResultsEnrichmentRates} \title{Class for Simulation Results Enrichment Rates} \description{ A class for simulation results rates in enrichment designs. } \details{ Use \code{\link{getSimulationEnrichmentRates}} to create an object of this type. } \keyword{internal} rpact/man/param_stageResults.Rd0000644000175000017500000000057514020357215016432 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_stageResults} \alias{param_stageResults} \title{Parameter Description: Stage Results} \arguments{ \item{stageResults}{The results at given stage, obtained from \code{\link{getStageResults}}.} } \description{ Parameter Description: Stage Results } \keyword{internal} rpact/man/dataEnrichmentRates.Rd0000644000175000017500000000076514102177375016523 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{dataEnrichmentRates} \alias{dataEnrichmentRates} \title{Enrichment Dataset of Rates} \format{ A \code{\link[base]{data.frame}} object. } \usage{ dataEnrichmentRates } \description{ A dataset containing the sample sizes and events of two groups. Use \code{getDataset(dataEnrichmentRates)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. } \keyword{datasets} rpact/man/StageResults_as.data.frame.Rd0000644000175000017500000000226714020357214017675 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R \name{StageResults_as.data.frame} \alias{StageResults_as.data.frame} \alias{as.data.frame.StageResults} \title{Coerce Stage Results to a Data Frame} \usage{ \method{as.data.frame}{StageResults}( x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, type = 1, ... ) } \arguments{ \item{x}{A \code{\link{StageResults}} object.} \item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column names will be used; syntactic names (variable names) otherwise (see \code{\link[base]{make.names}}).} \item{includeAllParameters}{Logical. If \code{TRUE}, all available parameters will be included in the data frame; a meaningful parameter selection otherwise, default is \code{FALSE}.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} } \value{ Returns a \code{\link[base]{data.frame}}. } \description{ Returns the \code{StageResults} as data frame. } \details{ Coerces the stage results to a data frame. } \keyword{internal} rpact/man/ParameterSet_summary.Rd0000644000175000017500000000562514142514771016746 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_parameter_set.R \name{ParameterSet_summary} \alias{ParameterSet_summary} \alias{summary.ParameterSet} \title{Parameter Set Summary} \usage{ \method{summary}{ParameterSet}( object, ..., type = 1, digits = NA_integer_, output = c("all", "title", "overview", "body") ) } \arguments{ \item{object}{A \code{\link{ParameterSet}} object.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{digits}{Defines how many digits are to be used for numeric values.} } \value{ Returns a \code{\link{SummaryFactory}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object } } \description{ Displays a summary of \code{\link{ParameterSet}} object. } \details{ Summarizes the parameters and results of a parameter set. } \section{Summary options}{ The following options can be set globally: \enumerate{ \item \code{rpact.summary.output.size}: one of \code{c("small", "medium", "large")}; defines how many details will be included into the summary; default is \code{"large"}, i.e., all available details are displayed. \item \code{rpact.summary.justify}: one of \code{c("right", "left", "centre")}; shall the values be right-justified (the default), left-justified or centered. \item \code{rpact.summary.width}: defines the maximum number of characters to be used per line (default is \code{83}). \item \code{rpact.summary.intervalFormat}: defines how intervals will be displayed in the summary, default is \code{"[\%s; \%s]"}. \item \code{rpact.summary.digits}: defines how many digits are to be used for numeric values (default is \code{3}). \item \code{rpact.summary.digits.probs}: defines how many digits are to be used for numeric values (default is one more than value of \code{rpact.summary.digits}, i.e., \code{4}). \item \code{rpact.summary.trim.zeroes}: if \code{TRUE} (default) zeroes will always displayed as "0", e.g. "0.000" will become "0". } Example: \code{options("rpact.summary.intervalFormat" = "\%s - \%s")} } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \keyword{internal} rpact/man/roxygen/0000755000175000017500000000000014070776016013773 5ustar nileshnileshrpact/man/roxygen/meta.R0000644000175000017500000000024714017174150015037 0ustar nileshnilesh rd_family_title <- list( design = "Design functions", analysis = "Analysis functions", "analysis functions" = "Analysis functions" ) list(r6 = FALSE) rpact/man/param_showSource.Rd0000644000175000017500000000221114020357215016073 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_showSource} \alias{param_showSource} \title{Parameter Description: Show Source} \arguments{ \item{showSource}{If \code{TRUE}, the parameter names of the object will be printed which were used to create the plot; that may be, e.g., useful to check the values or to create own plots with the base R \code{plot} function. Alternatively \code{showSource} can be defined as one of the following character values: \itemize{ \item \code{"commands"}: returns a character vector with plot commands \item \code{"axes"}: returns a list with the axes definitions \item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function does not stop if an error occurs) \item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function stops if an error occurs) } Note: no plot object will be returned if \code{showSource} is a character.} } \description{ Parameter Description: Show Source } \keyword{internal} rpact/man/getDesignCharacteristics.Rd0000644000175000017500000000470514153377720017543 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_design_group_sequential.R \name{getDesignCharacteristics} \alias{getDesignCharacteristics} \title{Get Design Characteristics} \usage{ getDesignCharacteristics(design) } \arguments{ \item{design}{The trial design.} } \value{ Returns a \code{\link{TrialDesignCharacteristics}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.ParameterSet]{plot}} to plot the object, \item \code{\link[=as.data.frame.TrialDesignCharacteristics]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Calculates the characteristics of a design and returns it. } \details{ Calculates the inflation factor (IF), the expected reduction in sample size under H1, under H0, and under a value in between H0 and H1. Furthermore, absolute information values are calculated under the prototype case testing H0: mu = 0 against H1: mu = 1. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Calculate design characteristics for a three-stage O'Brien & Fleming # design at power 90\% and compare it with Pocock's design. getDesignCharacteristics(getDesignGroupSequential(beta = 0.1)) getDesignCharacteristics(getDesignGroupSequential(beta = 0.1, typeOfDesign = "P")) } \seealso{ Other design functions: \code{\link{getDesignConditionalDunnett}()}, \code{\link{getDesignFisher}()}, \code{\link{getDesignGroupSequential}()}, \code{\link{getDesignInverseNormal}()}, \code{\link{getPowerAndAverageSampleNumber}()} } \concept{design functions} rpact/man/param_userAlphaSpending.Rd0000644000175000017500000000103614020357215017352 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_userAlphaSpending} \alias{param_userAlphaSpending} \title{Parameter Description: User Alpha Spending} \arguments{ \item{userAlphaSpending}{The user defined alpha spending. Numeric vector of length \code{kMax} containing the cumulative alpha-spending (Type I error rate) up to each interim stage: \code{0 <= alpha_1 <= ... <= alpha_K <= alpha}.} } \description{ Parameter Description: User Alpha Spending } \keyword{internal} rpact/man/getSimulationEnrichmentRates.Rd0000644000175000017500000003003614154651532020427 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_simulation_enrichment_rates.R \name{getSimulationEnrichmentRates} \alias{getSimulationEnrichmentRates} \title{Get Simulation Enrichment Rates} \usage{ getSimulationEnrichmentRates( design = NULL, ..., populations = NA_integer_, effectList = NULL, intersectionTest = c("Simes", "SpiessensDebois", "Bonferroni", "Sidak"), stratifiedAnalysis = TRUE, directionUpper = TRUE, adaptations = NA, typeOfSelection = c("best", "rBest", "epsilon", "all", "userDefined"), effectMeasure = c("effectEstimate", "testStatistic"), successCriterion = c("all", "atLeastOne"), epsilonValue = NA_real_, rValue = NA_real_, threshold = -Inf, plannedSubjects = NA_real_, allocationRatioPlanned = NA_real_, minNumberOfSubjectsPerStage = NA_real_, maxNumberOfSubjectsPerStage = NA_real_, conditionalPower = NA_real_, piTreatmentH1 = NA_real_, piControlH1 = NA_real_, maxNumberOfIterations = 1000L, seed = NA_real_, calcSubjectsFunction = NULL, selectPopulationsFunction = NULL, showStatistics = FALSE ) } \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{populations}{The number of populations in a two-sample comparison, default is \code{3}.} \item{effectList}{List of effect sizes with columns and number of rows reflecting the different situations to consider (see examples).} \item{intersectionTest}{Defines the multiple test for the intersection hypotheses in the closed system of hypotheses. Four options are available in enrichment designs: \code{"SpiessensDebois"}, \code{"Bonferroni"}, \code{"Simes"}, and \code{"Sidak"}, default is \code{"Simes"}.} \item{stratifiedAnalysis}{For enrichment designs, typically a stratified analysis should be chosen. For testing rates, also a non-stratified analysis based on overall data can be performed. For survival data, only a stratified analysis is possible (see Brannath et al., 2009), default is \code{TRUE}.} \item{directionUpper}{Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values.} \item{adaptations}{A vector of length \code{kMax - 1} indicating whether or not an adaptation takes place at interim k, default is \code{rep(TRUE, kMax - 1)}.} \item{typeOfSelection}{The way the treatment arms or populations are selected at interim. Five options are available: \code{"best"}, \code{"rbest"}, \code{"epsilon"}, \code{"all"}, and \code{"userDefined"}, default is \code{"best"}.\cr For \code{"rbest"} (select the \code{rValue} best treatment arms/populations), the parameter \code{rValue} has to be specified, for \code{"epsilon"} (select treatment arm/population not worse than epsilon compared to the best), the parameter \code{epsilonValue} has to be specified. If \code{"userDefined"} is selected, \code{"selectArmsFunction"} or \code{"selectPopulationsFunction"} has to be specified.} \item{effectMeasure}{Criterion for treatment arm/population selection, either based on test statistic (\code{"testStatistic"}) or effect estimate (difference for means and rates or ratio for survival) (\code{"effectEstimate"}), default is \code{"effectEstimate"}.} \item{successCriterion}{Defines when the study is stopped for efficacy at interim. Two options are available: \code{"all"} stops the trial if the efficacy criterion is fulfilled for all selected treatment arms/populations, \code{"atLeastOne"} stops if at least one of the selected treatment arms/populations is shown to be superior to control at interim, default is \code{"all"}.} \item{epsilonValue}{For \code{typeOfSelection = "epsilon"} (select treatment arm / population not worse than epsilon compared to the best), the parameter \code{epsilonValue} has to be specified.} \item{rValue}{For \code{typeOfSelection = "rbest"} (select the \code{rValue} best treatment arms / populations), the parameter \code{rValue} has to be specified.} \item{threshold}{Selection criterion: treatment arm / population is selected only if \code{effectMeasure} exceeds \code{threshold}, default is \code{-Inf}. \code{threshold} can also be a vector of length \code{activeArms} referring to a separate threshold condition over the treatment arms.} \item{plannedSubjects}{\code{plannedSubjects} is a vector of length \code{kMax} (the number of stages of the design) that determines the number of cumulated (overall) subjects when the interim stages are planned. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs, \code{plannedSubjects} refers to the number of subjects per selected active arm.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} \item{minNumberOfSubjectsPerStage}{When performing a data driven sample size recalculation, the vector \code{minNumberOfSubjectsPerStage} with length kMax determines the minimum number of subjects per stage (i.e., not cumulated), the first element is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs \code{minNumberOfSubjectsPerStage} refers to the minimum number of subjects per selected active arm.} \item{maxNumberOfSubjectsPerStage}{When performing a data driven sample size recalculation, the vector \code{maxNumberOfSubjectsPerStage} with length kMax determines the maximum number of subjects per stage (i.e., not cumulated), the first element is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs \code{maxNumberOfSubjectsPerStage} refers to the maximum number of subjects per selected active arm.} \item{conditionalPower}{If \code{conditionalPower} together with \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (or \code{minNumberOfEventsPerStage} and \code{maxNumberOfEventsPerStage} for survival designs) is specified, a sample size recalculation based on the specified conditional power is performed. It is defined as the power for the subsequent stage given the current data. By default, the conditional power will be calculated under the observed effect size. Optionally, you can also specify \code{thetaH1} and \code{stDevH1} (for simulating means), \code{pi1H1} and \code{pi2H1} (for simulating rates), or \code{thetaH1} (for simulating hazard ratios) as parameters under which it is calculated and the sample size recalculation is performed.} \item{piTreatmentH1}{If specified, the assumed probabilities in the active arm under which the sample size recalculation was performed and the conditional power was calculated.} \item{piControlH1}{If specified, the assumed probabilities in the control arm under which the sample size recalculation was performed and the conditional power was calculated.} \item{maxNumberOfIterations}{The number of simulation iterations, default is \code{1000}.} \item{seed}{The seed to reproduce the simulation, default is a random seed.} \item{calcSubjectsFunction}{Optionally, a function can be entered that defines the way of performing the sample size recalculation. By default, sample size recalculation is performed with conditional power with specified \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (see details and examples).} \item{selectPopulationsFunction}{Optionally, a function can be entered that defines the way of how populations are selected. This function is allowed to depend on \code{effectVector} with length \code{populations} and \code{stage} (see examples).} \item{showStatistics}{If \code{TRUE}, summary statistics of the simulated data are displayed for the \code{print} command, otherwise the output is suppressed, default is \code{FALSE}.} } \value{ Returns a \code{\link{SimulationResults}} object. The following generics (R generic functions) are available for this object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.SimulationResults]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the simulated power, stopping and selection probabilities, conditional power, and expected sample size for testing rates in an enrichment design testing situation. } \details{ At given design the function simulates the power, stopping probabilities, selection probabilities, and expected sample size at given number of subjects, parameter configuration, and treatment arm selection rule in the enrichment situation. An allocation ratio can be specified referring to the ratio of number of subjects in the active treatment groups as compared to the control group. The definition of \code{piTreatmentH1} and/or \code{piControlH1} makes only sense if \code{kMax} > 1 and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and \code{maxNumberOfSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. \code{calcSubjectsFunction}\cr This function returns the number of subjects at given conditional power and conditional critical value for specified testing situation. The function might depend on the variables \code{stage}, \code{selectedPopulations}, \code{directionUpper}, \code{plannedSubjects}, \code{allocationRatioPlanned}, \code{minNumberOfSubjectsPerStage}, \code{maxNumberOfSubjectsPerStage}, \code{conditionalPower}, \code{conditionalCriticalValue}, \code{overallRatesTreatment}, \code{overallRatesControl}, \code{piTreatmentH1}, and \code{piControlH1}. The function has to contain the three-dots argument '...' (see examples). } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ \donttest{ # Assess a population selection strategy with two subset populations and # a binary endpoint using a stratified analysis. No early efficacy stop, # weighted inverse normal method with weight sqrt(0.4). subGroups <- c("S1", "S2", "S12", "R") prevalences <- c(0.1, 0.4, 0.2, 0.3) p2 <- c(0.3, 0.4, 0.3, 0.55) range1 <- p2[1] + seq(0.0, 0.2, 0.2) range2 <- p2[2] + seq(0.0, 0.2, 0.2) range3 <- p2[3] + seq(0.0, 0.2, 0.2) range4 <- p2[4] + seq(0.0, 0.2, 0.2) piTreatments <- c() for (x1 in range1){ for (x2 in range2){ for (x3 in range3){ for (x4 in range4){ piTreatments <- c(piTreatments, x1, x2, x3, x4) }}}} effectList <- list(subGroups=subGroups, prevalences=prevalences, piControl = p2, piTreatments = matrix(piTreatments, byrow = TRUE, ncol = 4)) ds <- getDesignInverseNormal(informationRates = c(0.4, 1), typeOfDesign = "noEarlyEfficacy") simResultsPE <- getSimulationEnrichmentRates(ds, plannedSubjects = c(150, 300), allocationRatioPlanned = 1.5, directionUpper = TRUE, effectList = effectList, stratifiedAnalysis = TRUE, intersectionTest = "Sidak", typeOfSelection = "epsilon", epsilonValue = 0.025, maxNumberOfIterations = 100) print(simResultsPE) } } rpact/man/param_legendPosition.Rd0000644000175000017500000000167614020357215016733 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_legendPosition} \alias{param_legendPosition} \title{Parameter Description: Legend Position On Plots} \arguments{ \item{legendPosition}{The position of the legend. By default (\code{NA_integer_}) the algorithm tries to find a suitable position. Choose one of the following values to specify the position manually: \itemize{ \item \code{-1}: no legend will be shown \item \code{NA}: the algorithm tries to find a suitable position \item \code{0}: legend position outside plot \item \code{1}: legend position left top \item \code{2}: legend position left center \item \code{3}: legend position left bottom \item \code{4}: legend position right top \item \code{5}: legend position right center \item \code{6}: legend position right bottom }} } \description{ Parameter Description: Legend Position On Plots } \keyword{internal} rpact/man/param_alpha.Rd0000644000175000017500000000050614020357215015024 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_alpha} \alias{param_alpha} \title{Parameter Description: Alpha} \arguments{ \item{alpha}{The significance level alpha, default is \code{0.025}.} } \description{ Parameter Description: Alpha } \keyword{internal} rpact/man/param_effectList.Rd0000644000175000017500000000064014142514771016035 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_effectList} \alias{param_effectList} \title{Parameter Description: Effect List} \arguments{ \item{effectList}{List of effect sizes with columns and number of rows reflecting the different situations to consider (see examples).} } \description{ Parameter Description: Effect List } \keyword{internal} rpact/man/param_gED50.Rd0000644000175000017500000000062514142514771014554 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_gED50} \alias{param_gED50} \title{Parameter Description: G ED50} \arguments{ \item{gED50}{If \code{typeOfShape = "sigmoidEmax"} is selected, \code{"gED50"} has to be entered to specify the ED50 of the sigmoid Emax model.} } \description{ Parameter Description: G ED50 } \keyword{internal} rpact/man/param_design.Rd0000644000175000017500000000044614020357215015213 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_design} \alias{param_design} \title{Parameter Description: Design} \arguments{ \item{design}{The trial design.} } \description{ Parameter Description: Design } \keyword{internal} rpact/man/getSimulationRates.Rd0000644000175000017500000003472514153377720016426 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_simulation_base_rates.R \name{getSimulationRates} \alias{getSimulationRates} \title{Get Simulation Rates} \usage{ getSimulationRates( design = NULL, ..., groups = 2L, normalApproximation = TRUE, riskRatio = FALSE, thetaH0 = ifelse(riskRatio, 1, 0), pi1 = seq(0.2, 0.5, 0.1), pi2 = NA_real_, plannedSubjects = NA_real_, directionUpper = TRUE, allocationRatioPlanned = NA_real_, minNumberOfSubjectsPerStage = NA_real_, maxNumberOfSubjectsPerStage = NA_real_, conditionalPower = NA_real_, pi1H1 = NA_real_, pi2H1 = NA_real_, maxNumberOfIterations = 1000L, seed = NA_real_, calcSubjectsFunction = NULL, showStatistics = FALSE ) } \arguments{ \item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{groups}{The number of treatment groups (1 or 2), default is \code{2}.} \item{normalApproximation}{The type of computation of the p-values. Default is \code{FALSE} for testing means (i.e., the t test is used) and \code{TRUE} for testing rates and the hazard ratio. For testing rates, if \code{normalApproximation = FALSE} is specified, the binomial test (one sample) or the exact test of Fisher (two samples) is used for calculating the p-values. In the survival setting \code{normalApproximation = FALSE} has no effect.} \item{riskRatio}{If \code{TRUE}, the design characteristics for one-sided testing of H0: \code{pi1 / pi2 = thetaH0} are simulated, default is \code{FALSE}.} \item{thetaH0}{The null hypothesis value, default is \code{0} for the normal and the binary case (testing means and rates, respectively), it is \code{1} for the survival case (testing the hazard ratio).\cr\cr For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. That is, in case of (one-sided) testing of \itemize{ \item \emph{means}: a value \code{!= 0} (or a value \code{!= 1} for testing the mean ratio) can be specified. \item \emph{rates}: a value \code{!= 0} (or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. \item \emph{survival data}: a bound for testing H0: \code{hazard ratio = thetaH0 != 1} can be specified. } For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for defining the null hypothesis H0: \code{pi = thetaH0}.} \item{pi1}{A numeric value or vector that represents the assumed probability in the active treatment group if two treatment groups are considered, or the alternative probability for a one treatment group design, default is \code{seq(0.2, 0.5, 0.1)} (power calculations and simulations) or \code{seq(0.4, 0.6, 0.1)} (sample size calculations).} \item{pi2}{A numeric value that represents the assumed probability in the reference group if two treatment groups are considered, default is \code{0.2}.} \item{plannedSubjects}{\code{plannedSubjects} is a vector of length \code{kMax} (the number of stages of the design) that determines the number of cumulated (overall) subjects when the interim stages are planned. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs, \code{plannedSubjects} refers to the number of subjects per selected active arm.} \item{directionUpper}{Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} \item{minNumberOfSubjectsPerStage}{When performing a data driven sample size recalculation, the vector \code{minNumberOfSubjectsPerStage} with length kMax determines the minimum number of subjects per stage (i.e., not cumulated), the first element is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs \code{minNumberOfSubjectsPerStage} refers to the minimum number of subjects per selected active arm.} \item{maxNumberOfSubjectsPerStage}{When performing a data driven sample size recalculation, the vector \code{maxNumberOfSubjectsPerStage} with length kMax determines the maximum number of subjects per stage (i.e., not cumulated), the first element is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs \code{maxNumberOfSubjectsPerStage} refers to the maximum number of subjects per selected active arm.} \item{conditionalPower}{If \code{conditionalPower} together with \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (or \code{minNumberOfEventsPerStage} and \code{maxNumberOfEventsPerStage} for survival designs) is specified, a sample size recalculation based on the specified conditional power is performed. It is defined as the power for the subsequent stage given the current data. By default, the conditional power will be calculated under the observed effect size. Optionally, you can also specify \code{thetaH1} and \code{stDevH1} (for simulating means), \code{pi1H1} and \code{pi2H1} (for simulating rates), or \code{thetaH1} (for simulating hazard ratios) as parameters under which it is calculated and the sample size recalculation is performed.} \item{pi1H1}{If specified, the assumed probability in the active treatment group if two treatment groups are considered, or the assumed probability for a one treatment group design, for which the conditional power was calculated.} \item{pi2H1}{If specified, the assumed probability in the reference group if two treatment groups are considered, for which the conditional power was calculated.} \item{maxNumberOfIterations}{The number of simulation iterations, default is \code{1000}.} \item{seed}{The seed to reproduce the simulation, default is a random seed.} \item{calcSubjectsFunction}{Optionally, a function can be entered that defines the way of performing the sample size recalculation. By default, sample size recalculation is performed with conditional power with specified \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (see details and examples).} \item{showStatistics}{If \code{TRUE}, summary statistics of the simulated data are displayed for the \code{print} command, otherwise the output is suppressed, default is \code{FALSE}.} } \value{ Returns a \code{\link{SimulationResults}} object. The following generics (R generic functions) are available for this object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.SimulationResults]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the simulated power, stopping probabilities, conditional power, and expected sample size for testing rates in a one or two treatment groups testing situation. } \details{ At given design the function simulates the power, stopping probabilities, conditional power, and expected sample size at given number of subjects and parameter configuration. Additionally, an allocation ratio = n1/n2 can be specified where n1 and n2 are the number of subjects in the two treatment groups. The definition of \code{pi1H1} and/or \code{pi2H1} makes only sense if \code{kMax} > 1 and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and \code{maxNumberOfSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. \code{calcSubjectsFunction}\cr This function returns the number of subjects at given conditional power and conditional critical value for specified testing situation. The function might depend on variables \code{stage}, \code{riskRatio}, \code{thetaH0}, \code{groups}, \code{plannedSubjects}, \code{sampleSizesPerStage}, \code{directionUpper}, \code{allocationRatioPlanned}, \code{minNumberOfSubjectsPerStage}, \code{maxNumberOfSubjectsPerStage}, \code{conditionalPower}, \code{conditionalCriticalValue}, \code{overallRate}, \code{farringtonManningValue1}, and \code{farringtonManningValue2}. The function has to contain the three-dots argument '...' (see examples). } \section{Simulation Data}{ The summary statistics "Simulated data" contains the following parameters: median [range]; mean +/-sd\cr \code{$show(showStatistics = FALSE)} or \code{$setShowStatistics(FALSE)} can be used to disable the output of the aggregated simulated data.\cr Example 1: \cr \code{simulationResults <- getSimulationRates(plannedSubjects = 40)} \cr \code{simulationResults$show(showStatistics = FALSE)}\cr Example 2: \cr \code{simulationResults <- getSimulationRates(plannedSubjects = 40)} \cr \code{simulationResults$setShowStatistics(FALSE)}\cr \code{simulationResults}\cr \code{\link{getData}} can be used to get the aggregated simulated data from the object as \code{\link[base]{data.frame}}. The data frame contains the following columns: \enumerate{ \item \code{iterationNumber}: The number of the simulation iteration. \item \code{stageNumber}: The stage. \item \code{pi1}: The assumed or derived event rate in the treatment group (if available). \item \code{pi2}: The assumed or derived event rate in the control group (if available). \item \code{numberOfSubjects}: The number of subjects under consideration when the (interim) analysis takes place. \item \code{rejectPerStage}: 1 if null hypothesis can be rejected, 0 otherwise. \item \code{futilityPerStage}: 1 if study should be stopped for futility, 0 otherwise. \item \code{testStatistic}: The test statistic that is used for the test decision, depends on which design was chosen (group sequential, inverse normal, or Fisher combination test)' \item \code{testStatisticsPerStage}: The test statistic for each stage if only data from the considered stage is taken into account. \item \code{overallRate1}: The cumulative rate in treatment group 1. \item \code{overallRate2}: The cumulative rate in treatment group 2. \item \code{stagewiseRates1}: The stage-wise rate in treatment group 1. \item \code{stagewiseRates2}: The stage-wise rate in treatment group 2. \item \code{sampleSizesPerStage1}: The stage-wise sample size in treatment group 1. \item \code{sampleSizesPerStage2}: The stage-wise sample size in treatment group 2. \item \code{trialStop}: \code{TRUE} if study should be stopped for efficacy or futility or final stage, \code{FALSE} otherwise. \item \code{conditionalPowerAchieved}: The conditional power for the subsequent stage of the trial for selected sample size and effect. The effect is either estimated from the data or can be user defined with \code{pi1H1} and \code{pi2H1}. } } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Fixed sample size design (two groups) with total sample # size 120, pi1 = (0.3,0.4,0.5,0.6) and pi2 = 0.3 getSimulationRates(pi1 = seq(0.3, 0.6, 0.1), pi2 = 0.3, plannedSubjects = 120, maxNumberOfIterations = 10) \donttest{ # Increase number of simulation iterations and compare results with power calculator getSimulationRates(pi1 = seq(0.3, 0.6, 0.1), pi2 = 0.3, plannedSubjects = 120, maxNumberOfIterations = 50) getPowerRates(pi1 = seq(0.3, 0.6, 0.1), pi2 = 0.3, maxNumberOfSubjects = 120) # Do the same for a two-stage Pocock inverse normal group sequential # design with non-binding futility stops designIN <- getDesignInverseNormal(typeOfDesign = "P", futilityBounds = c(0)) getSimulationRates(designIN, pi1 = seq(0.3, 0.6, 0.1), pi2 = 0.3, plannedSubjects = c(40, 80), maxNumberOfIterations = 50) getPowerRates(designIN, pi1 = seq(0.3, 0.6, 0.1), pi2 = 0.3, maxNumberOfSubjects = 80) # Assess power and average sample size if a sample size reassessment is # foreseen at conditional power 80\% for the subsequent stage (decrease and increase) # based on observed overall rates and specified minNumberOfSubjectsPerStage # and maxNumberOfSubjectsPerStage # Do the same under the assumption that a sample size increase only takes place # if the rate difference exceeds the value 0.1 at interim. For this, the sample # size recalculation method needs to be redefined: mySampleSizeCalculationFunction <- function(..., stage, plannedSubjects, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage, conditionalPower, conditionalCriticalValue, overallRate) { if (overallRate[1] - overallRate[2] < 0.1) { return(plannedSubjects[stage] - plannedSubjects[stage - 1]) } else { rateUnderH0 <- (overallRate[1] + overallRate[2]) / 2 stageSubjects <- 2 * (max(0, conditionalCriticalValue * sqrt(2 * rateUnderH0 * (1 - rateUnderH0)) + stats::qnorm(conditionalPower) * sqrt(overallRate[1] * (1 - overallRate[1]) + overallRate[2] * (1 - overallRate[2]))))^2 / (max(1e-12, (overallRate[1] - overallRate[2])))^2 stageSubjects <- ceiling(min(max( minNumberOfSubjectsPerStage[stage], stageSubjects), maxNumberOfSubjectsPerStage[stage])) return(stageSubjects) } } getSimulationRates(designIN, pi1 = seq(0.3, 0.6, 0.1), pi2 = 0.3, plannedSubjects = c(40, 80), minNumberOfSubjectsPerStage = c(40, 20), maxNumberOfSubjectsPerStage = c(40, 160), conditionalPower = 0.8, calcSubjectsFunction = mySampleSizeCalculationFunction, maxNumberOfIterations = 50) } } rpact/man/SimulationResultsRates.Rd0000644000175000017500000000057614020357214017272 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R \docType{class} \name{SimulationResultsRates} \alias{SimulationResultsRates} \title{Class for Simulation Results Rates} \description{ A class for simulation results rates. } \details{ Use \code{\link{getSimulationRates}} to create an object of this type. } \keyword{internal} rpact/man/getLambdaStepFunction.Rd0000644000175000017500000000244714020357214017006 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_core_plot.R \name{getLambdaStepFunction} \alias{getLambdaStepFunction} \title{Get Lambda Step Function} \usage{ getLambdaStepFunction(timeValues, ..., piecewiseSurvivalTime, piecewiseLambda) } \arguments{ \item{timeValues}{A numeric vector that specifies the time values for which the lambda step values shall be calculated.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{piecewiseSurvivalTime}{A numeric vector that specifies the time intervals for the piecewise definition of the exponential survival time cumulative distribution function (see details).} \item{piecewiseLambda}{A numeric vector that specifies the assumed hazard rate in the treatment group.} } \value{ A numeric vector containing the lambda step values that corresponds to the specified time values. } \description{ Calculates the lambda step values for a given time vector. } \details{ The first element of the vector \code{piecewiseSurvivalTime} must be equal to \code{0}. This function is used for plotting of sample size survival results (cf., \code{\link[=plot.TrialDesignPlan]{plot}}, \code{type = 13} and \code{type = 14}). } \keyword{internal} rpact/man/param_stDev.Rd0000644000175000017500000000100614037546443015033 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_stDev} \alias{param_stDev} \title{Parameter Description: Standard Deviation} \arguments{ \item{stDev}{The standard deviation under which the sample size or power calculation is performed, default is \code{1}. If \code{meanRatio = TRUE} is specified, \code{stDev} defines the coefficient of variation \code{sigma / mu2}.} } \description{ Parameter Description: Standard Deviation } \keyword{internal} rpact/man/param_stratifiedAnalysis.Rd0000644000175000017500000000114714107154147017610 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_stratifiedAnalysis} \alias{param_stratifiedAnalysis} \title{Parameter Description: Stratified Analysis} \arguments{ \item{stratifiedAnalysis}{For enrichment designs, typically a stratified analysis should be chosen. For testing rates, also a non-stratified analysis based on overall data can be performed. For survival data, only a stratified analysis is possible (see Brannath et al., 2009), default is \code{TRUE}.} } \description{ Parameter Description: Stratified Analysis } \keyword{internal} rpact/man/getAnalysisResults.Rd0000644000175000017500000003473714153377720016453 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_analysis_base.R \name{getAnalysisResults} \alias{getAnalysisResults} \title{Get Analysis Results} \usage{ getAnalysisResults( design, dataInput, ..., directionUpper = TRUE, thetaH0 = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = 1, stage = NA_integer_, maxInformation = NULL, informationEpsilon = NULL ) } \arguments{ \item{design}{The trial design.} \item{dataInput}{The summary data used for calculating the test results. This is either an element of \code{DatasetMeans}, of \code{DatasetRates}, or of \code{DatasetSurvival} and should be created with the function \code{getDataset}. For more information see \code{\link{getDataset}}.} \item{...}{Further arguments to be passed to methods (cf. separate functions in "See Also" below), e.g., \describe{ \item{\code{thetaH1} and \code{assumedStDev} or \code{pi1}, \code{pi2}}{The assumed effect size or assumed rates to calculate the conditional power. Depending on the type of dataset, either \code{thetaH1} (means and survival) or \code{pi1}, \code{pi2} (rates) can be specified. For testing means, an assumed standard deviation can be specified, default is \code{1}.} \item{\code{normalApproximation}}{The type of computation of the p-values. Default is \code{FALSE} for testing means (i.e., the t test is used) and \code{TRUE} for testing rates and the hazard ratio. For testing rates, if \code{normalApproximation = FALSE} is specified, the binomial test (one sample) or the exact test of Fisher (two samples) is used for calculating the p-values. In the survival setting, \code{normalApproximation = FALSE} has no effect.} \item{\code{equalVariances}}{The type of t test. For testing means in two treatment groups, either the t test assuming that the variances are equal or the t test without assuming this, i.e., the test of Welch-Satterthwaite is calculated, default is \code{TRUE}.} \item{\code{iterations}}{Iterations for simulating the power for Fisher's combination test. If the power for more than one remaining stages is to be determined for Fisher's combination test, it is estimated via simulation with specified \cr \code{iterations}, the default is \code{1000}.} \item{\code{seed}}{Seed for simulating the power for Fisher's combination test. See above, default is a random seed.} \item{\code{intersectionTest}}{Defines the multiple test for the intersection hypotheses in the closed system of hypotheses when testing multiple hypotheses. Five options are available in multi-arm designs: \code{"Dunnett"}, \code{"Bonferroni"}, \code{"Simes"}, \code{"Sidak"}, and \code{"Hierarchical"}, default is \code{"Dunnett"}. Four options are available in population enrichment designs: \code{"SpiessensDebois"} (one subset only), \code{"Bonferroni"}, \code{"Simes"}, and \code{"Sidak"}, default is \code{"Simes"}.} \item{\code{varianceOption}}{Defines the way to calculate the variance in multiple treatment arms (> 2) or population enrichment designs for testing means. For multiple arms, three options are available: \code{"overallPooled"}, \code{"pairwisePooled"}, and \code{"notPooled"}, default is \code{"overallPooled"}. For enrichment designs, the options are: \code{"pooled"}, \code{"pooledFromFull"} (one subset only), and \code{"notPooled"}, default is \code{"pooled"}.} \item{\code{thetaH1} and \code{assumedStDevs} or \code{piTreatments}, \code{piControl}}{The assumed effect size or assumed rates to calculate the conditional power in multi-arm trials or enrichment designs. For survival designs, \code{thetaH1} refers to the hazard ratio. You can specify a value or a vector with elements referring to the treatment arms or the sub-populations, respectively. If not specified, the conditional power is calculated under the assumption of observed effect sizes, standard deviations, rates, or hazard ratios.} \item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. For testing means and rates, also a non-stratified analysis based on overall data can be performed. For survival data, only a stratified analysis is possible (see Brannath et al., 2009), default is \code{TRUE}.} }} \item{directionUpper}{Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values.} \item{thetaH0}{The null hypothesis value, default is \code{0} for the normal and the binary case (testing means and rates, respectively), it is \code{1} for the survival case (testing the hazard ratio).\cr\cr For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. That is, in case of (one-sided) testing of \itemize{ \item \emph{means}: a value \code{!= 0} (or a value \code{!= 1} for testing the mean ratio) can be specified. \item \emph{rates}: a value \code{!= 0} (or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. \item \emph{survival data}: a bound for testing H0: \code{hazard ratio = thetaH0 != 1} can be specified. } For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for defining the null hypothesis H0: \code{pi = thetaH0}.} \item{nPlanned}{The additional (i.e., "new" and not cumulative) sample size planned for each of the subsequent stages. The argument must be a vector with length equal to the number of remaining stages and contain the combined sample size from both treatment groups if two groups are considered. For survival outcomes, it should contain the planned number of additional events. For multi-arm designs, it is the per-comparison (combined) sample size. For enrichment designs, it is the (combined) sample size for the considered sub-population.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control.} \item{stage}{The stage number (optional). Default: total number of existing stages in the data input.} \item{maxInformation}{Positive integer value specifying the maximum information.} \item{informationEpsilon}{Positive integer value specifying the absolute information epsilon, which defines the maximum distance from the observed information to the maximum information that causes the final analysis. Updates at the final analysis in case the observed information at the final analysis is smaller ("under-running") than the planned maximum information \code{maxInformation}, default is 0. Alternatively, a floating-point number > 0 and < 1 can be specified to define a relative information epsilon.} } \value{ Returns an \code{\link{AnalysisResults}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.AnalysisResults]{names}} to obtain the field names, \item \code{\link[=print.ParameterSet]{print}} to print the object, \item \code{\link[=summary.AnalysisResults]{summary}} to display a summary of the object, \item \code{\link[=plot.AnalysisResults]{plot}} to plot the object, \item \code{\link[=as.data.frame.AnalysisResults]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Calculates and returns the analysis results for the specified design and data. } \details{ Given a design and a dataset, at given stage the function calculates the test results (effect sizes, stage-wise test statistics and p-values, overall p-values and test statistics, conditional rejection probability (CRP), conditional power, Repeated Confidence Intervals (RCIs), repeated overall p-values, and final stage p-values, median unbiased effect estimates, and final confidence intervals. For designs with more than two treatments arms (multi-arm designs) or enrichment designs a closed combination test is performed. That is, additionally the statistics to be used in a closed testing procedure are provided. The conditional power is calculated only if effect size and sample size is specified. Median unbiased effect estimates and confidence intervals are calculated if a group sequential design or an inverse normal combination test design was chosen, i.e., it is not applicable for Fisher's p-value combination test design. For the inverse normal combination test design with more than two stages, a warning informs that the validity of the confidence interval is theoretically shown only if no sample size change was performed. A final stage p-value for Fisher's combination test is calculated only if a two-stage design was chosen. For Fisher's combination test, the conditional power for more than one remaining stages is estimated via simulation. Final stage p-values, median unbiased effect estimates, and final confidence intervals are not calculated for multi-arm and enrichment designs. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \section{Note on the dependency of \code{mnormt}}{ If \code{intersectionTest = "Dunnett"} or \code{intersectionTest = "SpiessensDebois"}, or the design is a conditional Dunnett design and the dataset is a multi-arm or enrichment dataset, \code{rpact} uses the R package \href{https://cran.r-project.org/package=mnormt}{mnormt} to calculate the analysis results. } \examples{ \donttest{ # Example 1 One-Sample Test # Perform an analysis within a three-stage group sequential design with # O'Brien & Fleming boundaries and one-sample data with a continuous outcome # where H0: mu = 1.2 is to be tested dsnGS <- getDesignGroupSequential() dataMeans <- getDataset( n = c(30,30), means = c(1.96,1.76), stDevs = c(1.92,2.01)) getAnalysisResults(design = dsnGS, dataInput = dataMeans, thetaH0 = 1.2) # You can obtain the results when performing an inverse normal combination test # with these data by using the commands dsnIN <- getDesignInverseNormal() getAnalysisResults(design = dsnIN, dataInput = dataMeans, thetaH0 = 1.2) # Example 2 Use Function Approach with Time to Event Data # Perform an analysis within a use function approach according to an # O'Brien & Fleming type use function and survival data where # where H0: hazard ratio = 1 is to be tested. The events were observed # over time and maxInformation = 120, informationEpsilon = 5 specifies # that 116 > 120 - 5 observed events defines the final analysis. design <- getDesignGroupSequential(typeOfDesign = "asOF") dataSurvival <- getDataset( overallEvents = c(33, 72, 116), overallLogRanks = c(1.33, 1.88, 1.902)) getAnalysisResults(design, dataInput = dataSurvival, maxInformation = 120, informationEpsilon = 5) # Example 3 Multi-Arm Design # In a four-stage combination test design with O'Brien & Fleming boundaries # at the first stage the second treatment arm was dropped. With the Bonferroni # intersection test, the results together with the CRP, conditional power # (assuming a total of 40 subjects for each comparison and effect sizes 0.5 # and 0.8 for treatment arm 1 and 3, respectively, and standard deviation 1.2), # RCIs and p-values of a closed adaptive test procedure are # obtained as follows with the given data (treatment arm 4 refers to the # reference group (displayed with summary and plot commands): data <- getDataset( n1 = c(22, 23), n2 = c(21, NA), n3 = c(20, 25), n4 = c(25, 27), means1 = c(1.63, 1.51), means2 = c(1.4, NA), means3 = c(0.91, 0.95), means4 = c(0.83, 0.75), stds1 = c(1.2, 1.4), stds2 = c(1.3, NA), stds3 = c(1.1, 1.14), stds4 = c(1.02, 1.18)) design <- getDesignInverseNormal(kMax = 4) x <- getAnalysisResults(design, dataInput = data, intersectionTest = "Bonferroni", nPlanned = c(40, 40), thetaH1 = c(0.5, NA, 0.8), assumedStDevs = 1.2) summary(x) plot(x, thetaRange = c(0,0.8)) design <- getDesignConditionalDunnett(secondStageConditioning = FALSE) y <- getAnalysisResults(design, dataInput = data, nPlanned = c(40), thetaH1 = c(0.5, NA, 0.8), assumedStDevs = 1.2, stage = 1) summary(y) plot(y, thetaRange = c(0,0.4)) # Example 4 Enrichment Design # Perform an two-stage enrichment design analysis with O'Brien & Fleming boundaries # where one sub-population (S1) and a full population (F) are considered as primary # analysis sets. At interim, S1 is selected for further analysis and the sample # size is increased accordingly. With the Spiessens & Debois intersection test, # the results of a closed adaptive test procedure together with the CRP, repeated # RCIs and p-values are obtained as follows with the given data (displayed with # summary and plot commands): design <- getDesignInverseNormal(kMax = 2, typeOfDesign = "OF") dataS1 <- getDataset( means1 = c(13.2, 12.8), means2 = c(11.1, 10.8), stDev1 = c(3.4, 3.3), stDev2 = c(2.9, 3.5), n1 = c(21, 42), n2 = c(19, 39)) dataNotS1 <- getDataset( means1 = c(11.8, NA), means2 = c(10.5, NA), stDev1 = c(3.6, NA), stDev2 = c(2.7, NA), n1 = c(15, NA), n2 = c(13, NA)) dataBoth <- getDataset(S1 = dataS1, R = dataNotS1) x <- getAnalysisResults(design, dataInput = dataBoth, intersectionTest = "SpiessensDebois", varianceOption = "pooledFromFull", stratifiedAnalysis = TRUE) summary(x) plot(x, type = 2) } } \seealso{ \itemize{ \item \code{\link{getObservedInformationRates}} for recalculation the observed information rates. } Other analysis functions: \code{\link{getClosedCombinationTestResults}()}, \code{\link{getClosedConditionalDunnettTestResults}()}, \code{\link{getConditionalPower}()}, \code{\link{getConditionalRejectionProbabilities}()}, \code{\link{getFinalConfidenceInterval}()}, \code{\link{getFinalPValue}()}, \code{\link{getRepeatedConfidenceIntervals}()}, \code{\link{getRepeatedPValues}()}, \code{\link{getStageResults}()}, \code{\link{getTestActions}()} } \concept{analysis functions} rpact/man/param_minNumberOfSubjectsPerStage.Rd0000644000175000017500000000151414020357215021316 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_minNumberOfSubjectsPerStage} \alias{param_minNumberOfSubjectsPerStage} \title{Parameter Description: Minimum Number Of Subjects Per Stage} \arguments{ \item{minNumberOfSubjectsPerStage}{When performing a data driven sample size recalculation, the vector \code{minNumberOfSubjectsPerStage} with length kMax determines the minimum number of subjects per stage (i.e., not cumulated), the first element is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs \code{minNumberOfSubjectsPerStage} refers to the minimum number of subjects per selected active arm.} } \description{ Parameter Description: Minimum Number Of Subjects Per Stage } \keyword{internal} rpact/man/AnalysisResultsEnrichment.Rd0000644000175000017500000000101214020357214017731 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsEnrichment} \alias{AnalysisResultsEnrichment} \title{Basic Class for Analysis Results Enrichment} \description{ A basic class for enrichment analysis results. } \details{ \code{AnalysisResultsEnrichment} is the basic class for \itemize{ \item \code{\link{AnalysisResultsEnrichmentFisher}} and \item \code{\link{AnalysisResultsEnrichmentInverseNormal}}. } } \keyword{internal} rpact/man/TrialDesignGroupSequential.Rd0000644000175000017500000000103414020357214020030 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R \docType{class} \name{TrialDesignGroupSequential} \alias{TrialDesignGroupSequential} \title{Group Sequential Design} \description{ Trial design for group sequential design. } \details{ This object should not be created directly; use \code{\link{getDesignGroupSequential}} with suitable arguments to create a group sequential design. } \seealso{ \code{\link{getDesignGroupSequential}} for creating a group sequential design. } \keyword{internal} rpact/man/param_dataInput.Rd0000644000175000017500000000106414055345235015677 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_dataInput} \alias{param_dataInput} \title{Parameter Description: Data Input} \arguments{ \item{dataInput}{The summary data used for calculating the test results. This is either an element of \code{DatasetMeans}, of \code{DatasetRates}, or of \code{DatasetSurvival} and should be created with the function \code{getDataset}. For more information see \code{\link{getDataset}}.} } \description{ Parameter Description: Data Input } \keyword{internal} rpact/man/readDataset.Rd0000644000175000017500000000726514020357214015010 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R \name{readDataset} \alias{readDataset} \title{Read Dataset} \usage{ readDataset( file, ..., header = TRUE, sep = ",", quote = "\\"", dec = ".", fill = TRUE, comment.char = "", fileEncoding = "UTF-8" ) } \arguments{ \item{file}{A CSV file (see \code{\link[utils]{read.table}}).} \item{...}{Further arguments to be passed to code{\link[utils]{read.table}}.} \item{header}{A logical value indicating whether the file contains the names of the variables as its first line.} \item{sep}{The field separator character. Values on each line of the file are separated by this character. If sep = "," (the default for \code{readDataset}) the separator is a comma.} \item{quote}{The set of quoting characters. To disable quoting altogether, use quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only considered for columns read as character, which is all of them unless \code{colClasses} is specified.} \item{dec}{The character used in the file for decimal points.} \item{fill}{logical. If \code{TRUE} then in case the rows have unequal length, blank fields are implicitly added.} \item{comment.char}{character: a character vector of length one containing a single character or an empty string. Use "" to turn off the interpretation of comments altogether.} \item{fileEncoding}{character string: if non-empty declares the encoding used on a file (not a connection) so the character data can be re-encoded. See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'.} } \value{ Returns a \code{\link{Dataset}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.Dataset]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Reads a data file and returns it as dataset object. } \details{ \code{readDataset} is a wrapper function that uses \code{\link[utils]{read.table}} to read the CSV file into a data frame, transfers it from long to wide format with \code{\link[stats]{reshape}} and puts the data to \code{\link{getDataset}}. } \examples{ dataFileRates <- system.file("extdata", "dataset_rates.csv", package = "rpact") if (dataFileRates != "") { datasetRates <- readDataset(dataFileRates) datasetRates } dataFileMeansMultiArm <- system.file("extdata", "dataset_means_multi-arm.csv", package = "rpact") if (dataFileMeansMultiArm != "") { datasetMeansMultiArm <- readDataset(dataFileMeansMultiArm) datasetMeansMultiArm } dataFileRatesMultiArm <- system.file("extdata", "dataset_rates_multi-arm.csv", package = "rpact") if (dataFileRatesMultiArm != "") { datasetRatesMultiArm <- readDataset(dataFileRatesMultiArm) datasetRatesMultiArm } dataFileSurvivalMultiArm <- system.file("extdata", "dataset_survival_multi-arm.csv", package = "rpact") if (dataFileSurvivalMultiArm != "") { datasetSurvivalMultiArm <- readDataset(dataFileSurvivalMultiArm) datasetSurvivalMultiArm } } \seealso{ \itemize{ \item \code{\link{readDatasets}} for reading multiple datasets, \item \code{\link{writeDataset}} for writing a single dataset, \item \code{\link{writeDatasets}} for writing multiple datasets. } } rpact/man/param_intersectionTest_MultiArm.Rd0000644000175000017500000000115314046411610021114 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_intersectionTest_MultiArm} \alias{param_intersectionTest_MultiArm} \title{Parameter Description: Intersection Test} \arguments{ \item{intersectionTest}{Defines the multiple test for the intersection hypotheses in the closed system of hypotheses. Five options are available in multi-arm designs: \code{"Dunnett"}, \code{"Bonferroni"}, \code{"Simes"}, \code{"Sidak"}, and \code{"Hierarchical"}, default is \code{"Dunnett"}.} } \description{ Parameter Description: Intersection Test } \keyword{internal} rpact/man/FieldSet_names.Rd0000644000175000017500000000113314020357214015435 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_parameter_set.R \name{FieldSet_names} \alias{FieldSet_names} \alias{names.FieldSet} \title{Names of a Field Set Object} \usage{ \method{names}{FieldSet}(x) } \arguments{ \item{x}{A \code{\link{FieldSet}} object.} } \value{ Returns a \code{\link[base]{character}} vector containing the names of the \code{\link{AnalysisResults}} object. } \description{ Function to get the names of a \code{\link{FieldSet}} object. } \details{ Returns the names of a field set that can be accessed by the user. } \keyword{internal} rpact/man/AnalysisResultsConditionalDunnett.Rd0000644000175000017500000000106714020357214021454 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsConditionalDunnett} \alias{AnalysisResultsConditionalDunnett} \title{Analysis Results Multi-Arm Conditional Dunnett} \description{ Class for multi-arm analysis results based on a conditional Dunnett test design. } \details{ This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the multi-arm analysis results of a conditional Dunnett test design. } \keyword{internal} rpact/man/AnalysisResultsGroupSequential.Rd0000644000175000017500000000101014020357214020762 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsGroupSequential} \alias{AnalysisResultsGroupSequential} \title{Analysis Results Group Sequential} \description{ Class for analysis results results based on a group sequential design. } \details{ This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the analysis results of a group sequential design. } \keyword{internal} rpact/man/getPiecewiseSurvivalTime.Rd0000644000175000017500000001400714060361011017541 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_time.R \name{getPiecewiseSurvivalTime} \alias{getPiecewiseSurvivalTime} \title{Get Piecewise Survival Time} \usage{ getPiecewiseSurvivalTime( piecewiseSurvivalTime = NA_real_, ..., lambda1 = NA_real_, lambda2 = NA_real_, hazardRatio = NA_real_, pi1 = NA_real_, pi2 = NA_real_, median1 = NA_real_, median2 = NA_real_, eventTime = 12L, kappa = 1, delayedResponseAllowed = FALSE ) } \arguments{ \item{piecewiseSurvivalTime}{A vector that specifies the time intervals for the piecewise definition of the exponential survival time cumulative distribution function (see details).} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{lambda1}{The assumed hazard rate in the treatment group, there is no default. \code{lambda1} can also be used to define piecewise exponentially distributed survival times (see details).} \item{lambda2}{The assumed hazard rate in the reference group, there is no default. \code{lambda2} can also be used to define piecewise exponentially distributed survival times (see details).} \item{hazardRatio}{The vector of hazard ratios under consideration. If the event or hazard rates in both treatment groups are defined, the hazard ratio needs not to be specified as it is calculated, there is no default.} \item{pi1}{A numeric value or vector that represents the assumed event rate in the treatment group, default is \code{seq(0.2, 0.5, 0.1)} (power calculations and simulations) or \code{seq(0.4, 0.6, 0.1)} (sample size calculations).} \item{pi2}{A numeric value that represents the assumed event rate in the control group, default is \code{0.2}.} \item{median1}{The assumed median survival time in the treatment group, there is no default.} \item{median2}{The assumed median survival time in the reference group, there is no default.} \item{eventTime}{The assumed time under which the event rates are calculated, default is \code{12}.} \item{kappa}{A numeric value > 0. A \code{kappa != 1} will be used for the specification of the shape of the Weibull distribution. Default is \code{1}, i.e., the exponential survival distribution is used instead of the Weibull distribution. Note that the Weibull distribution cannot be used for the piecewise definition of the survival time distribution, i.e., only \code{piecewiselambda} (as a single value) and \code{kappa} can be specified. This function is equivalent to \code{pweibull(t, shape = kappa, scale = 1 / lambda)} of the \code{stats} package, i.e., the scale parameter is \code{1 / 'hazard rate'}.\cr For example, \code{getPiecewiseExponentialDistribution(time = 130, piecewiseLambda = 0.01, kappa = 4.2)} and \code{pweibull(q = 130, shape = 4.2, scale = 1 / 0.01)} provide the sample result.} \item{delayedResponseAllowed}{If \code{TRUE}, delayed response is allowed; otherwise it will be validated that the response is not delayed, default is \code{FALSE}.} } \value{ Returns a \code{\link{PiecewiseSurvivalTime}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.ParameterSet]{plot}} to plot the object, \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns a \code{PiecewiseSurvivalTime} object that contains the all relevant parameters of an exponential survival time cumulative distribution function. Use \code{\link[base]{names}} to obtain the field names. } \section{Piecewise survival time}{ The first element of the vector \code{piecewiseSurvivalTime} must be equal to \code{0}. \code{piecewiseSurvivalTime} can also be a list that combines the definition of the time intervals and hazard rates in the reference group. The definition of the survival time in the treatment group is obtained by the specification of the hazard ratio (see examples for details). } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ getPiecewiseSurvivalTime(lambda2 = 0.5, hazardRatio = 0.8) getPiecewiseSurvivalTime(lambda2 = 0.5, lambda1 = 0.4) getPiecewiseSurvivalTime(pi2 = 0.5, hazardRatio = 0.8) getPiecewiseSurvivalTime(pi2 = 0.5, pi1 = 0.4) getPiecewiseSurvivalTime(pi1 = 0.3) getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4) getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6, 9), lambda2 = c(0.025, 0.04, 0.015), hazardRatio = 0.8) getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6, 9), lambda2 = c(0.025, 0.04, 0.015), lambda1 = c(0.025, 0.04, 0.015) * 0.8) pwst <- getPiecewiseSurvivalTime(list( "0 - <6" = 0.025, "6 - <9" = 0.04, "9 - <15" = 0.015, "15 - <21" = 0.01, ">=21" = 0.007), hazardRatio = 0.75) pwst \donttest{ # The object created by getPiecewiseSurvivalTime() can be used directly in # getSampleSizeSurvival(): getSampleSizeSurvival(piecewiseSurvivalTime = pwst) # The object created by getPiecewiseSurvivalTime() can be used directly in # getPowerSurvival(): getPowerSurvival(piecewiseSurvivalTime = pwst, maxNumberOfEvents = 40, maxNumberOfSubjects = 100) } } rpact/man/writeDatasets.Rd0000644000175000017500000000573514020357214015412 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R \name{writeDatasets} \alias{writeDatasets} \title{Write Multiple Datasets} \usage{ writeDatasets( datasets, file, ..., append = FALSE, quote = TRUE, sep = ",", eol = "\\n", na = "NA", dec = ".", row.names = TRUE, col.names = NA, qmethod = "double", fileEncoding = "UTF-8" ) } \arguments{ \item{datasets}{A list of datasets.} \item{file}{The target CSV file.} \item{...}{Further arguments to be passed to \code{\link[utils]{write.table}}.} \item{append}{Logical. Only relevant if file is a character string. If \code{TRUE}, the output is appended to the file. If FALSE, any existing file of the name is destroyed.} \item{quote}{The set of quoting characters. To disable quoting altogether, use quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only considered for columns read as character, which is all of them unless \code{colClasses} is specified.} \item{sep}{The field separator character. Values on each line of the file are separated by this character. If sep = "," (the default for \code{writeDatasets}) the separator is a comma.} \item{eol}{The character(s) to print at the end of each line (row).} \item{na}{The string to use for missing values in the data.} \item{dec}{The character used in the file for decimal points.} \item{row.names}{Either a logical value indicating whether the row names of \code{dataset} are to be written along with \code{dataset}, or a character vector of row names to be written.} \item{col.names}{Either a logical value indicating whether the column names of \code{dataset} are to be written along with \code{dataset}, or a character vector of column names to be written. See the section on 'CSV files' for the meaning of \code{col.names = NA}.} \item{qmethod}{A character string specifying how to deal with embedded double quote characters when quoting strings. Must be one of "double" (default in \code{writeDatasets}) or "escape".} \item{fileEncoding}{Character string: if non-empty declares the encoding used on a file (not a connection) so the character data can be re-encoded. See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'.} } \description{ Writes a list of datasets to a CSV file. } \details{ The format of the CSV file is optimized for usage of \code{\link{readDatasets}}. } \examples{ \dontrun{ d1 <- getDataset( n1 = c(11, 13, 12, 13), n2 = c(8, 10, 9, 11), events1 = c(10, 10, 12, 12), events2 = c(3, 5, 5, 6) ) d2 <- getDataset( n1 = c(9, 13, 12, 13), n2 = c(6, 10, 9, 11), events1 = c(10, 10, 12, 12), events2 = c(4, 5, 5, 6) ) datasets <- list(d1, d2) writeDatasets(datasets, "datasets_rates.csv") } } \seealso{ \itemize{ \item \code{\link{writeDataset}} for writing a single dataset, \item \code{\link{readDatasets}} for reading multiple datasets, \item \code{\link{readDataset}} for reading a single dataset. } } rpact/man/rawDataTwoArmNormal.Rd0000644000175000017500000000175514156105041016452 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{rawDataTwoArmNormal} \alias{rawDataTwoArmNormal} \title{Raw Dataset Of A Two Arm Continuous Outcome With Covariates} \format{ A \code{\link[base]{data.frame}} object. } \usage{ rawDataTwoArmNormal } \description{ An artificial dataset that was randomly generated with simulated normal data. The data set has six variables: 1. Subject id 2. Stage number 3. Group name 4. An example outcome in that we are interested in 5. The first covariate *gender* 6. The second covariate *covariate* } \details{ See the vignette "Two-arm analysis for continuous data with covariates from raw data" to learn how to * import raw data from a csv file, * calculate estimated adjusted (marginal) means (EMMs, least-squares means) for a linear model, and * perform two-arm interim analyses with these data. You can use \code{rawDataTwoArmNormal} to reproduce the examples in the vignette. } \keyword{datasets} rpact/man/SimulationResults_names.Rd0000644000175000017500000000136514102177375017464 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R \name{SimulationResults_names} \alias{SimulationResults_names} \alias{names.SimulationResults} \title{Names of a Simulation Results Object} \usage{ \method{names}{SimulationResults}(x) } \arguments{ \item{x}{A \code{\link{SimulationResults}} object created by \code{getSimulationResults[MultiArm/Enrichment][Means/Rates/Survival]}.} } \value{ Returns a \code{\link[base]{character}} vector containing the names of the \code{\link{AnalysisResults}} object. } \description{ Function to get the names of a \code{\link{SimulationResults}} object. } \details{ Returns the names of a simulation results that can be accessed by the user. } \keyword{internal} rpact/man/plot.TrialDesign.Rd0000644000175000017500000001214214051425052015737 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R \name{plot.TrialDesign} \alias{plot.TrialDesign} \title{Trial Design Plotting} \usage{ \method{plot}{TrialDesign}( x, y, ..., main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", theta = seq(-1, 1, 0.01), nMax = NA_integer_, plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, grid = 1, plotSettings = NULL ) } \arguments{ \item{x}{The trial design, obtained from \cr \code{\link{getDesignGroupSequential}}, \cr \code{\link{getDesignInverseNormal}} or \cr \code{\link{getDesignFisher}}.} \item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} \item{...}{Optional plot arguments. At the moment \code{xlim} and \code{ylim} are implemented for changing x or y axis limits without dropping data observations.} \item{main}{The main title.} \item{xlab}{The x-axis label.} \item{ylab}{The y-axis label.} \item{type}{The plot type (default = \code{1}). The following plot types are available: \itemize{ \item \code{1}: creates a 'Boundaries' plot \item \code{3}: creates a 'Stage Levels' plot \item \code{4}: creates a 'Error Spending' plot \item \code{5}: creates a 'Power and Early Stopping' plot \item \code{6}: creates an 'Average Sample Size and Power / Early Stop' plot \item \code{7}: creates an 'Power' plot \item \code{8}: creates an 'Early Stopping' plot \item \code{9}: creates an 'Average Sample Size' plot \item \code{"all"}: creates all available plots and returns it as a grid plot or list }} \item{palette}{The palette, default is \code{"Set1"}.} \item{theta}{A vector of standardized effect sizes (theta values), default is a sequence from -1 to 1.} \item{nMax}{The maximum sample size.} \item{plotPointsEnabled}{If \code{TRUE}, additional points will be plotted.} \item{legendPosition}{The position of the legend. By default (\code{NA_integer_}) the algorithm tries to find a suitable position. Choose one of the following values to specify the position manually: \itemize{ \item \code{-1}: no legend will be shown \item \code{NA}: the algorithm tries to find a suitable position \item \code{0}: legend position outside plot \item \code{1}: legend position left top \item \code{2}: legend position left center \item \code{3}: legend position left bottom \item \code{4}: legend position right top \item \code{5}: legend position right center \item \code{6}: legend position right bottom }} \item{showSource}{If \code{TRUE}, the parameter names of the object will be printed which were used to create the plot; that may be, e.g., useful to check the values or to create own plots with the base R \code{plot} function. Alternatively \code{showSource} can be defined as one of the following character values: \itemize{ \item \code{"commands"}: returns a character vector with plot commands \item \code{"axes"}: returns a list with the axes definitions \item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function does not stop if an error occurs) \item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function stops if an error occurs) } Note: no plot object will be returned if \code{showSource} is a character.} \item{grid}{An integer value specifying the output of multiple plots. By default (\code{1}) a list of \code{ggplot} objects will be returned. If a \code{grid} value > 1 was specified, a grid plot will be returned if the number of plots is <= specified \code{grid} value; a list of \code{ggplot} objects will be returned otherwise. If \code{grid = 0} is specified, all plots will be created using \code{\link[base]{print}} command and a list of \code{ggplot} objects will be returned invisible. Note that one of the following packages must be installed to create a grid plot: 'ggpubr', 'gridExtra', or 'cowplot'.} \item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link{getPlotSettings}}.} } \value{ Returns a \code{ggplot2} object. } \description{ Plots a trial design. } \details{ Generic function to plot a trial design. Generic function to plot a trial design. Note that \code{\link[=param_nMax]{nMax}} is not an argument that it passed to \code{ggplot2}. Rather, the underlying calculations (e.g. power for different theta's or average sample size) are based on calls to function \code{\link{getPowerAndAverageSampleNumber}} which has argument \code{\link[=param_nMax]{nMax}}. I.e., \code{\link[=param_nMax]{nMax}} is not an argument to ggplot2 but to \code{\link{getPowerAndAverageSampleNumber}} which is called prior to plotting. } \examples{ \donttest{ design <- getDesignInverseNormal(kMax = 3, alpha = 0.025, typeOfDesign = "asKD", gammaA = 2, informationRates = c(0.2, 0.7, 1), typeBetaSpending = "bsOF") if (require(ggplot2)) { plot(design) # default: type = 1 } } } \seealso{ \code{\link{plot.TrialDesignSet}} to compare different designs or design parameters visual. } rpact/man/param_palette.Rd0000644000175000017500000000050014020357215015367 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_palette} \alias{param_palette} \title{Parameter Description: Palette} \arguments{ \item{palette}{The palette, default is \code{"Set1"}.} } \description{ Parameter Description: Palette } \keyword{internal} rpact/man/param_stage.Rd0000644000175000017500000000055014020357215015041 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_stage} \alias{param_stage} \title{Parameter Description: Stage} \arguments{ \item{stage}{The stage number (optional). Default: total number of existing stages in the data input.} } \description{ Parameter Description: Stage } \keyword{internal} rpact/man/param_adaptations.Rd0000644000175000017500000000067214020357215016252 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_adaptations} \alias{param_adaptations} \title{Parameter Description: Adaptations} \arguments{ \item{adaptations}{A vector of length \code{kMax - 1} indicating whether or not an adaptation takes place at interim k, default is \code{rep(TRUE, kMax - 1)}.} } \description{ Parameter Description: Adaptations } \keyword{internal} rpact/man/param_maxNumberOfSubjectsPerStage.Rd0000644000175000017500000000151314060361011021310 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_maxNumberOfSubjectsPerStage} \alias{param_maxNumberOfSubjectsPerStage} \title{Parameter Description: Maximum Number Of Subjects Per Stage} \arguments{ \item{maxNumberOfSubjectsPerStage}{When performing a data driven sample size recalculation, the vector \code{maxNumberOfSubjectsPerStage} with length kMax determines the maximum number of subjects per stage (i.e., not cumulated), the first element is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms. For multi-arm designs \code{maxNumberOfSubjectsPerStage} refers to the maximum number of subjects per selected active arm.} } \description{ Parameter Description: Maximum Number Of Subjects Per Stage } \keyword{internal} rpact/man/plot.NumberOfSubjects.Rd0000644000175000017500000000635314046535122016765 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_event_probabilities.R \name{plot.NumberOfSubjects} \alias{plot.NumberOfSubjects} \title{Number Of Subjects Plotting} \usage{ \method{plot}{NumberOfSubjects}( x, y, ..., allocationRatioPlanned = NA_real_, main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, legendTitle = NA_character_, palette = "Set1", plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, plotSettings = NULL ) } \arguments{ \item{x}{The object that inherits from \code{\link{NumberOfSubjects}}.} \item{y}{An optional object that inherits from \code{\link{EventProbabilities}}.} \item{...}{Optional plot arguments. At the moment \code{xlim} and \code{ylim} are implemented for changing x or y axis limits without dropping data observations.} \item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups design, default is \code{1}. Will be ignored if \code{y} is undefined.} \item{main}{The main title.} \item{xlab}{The x-axis label.} \item{ylab}{The y-axis label.} \item{type}{The plot type (default = 1). Note that at the moment only one type is available.} \item{legendTitle}{The legend title, default is \code{""}.} \item{palette}{The palette, default is \code{"Set1"}.} \item{plotPointsEnabled}{If \code{TRUE}, additional points will be plotted.} \item{legendPosition}{The position of the legend. By default (\code{NA_integer_}) the algorithm tries to find a suitable position. Choose one of the following values to specify the position manually: \itemize{ \item \code{-1}: no legend will be shown \item \code{NA}: the algorithm tries to find a suitable position \item \code{0}: legend position outside plot \item \code{1}: legend position left top \item \code{2}: legend position left center \item \code{3}: legend position left bottom \item \code{4}: legend position right top \item \code{5}: legend position right center \item \code{6}: legend position right bottom }} \item{showSource}{If \code{TRUE}, the parameter names of the object will be printed which were used to create the plot; that may be, e.g., useful to check the values or to create own plots with the base R \code{plot} function. Alternatively \code{showSource} can be defined as one of the following character values: \itemize{ \item \code{"commands"}: returns a character vector with plot commands \item \code{"axes"}: returns a list with the axes definitions \item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function does not stop if an error occurs) \item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and returned as character vector (function stops if an error occurs) } Note: no plot object will be returned if \code{showSource} is a character.} \item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link{getPlotSettings}}.} } \value{ Returns a \code{ggplot2} object. } \description{ Plots an object that inherits from class \code{\link{NumberOfSubjects}}. } \details{ Generic function to plot an "number of subjects" object. Generic function to plot a parameter set. } rpact/man/param_informationRates.Rd0000644000175000017500000000065314020357215017266 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_informationRates} \alias{param_informationRates} \title{Parameter Description: Information Rates} \arguments{ \item{informationRates}{The information rates (that must be fixed prior to the trial), default is \code{(1:kMax) / kMax}.} } \description{ Parameter Description: Information Rates } \keyword{internal} rpact/man/param_pi1_survival.Rd0000644000175000017500000000103714020357215016363 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_pi1_survival} \alias{param_pi1_survival} \title{Parameter Description: Pi (1) for Survival Data} \arguments{ \item{pi1}{A numeric value or vector that represents the assumed event rate in the treatment group, default is \code{seq(0.2, 0.5, 0.1)} (power calculations and simulations) or \code{seq(0.4, 0.6, 0.1)} (sample size calculations).} } \description{ Parameter Description: Pi (1) for Survival Data } \keyword{internal} rpact/man/AccrualTime.Rd0000644000175000017500000000055714020357214014755 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_time.R \docType{class} \name{AccrualTime} \alias{AccrualTime} \title{Accrual Time} \description{ Class for the definition of accrual time and accrual intensity. } \details{ \code{AccrualTime} is a class for the definition of accrual time and accrual intensity. } \keyword{internal} rpact/man/param_tolerance.Rd0000644000175000017500000000052514020357215015714 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_tolerance} \alias{param_tolerance} \title{Parameter Description: Tolerance} \arguments{ \item{tolerance}{The numerical tolerance, default is \code{1e-06}.} } \description{ Parameter Description: Tolerance } \keyword{internal} rpact/man/getRepeatedConfidenceIntervals.Rd0000644000175000017500000001115014153377720020665 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_analysis_base.R \name{getRepeatedConfidenceIntervals} \alias{getRepeatedConfidenceIntervals} \title{Get Repeated Confidence Intervals} \usage{ getRepeatedConfidenceIntervals( design, dataInput, ..., directionUpper = TRUE, tolerance = 1e-06, stage = NA_integer_ ) } \arguments{ \item{design}{The trial design.} \item{dataInput}{The summary data used for calculating the test results. This is either an element of \code{DatasetMeans}, of \code{DatasetRates}, or of \code{DatasetSurvival} and should be created with the function \code{getDataset}. For more information see \code{\link{getDataset}}.} \item{...}{Further arguments to be passed to methods (cf. separate functions in "See Also" below), e.g., \describe{ \item{\code{normalApproximation}}{The type of computation of the p-values. Default is \code{FALSE} for testing means (i.e., the t test is used) and \code{TRUE} for testing rates and the hazard ratio. For testing rates, if \code{normalApproximation = FALSE} is specified, the binomial test (one sample) or the exact test of Fisher (two samples) is used for calculating the p-values. In the survival setting, \code{normalApproximation = FALSE} has no effect.} \item{\code{equalVariances}}{The type of t test. For testing means in two treatment groups, either the t test assuming that the variances are equal or the t test without assuming this, i.e., the test of Welch-Satterthwaite is calculated, default is \code{TRUE}.} \item{\code{intersectionTest}}{Defines the multiple test for the intersection hypotheses in the closed system of hypotheses when testing multiple hypotheses. Five options are available in multi-arm designs: \code{"Dunnett"}, \code{"Bonferroni"}, \code{"Simes"}, \code{"Sidak"}, and \code{"Hierarchical"}, default is \code{"Dunnett"}. Four options are available in population enrichment designs: \code{"SpiessensDebois"} (one subset only), \code{"Bonferroni"}, \code{"Simes"}, and \code{"Sidak"}, default is \code{"Simes"}.} \item{\code{varianceOption}}{Defines the way to calculate the variance in multiple treatment arms (> 2) or population enrichment designs for testing means. For multiple arms, three options are available: \code{"overallPooled"}, \code{"pairwisePooled"}, and \code{"notPooled"}, default is \code{"overallPooled"}. For enrichment designs, the options are: \code{"pooled"}, \code{"pooledFromFull"} (one subset only), and \code{"notPooled"}, default is \code{"pooled"}.} \item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. For testing means and rates, also a non-stratified analysis based on overall data can be performed. For survival data, only a stratified analysis is possible (see Brannath et al., 2009), default is \code{TRUE}.} }} \item{directionUpper}{Specifies the direction of the alternative, only applicable for one-sided testing; default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values.} \item{tolerance}{The numerical tolerance, default is \code{1e-06}.} \item{stage}{The stage number (optional). Default: total number of existing stages in the data input.} } \value{ Returns a \code{\link[base]{matrix}} with \code{2} rows and \code{kMax} columns containing the lower RCI limits in the first row and the upper RCI limits in the second row, where each column represents a stage. } \description{ Calculates and returns the lower and upper limit of the repeated confidence intervals of the trial. } \details{ The repeated confidence interval at a given stage of the trial contains the parameter values that are not rejected using the specified sequential design. It can be calculated at each stage of the trial and can thus be used as a monitoring tool. The repeated confidence intervals are provided up to the specified stage. } \examples{ \donttest{ design <- getDesignInverseNormal(kMax = 2) data <- getDataset( n = c( 20, 30), means = c( 50, 51), stDevs = c(130, 140) ) getRepeatedConfidenceIntervals(design, dataInput = data) } } \seealso{ Other analysis functions: \code{\link{getAnalysisResults}()}, \code{\link{getClosedCombinationTestResults}()}, \code{\link{getClosedConditionalDunnettTestResults}()}, \code{\link{getConditionalPower}()}, \code{\link{getConditionalRejectionProbabilities}()}, \code{\link{getFinalConfidenceInterval}()}, \code{\link{getFinalPValue}()}, \code{\link{getRepeatedPValues}()}, \code{\link{getStageResults}()}, \code{\link{getTestActions}()} } \concept{analysis functions} rpact/man/rpact.Rd0000644000175000017500000000474414153377720013712 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pkgname.R \docType{package} \name{rpact} \alias{rpact} \alias{rpact-package} \title{rpact - Confirmatory Adaptive Clinical Trial Design and Analysis} \description{ rpact (R Package for Adaptive Clinical Trials) is a comprehensive package that enables the design and analysis of confirmatory adaptive group sequential designs. Particularly, the methods described in the recent monograph by Wassmer and Brannath (published by Springer, 2016) are implemented. It also comprises advanced methods for sample size calculations for fixed sample size designs incl., e.g., sample size calculation for survival trials with piecewise exponentially distributed survival times and staggered patients entry. } \details{ rpact includes the classical group sequential designs (incl. user spending function approaches) where the sample sizes per stage (or the time points of interim analysis) cannot be changed in a data-driven way. Confirmatory adaptive designs explicitly allow for this under control of the Type I error rate. They are either based on the combination testing or the conditional rejection probability (CRP) principle. Both are available, for the former the inverse normal combination test and Fisher's combination test can be used. Specific techniques of the adaptive methodology are also available, e.g., overall confidence intervals, overall p-values, and conditional and predictive power assessments. Simulations can be performed to assess the design characteristics of a (user-defined) sample size recalculation strategy. Designs are available for trials with continuous, binary, and survival endpoint. For more information please visit \href{https://www.rpact.org}{www.rpact.org}. If you are interested in professional services round about the package or need a comprehensive validation documentation to fulfill regulatory requirements please visit \href{https://www.rpact.com}{www.rpact.com}. rpact is developed by \itemize{ \item Gernot Wassmer (\email{gernot.wassmer@rpact.com}) and \item Friedrich Pahlke (\email{friedrich.pahlke@rpact.com}). } } \references{ Wassmer, G., Brannath, W. (2016) Group Sequential and Confirmatory Adaptive Designs in Clinical Trials (Springer Series in Pharmaceutical Statistics; \doi{10.1007/978-3-319-32562-0}) } \seealso{ Useful links: \itemize{ \item \url{https://www.rpact.org} \item Report bugs at \url{https://www.rpact.com/bugreport} } } \author{ Gernot Wassmer, Friedrich Pahlke } rpact/man/AnalysisResults_summary.Rd0000644000175000017500000000557014020357214017506 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R \name{AnalysisResults_summary} \alias{AnalysisResults_summary} \alias{summary.AnalysisResults} \title{Analysis Results Summary} \usage{ \method{summary}{AnalysisResults}(object, ..., type = 1, digits = NA_integer_) } \arguments{ \item{object}{An \code{\link{AnalysisResults}} object.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} \item{digits}{Defines how many digits are to be used for numeric values.} } \value{ Returns a \code{\link{SummaryFactory}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object } } \description{ Displays a summary of \code{\link{AnalysisResults}} object. } \details{ Summarizes the parameters and results of an analysis results object. } \section{Summary options}{ The following options can be set globally: \enumerate{ \item \code{rpact.summary.output.size}: one of \code{c("small", "medium", "large")}; defines how many details will be included into the summary; default is \code{"large"}, i.e., all available details are displayed. \item \code{rpact.summary.justify}: one of \code{c("right", "left", "centre")}; shall the values be right-justified (the default), left-justified or centered. \item \code{rpact.summary.width}: defines the maximum number of characters to be used per line (default is \code{83}). \item \code{rpact.summary.intervalFormat}: defines how intervals will be displayed in the summary, default is \code{"[\%s; \%s]"}. \item \code{rpact.summary.digits}: defines how many digits are to be used for numeric values (default is \code{3}). \item \code{rpact.summary.digits.probs}: defines how many digits are to be used for numeric values (default is one more than value of \code{rpact.summary.digits}, i.e., \code{4}). \item \code{rpact.summary.trim.zeroes}: if \code{TRUE} (default) zeroes will always displayed as "0", e.g. "0.000" will become "0". } Example: \code{options("rpact.summary.intervalFormat" = "\%s - \%s")} } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \keyword{internal} rpact/man/SimulationResultsEnrichmentMeans.Rd0000644000175000017500000000067514117626572021311 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R \docType{class} \name{SimulationResultsEnrichmentMeans} \alias{SimulationResultsEnrichmentMeans} \title{Class for Simulation Results Enrichment Means} \description{ A class for simulation results means in enrichment designs. } \details{ Use \code{\link{getSimulationEnrichmentMeans}} to create an object of this type. } \keyword{internal} rpact/man/param_calcEventsFunction.Rd0000644000175000017500000000120114020357215017525 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_calcEventsFunction} \alias{param_calcEventsFunction} \title{Parameter Description: Calculate Events Function} \arguments{ \item{calcEventsFunction}{Optionally, a function can be entered that defines the way of performing the sample size recalculation. By default, sample size recalculation is performed with conditional power with specified \code{minNumberOfEventsPerStage} and \code{maxNumberOfEventsPerStage} (see details and examples).} } \description{ Parameter Description: Calculate Events Function } \keyword{internal} rpact/man/param_eventTime.Rd0000644000175000017500000000057014020357215015700 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parameter_descriptions.R \name{param_eventTime} \alias{param_eventTime} \title{Parameter Description: Event Time} \arguments{ \item{eventTime}{The assumed time under which the event rates are calculated, default is \code{12}.} } \description{ Parameter Description: Event Time } \keyword{internal} rpact/man/getPowerAndAverageSampleNumber.Rd0000644000175000017500000000544214153377720020622 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/f_design_group_sequential.R \name{getPowerAndAverageSampleNumber} \alias{getPowerAndAverageSampleNumber} \title{Get Power And Average Sample Number} \usage{ getPowerAndAverageSampleNumber(design, theta = seq(-1, 1, 0.02), nMax = 100) } \arguments{ \item{design}{The trial design.} \item{theta}{A vector of standardized effect sizes (theta values), default is a sequence from -1 to 1.} \item{nMax}{The maximum sample size.} } \value{ Returns a \code{\link{PowerAndAverageSampleNumberResult}} object. The following generics (R generic functions) are available for this result object: \itemize{ \item \code{\link[=names.FieldSet]{names}} to obtain the field names, \item \code{\link[=print.FieldSet]{print}} to print the object, \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, \item \code{\link[=plot.ParameterSet]{plot}} to plot the object, \item \code{\link[=as.data.frame.PowerAndAverageSampleNumberResult]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. } } \description{ Returns the power and average sample number of the specified design. } \details{ This function returns the power and average sample number (ASN) of the specified design for the prototype case which is testing H0: mu = mu0 in a one-sample design. \code{theta} represents the standardized effect \code{(mu - mu0) / sigma} and power and ASN is calculated for maximum sample size \code{nMax}. For other designs than the one-sample test of a mean the standardized effect needs to be adjusted accordingly. } \section{How to get help for generic functions}{ Click on the link of a generic in the list above to go directly to the help documentation of the \code{rpact} specific implementation of the generic. Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and to identify the object specific name of it, e.g., use \code{methods("plot")} to get all the methods for the \code{plot} generic. There you can find, e.g., \code{plot.AnalysisResults} and obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. } \examples{ # Calculate power, stopping probabilities, and expected sample # size for the default design with specified theta and nMax getPowerAndAverageSampleNumber( getDesignGroupSequential(), theta = seq(-1, 1, 0.5), nMax = 100) } \seealso{ Other design functions: \code{\link{getDesignCharacteristics}()}, \code{\link{getDesignConditionalDunnett}()}, \code{\link{getDesignFisher}()}, \code{\link{getDesignGroupSequential}()}, \code{\link{getDesignInverseNormal}()} } \concept{design functions} rpact/src/0000755000175000017500000000000014165536077012322 5ustar nileshnileshrpact/src/f_simulation_base_survival.cpp0000644000175000017500000007515514153433457020454 0ustar nileshnilesh/** * * -- Simulation of survival data with group sequential and combination test -- * * This file is part of the R package rpact: * Confirmatory Adaptive Clinical Trial Design and Analysis * * Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD * Licensed under "GNU Lesser General Public License" version 3 * License text can be found here: https://www.r-project.org/Licenses/LGPL-3 * * RPACT company website: https://www.rpact.com * rpact package website: https://www.rpact.org * * Contact us for information about our services: info@rpact.com * * File version: $Revision: 5620 $ * Last changed: $Date: 2021-12-06 17:15:42 +0100 (Mo, 06 Dez 2021) $ * Last changed by: $Author: pahlke $ * */ #include #include "f_utilities.h" #include "f_simulation_survival_utilities.h" using namespace Rcpp; // Log Rank Test // // This function calculates the logrank test statistic for the survival data set at given time, // i.e., it determines whether an event or a dropout // was observed, calculates the time under risk, and the logrank statistic. // // @param accrualTime An double vector // List logRankTest(NumericVector accrualTime, NumericVector survivalTime, NumericVector dropoutTime, IntegerVector treatmentGroup, double time, bool directionUpper, double thetaH0, bool returnRawData) { int numberOfSubjects = accrualTime.size(); int subjectsT1 = 0; int subjectsT2 = 0; NumericVector timeUnderObservation = NumericVector(numberOfSubjects, 0.0); LogicalVector event = LogicalVector(numberOfSubjects, NA_LOGICAL); LogicalVector dropoutEvent = LogicalVector(numberOfSubjects, NA_LOGICAL); for (int i = 0; i < numberOfSubjects; i++) { if (accrualTime[i] > time) { treatmentGroup[i] = -treatmentGroup[i]; event[i] = false; dropoutEvent[i] = false; } else { if (treatmentGroup[i] == 1) { subjectsT1++; } else if (treatmentGroup[i] == 2) { subjectsT2++; } if (treatmentGroup[i] > 0 && accrualTime[i] + survivalTime[i] < time && (R_IsNA((double) dropoutTime[i]) || dropoutTime[i] > survivalTime[i])) { event[i] = true; } else { event[i] = false; } if (treatmentGroup[i] > 0 && accrualTime[i] + dropoutTime[i] < time && !R_IsNA((double) dropoutTime[i]) && dropoutTime[i] < survivalTime[i]) { dropoutEvent[i] = true; } else { dropoutEvent[i] = false; } } if (event[i]) { timeUnderObservation[i] = survivalTime[i]; } else if (dropoutEvent[i]) { timeUnderObservation[i] = dropoutTime[i]; } else { timeUnderObservation[i] = time - accrualTime[i]; } } int numberOfSubjets = subjectsT1 + subjectsT2; NumericVector timeUnderObservationSorted = clone(timeUnderObservation).sort(); IntegerVector sortedIndex = match(timeUnderObservationSorted, timeUnderObservation); sortedIndex = sortedIndex - 1; LogicalVector eventSorted = event[sortedIndex]; IntegerVector treatmentGroupSorted = treatmentGroup[sortedIndex]; eventSorted = eventSorted[treatmentGroupSorted > 0]; treatmentGroupSorted = treatmentGroupSorted[treatmentGroupSorted > 0]; treatmentGroup = abs(treatmentGroup); double numerator = 0; double denominator = 0; int events1 = 0; int events2 = 0; for (int i = 0; i < eventSorted.size(); i++) { if (eventSorted[i]) { if (treatmentGroupSorted[i] == 1) { if (subjectsT1 + subjectsT2 > 0) { numerator -= subjectsT2 / (thetaH0 * subjectsT1 + subjectsT2); } events1++; } else if (treatmentGroupSorted[i] == 2) { if (subjectsT1 + subjectsT2 > 0) { numerator += 1 - subjectsT2 / (thetaH0 * subjectsT1 + subjectsT2); } events2++; } if (subjectsT1 + subjectsT2 > 0) { denominator += thetaH0 * subjectsT1 * subjectsT2 / pow(thetaH0 * subjectsT1 + subjectsT2, 2); } } if (treatmentGroupSorted[i] == 1) { subjectsT1--; } else if (treatmentGroupSorted[i] == 2) { subjectsT2--; } } double logRank; if (denominator > 0) { logRank = -numerator / sqrt(denominator); } else { logRank = R_NegInf; } if (!directionUpper) { logRank = -logRank; } NumericVector out(4); out[0] = logRank; out[1] = numberOfSubjets; out[2] = events1; out[3] = events2; if (returnRawData) { return List::create( _["result"] = out, _["timeUnderObservation"] = timeUnderObservation, _["event"] = event, _["dropoutEvent"] = dropoutEvent ); } return List::create( _["result"] = out ); } NumericVector getIndependentIncrements(int stage, NumericVector eventsPerStage, NumericVector logRankOverStages) { NumericVector independentIncrements = NumericVector(stage, NA_REAL); independentIncrements[0] = logRankOverStages[0]; const IntegerVector indices1 = seq(0, stage - 2); const IntegerVector indices2 = seq(1, stage - 1); independentIncrements[indices2] = vectorDivide( vectorMultiply(vectorSqrt(eventsPerStage[indices2]), logRankOverStages[indices2]) - vectorMultiply(vectorSqrt(eventsPerStage[indices1]), logRankOverStages[indices1]), vectorSqrt(eventsPerStage[indices2] - eventsPerStage[indices1])); return independentIncrements; } // Get Test Statistics // @param designNumber The design number: // 1: Group sequential design // 2: Inverse normal design // 3: Fisher design // NumericVector getTestStatistics(int stage, int designNumber, NumericVector informationRates, NumericVector eventsPerStage, NumericVector logRankOverStages) { // Group sequential design if (designNumber == 1) { return NumericVector::create(logRankOverStages[stage - 1], NA_REAL); } // Inverse normal design if (designNumber == 2) { if (stage == 1) { return NumericVector::create(logRankOverStages[0], NA_REAL); } NumericVector independentIncrements = getIndependentIncrements(stage, eventsPerStage, logRankOverStages); const IntegerVector indices1 = seq(0, stage - 2); const IntegerVector indices2 = seq(1, stage - 1); double value = (sqrt((double) informationRates[0]) * independentIncrements[0] + vectorProduct(vectorSqrt(informationRates[indices2] - informationRates[indices1]), independentIncrements[indices2])) / sqrt((double) informationRates[stage - 1]); return NumericVector::create(value, NA_REAL); } // Fisher design NumericVector independentIncrements = NumericVector(stage, NA_REAL); independentIncrements[0] = logRankOverStages[0]; NumericVector weightFisher = NumericVector(stage, NA_REAL); weightFisher[0] = 1; if (stage > 1) { independentIncrements = getIndependentIncrements(stage, eventsPerStage, logRankOverStages); const IntegerVector indices1 = seq(0, stage - 2); const IntegerVector indices2 = seq(1, stage - 1); weightFisher[indices2] = vectorDivide( vectorSqrt(informationRates[indices2] - informationRates[indices1]), sqrt((double) informationRates[0])); } const IntegerVector indices0 = seq(0, stage - 1); double value = vectorProduct(vectorPow(1 - pnorm(as(independentIncrements[indices0])), as(weightFisher[indices0]))); double pValueSeparate = 1 - getNormalDistribution((double) independentIncrements[stage - 1]); return NumericVector::create(value, pValueSeparate); } // Get Recalculated Event Sizes // @param designNumber The design number: // 1: Group sequential design // 2: Inverse normal design // 3: Fisher design // NumericVector getRecalculatedEventSizes(int designNumber, int stage, int kMax, NumericVector criticalValues, NumericVector informationRates, double conditionalPower, NumericVector plannedEvents, double thetaH1, NumericVector eventsPerStage, NumericVector logRankOverStages, NumericVector testStatisticOverStages, NumericVector minNumberOfEventsPerStage, NumericVector maxNumberOfEventsPerStage, bool directionUpper, double allocation1, double allocation2) { double requiredStageEvents = plannedEvents[stage - 1]; if (stage == 1) { NumericVector result = NumericVector(3, NA_REAL); result[0] = requiredStageEvents; return result; } // Used effect size is either estimated from test statistic of pre-fixed double estimatedTheta; if (R_IsNA(thetaH1)) { estimatedTheta = exp((double) logRankOverStages[stage - 2] * (1 + allocation1 / allocation2) / sqrt(allocation1 / allocation2 * eventsPerStage[stage - 2])); } else { estimatedTheta = thetaH1; if (!directionUpper) { estimatedTheta = 1 / estimatedTheta; } } // Conditional critical value to reject the null hypotheses at the last stage of the trial double conditionalCriticalValue; if (designNumber == 3) { // Fisher design conditionalCriticalValue = getNormalQuantile( 1 - pow((double) criticalValues[stage - 1] / testStatisticOverStages[stage - 2], 1 / sqrt((double) (informationRates[stage - 1] - informationRates[stage - 2]) / informationRates[0] ) )); } else { conditionalCriticalValue = (sqrt((double) informationRates[stage - 1]) * criticalValues[stage - 1] - testStatisticOverStages[stage - 2] * sqrt((double) informationRates[stage - 2])) / sqrt((double) informationRates[stage - 1] - informationRates[stage - 2]); } if (!R_IsNA(conditionalPower)) { double theta; theta = max(NumericVector::create(1 + 1E-12, estimatedTheta)); requiredStageEvents = pow(max(NumericVector::create(0, conditionalCriticalValue + getNormalQuantile(conditionalPower))), 2) * pow(1 + allocation1 / allocation2, 2) * allocation2 / allocation1 / pow(log(theta), 2); requiredStageEvents = min(NumericVector::create( max(NumericVector::create(minNumberOfEventsPerStage[stage - 1], requiredStageEvents)), maxNumberOfEventsPerStage[stage - 1])) + eventsPerStage[stage - 2]; } NumericVector result = NumericVector(3, NA_REAL); result[0] = requiredStageEvents; result[1] = conditionalCriticalValue; result[2] = estimatedTheta; return result; } NumericMatrix getSimulationStepResultsSurvival( int designNumber, int kMax, int sided, NumericVector criticalValues, NumericVector informationRates, double conditionalPower, NumericVector plannedEvents, double thetaH1, NumericVector minNumberOfEventsPerStage, NumericVector maxNumberOfEventsPerStage, bool directionUpper, double allocation1, double allocation2, NumericVector accrualTime, NumericVector survivalTime, NumericVector dropoutTime, IntegerVector treatmentGroup, double thetaH0, NumericVector futilityBounds, NumericVector alpha0Vec) { NumericVector eventsPerStage = NumericVector(kMax, 0.0); NumericVector logRankOverStages = NumericVector(kMax, 0.0); NumericVector testStatisticOverStages = NumericVector(kMax, 0.0); NumericVector analysisTime = NumericVector(kMax, 0.0); NumericVector subjects = NumericVector(kMax, 0.0); NumericVector expectedNumberOfEvents1 = NumericVector(kMax, 0.0); NumericVector expectedNumberOfEvents2 = NumericVector(kMax, 0.0); NumericVector expectedNumberOfEvents = NumericVector(kMax, 0.0); NumericVector rejections = NumericVector(kMax, 0.0); NumericVector eventsNotAchieved = NumericVector(kMax, 0.0); NumericVector futilityStops = NumericVector(kMax, 0.0); NumericVector pValuesSeparate = NumericVector(kMax, NA_REAL); NumericVector duration = NumericVector(kMax, 0.0); NumericVector iterations = NumericVector(kMax, 0.0); NumericVector hazardRates1 = NumericVector(kMax, 0.0); NumericVector hazardRates2 = NumericVector(kMax, 0.0); NumericVector hazardRatiosEstimate = NumericVector(kMax, 0.0); NumericVector observationTimePerStage = NumericVector(kMax, NA_REAL); NumericVector conditionalPowerAchieved = NumericVector(kMax, 0.0); for (int k = 1; k <= kMax; k++) { NumericVector recalculatedEventSizes = getRecalculatedEventSizes( designNumber, k, kMax, criticalValues, informationRates, conditionalPower, plannedEvents, thetaH1, eventsPerStage, logRankOverStages, testStatisticOverStages, minNumberOfEventsPerStage, maxNumberOfEventsPerStage, directionUpper, allocation1, allocation2); double requiredStageEvents = recalculatedEventSizes[0]; double observationTime = findObservationTime(accrualTime, survivalTime, dropoutTime, requiredStageEvents); if (R_IsNA(observationTime)) { eventsNotAchieved[k - 1]++; break; } if (k > 1) { double conditionalCriticalValue = recalculatedEventSizes[1]; double theta = recalculatedEventSizes[2]; conditionalPowerAchieved[k - 1] = 1 - getNormalDistribution(conditionalCriticalValue - log(theta) * sqrt(requiredStageEvents - eventsPerStage[k - 2]) * sqrt(allocation1 / allocation2) / (1 + allocation1 / allocation2)); } else { conditionalPowerAchieved[k - 1] = NA_REAL; } observationTimePerStage[k - 1] = observationTime; List result = logRankTest( accrualTime, survivalTime, dropoutTime, treatmentGroup, observationTime, directionUpper, thetaH0, false); NumericVector survivalResult = result["result"]; double logRank = survivalResult[0]; double numberOfSubjects = survivalResult[1]; double events1 = survivalResult[2]; double events2 = survivalResult[3]; hazardRates1[k - 1] = NA_REAL; hazardRates2[k - 1] = NA_REAL; hazardRatiosEstimate[k - 1] = NA_REAL; eventsPerStage[k - 1] = events1 + events2; logRankOverStages[k - 1] = logRank; NumericVector testStatistic = getTestStatistics(k, designNumber, informationRates, eventsPerStage, logRankOverStages); testStatisticOverStages[k - 1] = testStatistic[0]; int trialStopEventCounter = 0; if (designNumber == 3) { // Fisher design pValuesSeparate[k - 1] = testStatistic[1]; if (testStatistic[0] <= criticalValues[k - 1]) { rejections[k - 1]++; trialStopEventCounter++; } if (k < kMax && (testStatistic[1] >= alpha0Vec[k - 1])) { futilityStops[k - 1]++; trialStopEventCounter++; } } else { // all other designs if ((sided == 1 && testStatistic[0] >= criticalValues[k - 1]) || (sided == 2 && std::abs((double) testStatistic[0]) >= criticalValues[k - 1])) { rejections[k - 1]++; trialStopEventCounter++; } if (sided == 1 && k < kMax && testStatistic[0] <= futilityBounds[k - 1]) { futilityStops[k - 1]++; trialStopEventCounter++; } } if (trialStopEventCounter > 0) { for (int i = 0; i < trialStopEventCounter; i++) { duration[k - 1] += observationTime; subjects[k - 1] += numberOfSubjects; } } else { subjects[k - 1] += numberOfSubjects; if (k == kMax) { duration[k - 1] += observationTime; } } expectedNumberOfEvents1[k - 1] += events1; expectedNumberOfEvents2[k - 1] += events2; double x = events1 + events2; if (k > 1) { x -= eventsPerStage[k - 2]; } expectedNumberOfEvents[k - 1] += x; analysisTime[k - 1] += observationTime; iterations[k - 1]++; if (trialStopEventCounter > 0) { break; } } NumericMatrix result(kMax, 18); result(_, 0) = analysisTime; result(_, 1) = subjects; result(_, 2) = expectedNumberOfEvents1; result(_, 3) = expectedNumberOfEvents2; result(_, 4) = expectedNumberOfEvents; result(_, 5) = rejections; result(_, 6) = eventsNotAchieved; result(_, 7) = futilityStops; result(_, 8) = duration; result(_, 9) = iterations; result(_, 10) = testStatisticOverStages; result(_, 11) = logRankOverStages; result(_, 12) = hazardRates1; result(_, 13) = hazardRates2; result(_, 14) = hazardRatiosEstimate; result(_, 15) = observationTimePerStage; result(_, 16) = conditionalPowerAchieved; result(_, 17) = pValuesSeparate; return result; } NumericMatrix getExtendedSurvivalDataSet(IntegerVector treatmentGroup, int maxNumberOfSubjects, double lambda1, double lambda2, double phi1, double phi2, double kappa) { NumericVector survivalTime = NumericVector(maxNumberOfSubjects, NA_REAL); NumericVector dropoutTime = NumericVector(maxNumberOfSubjects, NA_REAL); for (int i = 0; i < maxNumberOfSubjects; i++) { if (treatmentGroup[i] == 1) { survivalTime[i] = getRandomSurvivalDistribution(lambda1, kappa); if (phi1 > 0) { dropoutTime[i] = getRandomSurvivalDistribution(phi1, 1); } } else { survivalTime[i] = getRandomSurvivalDistribution(lambda2, kappa); if (phi2 > 0) { dropoutTime[i] = getRandomSurvivalDistribution(phi2, 1); } } } NumericMatrix result(maxNumberOfSubjects, 2); result(_, 0) = survivalTime; result(_, 1) = dropoutTime; return result; } NumericMatrix getExtendedSurvivalDataSet(IntegerVector treatmentGroup, int maxNumberOfSubjects, NumericVector piecewiseSurvivalTime, NumericVector cdfValues1, NumericVector cdfValues2, NumericVector lambdaVec1, NumericVector lambdaVec2, double phi1, double phi2) { NumericVector survivalTime = NumericVector(maxNumberOfSubjects, NA_REAL); NumericVector dropoutTime = NumericVector(maxNumberOfSubjects, NA_REAL); for (int i = 0; i < maxNumberOfSubjects; i++) { if (treatmentGroup[i] == 1) { survivalTime[i] = getRandomPiecewiseExponentialDistribution(cdfValues1, lambdaVec1, piecewiseSurvivalTime); if (phi1 > 0) { dropoutTime[i] = getRandomPiecewiseExponentialDistribution( cdfValues1, rep(phi1, lambdaVec1.size()), piecewiseSurvivalTime); } } else { survivalTime[i] = getRandomPiecewiseExponentialDistribution(cdfValues2, lambdaVec2, piecewiseSurvivalTime); if (phi2 > 0) { dropoutTime[i] = getRandomPiecewiseExponentialDistribution( cdfValues2, rep(phi2, lambdaVec2.size()), piecewiseSurvivalTime); } } } NumericMatrix result(maxNumberOfSubjects, 2); result(_, 0) = survivalTime; result(_, 1) = dropoutTime; return result; } /* Get Simulation Results * * This function calculates the simulation results for survival data. * * @param kappa The kappa value for the Weibull distribution; * if kappa = 1, then the exponential distribution will be used for simulation. */ // [[Rcpp::export]] List getSimulationSurvivalCpp( int designNumber, int kMax, int sided, NumericVector criticalValues, NumericVector informationRates, double conditionalPower, NumericVector plannedEvents, double thetaH1, NumericVector minNumberOfEventsPerStage, NumericVector maxNumberOfEventsPerStage, bool directionUpper, double allocation1, double allocation2, NumericVector accrualTime, IntegerVector treatmentGroup, double thetaH0, NumericVector futilityBounds, NumericVector alpha0Vec, NumericVector pi1Vec, double pi2, double eventTime, NumericVector piecewiseSurvivalTime, NumericVector cdfValues1, NumericVector cdfValues2, NumericVector lambdaVec1, NumericVector lambdaVec2, NumericVector phi, int maxNumberOfSubjects, int maxNumberOfIterations, int maxNumberOfRawDatasetsPerStage, double kappa) { bool pwExpEnabled = isPiecewiseExponentialSurvivalEnabled(lambdaVec2); int n = 1; if (!pwExpEnabled) { n = pi1Vec.size(); } if (n < 1) { throw Rcpp::exception(tfm::format( "'pi1Vec' must have minimum length %s (is %s)", 1, pi1Vec.size()).c_str()); } int sumVectorLength = kMax * n; IntegerVector stages = IntegerVector(sumVectorLength, NA_INTEGER); NumericVector pi1Column = NumericVector(sumVectorLength, 0.0); NumericVector hazardRatioColumn = NumericVector(sumVectorLength, 0.0); NumericVector analysisTimeSum = NumericVector(sumVectorLength, 0.0); NumericVector subjectsSum = NumericVector(sumVectorLength, 0.0); NumericVector eventsSum = NumericVector(sumVectorLength, 0.0); NumericVector rejectionsSum = NumericVector(sumVectorLength, 0.0); NumericVector eventsNotAchievedSum = NumericVector(sumVectorLength, 0.0); NumericVector futilityStopsSum = NumericVector(sumVectorLength, 0.0); NumericVector durationsSum = NumericVector(sumVectorLength, 0.0); NumericVector iterationsSum = NumericVector(sumVectorLength, 0.0); NumericVector conditionalPowerAchievedSum = NumericVector(sumVectorLength, 0.0); int simResultsVectorLength = sumVectorLength * maxNumberOfIterations; IntegerVector iterationNumbers = IntegerVector(simResultsVectorLength, NA_INTEGER); IntegerVector stageNumbers = IntegerVector(simResultsVectorLength, NA_INTEGER); NumericVector pi1Values = NumericVector(simResultsVectorLength, NA_REAL); NumericVector hazardRatios = NumericVector(simResultsVectorLength, NA_REAL); NumericVector analysisTime = NumericVector(simResultsVectorLength, NA_REAL); NumericVector subjects = NumericVector(simResultsVectorLength, NA_REAL); NumericVector events1 = NumericVector(simResultsVectorLength, NA_REAL); NumericVector events2 = NumericVector(simResultsVectorLength, NA_REAL); NumericVector events = NumericVector(simResultsVectorLength, NA_REAL); NumericVector rejections = NumericVector(simResultsVectorLength, NA_REAL); NumericVector eventsNotAchieved = NumericVector(simResultsVectorLength, NA_REAL); NumericVector futilityStops = NumericVector(simResultsVectorLength, NA_REAL); NumericVector pValuesSeparate = NumericVector(simResultsVectorLength, NA_REAL); NumericVector testStatistics = NumericVector(simResultsVectorLength, NA_REAL); NumericVector logRankStatistics = NumericVector(simResultsVectorLength, NA_REAL); NumericVector hazardRates1 = NumericVector(simResultsVectorLength, NA_REAL); NumericVector hazardRates2 = NumericVector(simResultsVectorLength, NA_REAL); NumericVector hazardRatiosEstimate = NumericVector(simResultsVectorLength, NA_REAL); NumericVector conditionalPowerAchieved = NumericVector(simResultsVectorLength, NA_REAL); // raw datasets per stage int rawDataVectorLength = maxNumberOfRawDatasetsPerStage * n * kMax *maxNumberOfSubjects; IntegerVector rawDataPerStage = IntegerVector(kMax, 0); NumericVector rawDataIterationNumbers = NumericVector(rawDataVectorLength, NA_REAL); IntegerVector rawDataStageNumbers = IntegerVector(rawDataVectorLength, NA_INTEGER); NumericVector rawDataPi1Values = NumericVector(rawDataVectorLength, NA_REAL); IntegerVector rawDataSubjectIds = IntegerVector(rawDataVectorLength, NA_INTEGER); NumericVector rawDataAccrualTime = NumericVector(rawDataVectorLength, NA_REAL); IntegerVector rawDataTreatmentGroups = IntegerVector(rawDataVectorLength, NA_INTEGER); NumericVector rawDataSurvivalTime = NumericVector(rawDataVectorLength, NA_REAL); NumericVector rawDataDropoutTime = NumericVector(rawDataVectorLength, NA_REAL); NumericVector rawDataObservationTime = NumericVector(rawDataVectorLength, NA_REAL); NumericVector rawDataTimeUnderObservation = NumericVector(rawDataVectorLength, NA_REAL); LogicalVector rawDataEvent = LogicalVector(rawDataVectorLength, NA_LOGICAL); LogicalVector rawDataDropoutEvent = LogicalVector(rawDataVectorLength, NA_LOGICAL); IntegerVector rawDataCensorIndicator = IntegerVector(rawDataVectorLength, NA_INTEGER); NumericMatrix survivalDataSet; int index = 0; for (int pi1Index = 0; pi1Index < n; pi1Index++) { double pi1 = NA_REAL; double hazardRatio = NA_REAL; double lambda1 = NA_REAL; double lambda2 = NA_REAL; if (!pwExpEnabled) { if (R_IsNA((double) pi1Vec[pi1Index])) { lambda1 = lambdaVec1[pi1Index]; lambda2 = lambdaVec2[0]; } else { pi1 = pi1Vec[pi1Index]; lambda1 = getLambdaByPi(pi1, eventTime, kappa); lambda2 = getLambdaByPi(pi2, eventTime, kappa); } hazardRatio = pow(lambda1 / lambda2, kappa); } for (int k = 0; k < kMax; k++) { stages[pi1Index * kMax + k] = k + 1; } vectorInitC(pi1Index, kMax, REAL(pi1Column), pi1); vectorInitC(pi1Index, kMax, REAL(hazardRatioColumn), hazardRatio); for (int iterationIndex = 0; iterationIndex < maxNumberOfIterations; iterationIndex++) { if (!pwExpEnabled) { survivalDataSet = getExtendedSurvivalDataSet( treatmentGroup, maxNumberOfSubjects, lambda1, lambda2, (double) phi[0], (double) phi[1], kappa); } else { survivalDataSet = getExtendedSurvivalDataSet(treatmentGroup, maxNumberOfSubjects, piecewiseSurvivalTime, cdfValues1, cdfValues2, lambdaVec1, lambdaVec2, (double) phi[0], (double) phi[1]); } NumericVector survivalTime = survivalDataSet(_, 0); NumericVector dropoutTime = survivalDataSet(_, 1); NumericMatrix stepResults = getSimulationStepResultsSurvival( designNumber, kMax, sided, criticalValues, informationRates, conditionalPower, plannedEvents, thetaH1, minNumberOfEventsPerStage, maxNumberOfEventsPerStage, directionUpper, allocation1, allocation2, accrualTime, survivalTime, dropoutTime, treatmentGroup, thetaH0, futilityBounds, alpha0Vec); vectorSumC(pi1Index, 0, kMax, REAL(analysisTimeSum), stepResults); vectorSumC(pi1Index, 1, kMax, REAL(subjectsSum), stepResults); vectorSumC(pi1Index, 4, kMax, REAL(eventsSum), stepResults); vectorSumC(pi1Index, 5, kMax, REAL(rejectionsSum), stepResults); vectorSumC(pi1Index, 6, kMax, REAL(eventsNotAchievedSum), stepResults); vectorSumC(pi1Index, 7, kMax, REAL(futilityStopsSum), stepResults); vectorSumC(pi1Index, 8, kMax, REAL(durationsSum), stepResults); vectorSumC(pi1Index, 9, kMax, REAL(iterationsSum), stepResults); vectorSumC(pi1Index, 16, kMax, REAL(conditionalPowerAchievedSum), stepResults); // conditionalPowerAchieved // pValuesSeparate // get data for (int k = 0; k < kMax; k++) { if (stepResults(k, 9) > 0) { iterationNumbers[index] = iterationIndex + 1; stageNumbers[index] = k + 1; pi1Values[index] = pi1; hazardRatios[index] = hazardRatio; analysisTime[index] = stepResults(k, 0); subjects[index] = stepResults(k, 1); events1[index] = stepResults(k, 2); events2[index] = stepResults(k, 3); events[index] = stepResults(k, 4); rejections[index] = stepResults(k, 5); eventsNotAchieved[index] = stepResults(k, 6); futilityStops[index] = stepResults(k, 7); testStatistics[index] = stepResults(k, 10); logRankStatistics[index] = stepResults(k, 11); hazardRates1[index] = stepResults(k, 12); hazardRates2[index] = stepResults(k, 13); hazardRatiosEstimate[index] = stepResults(k, 14); conditionalPowerAchieved[index] = stepResults(k, 16); pValuesSeparate[index] = stepResults(k, 17); index++; } } // get raw datasets per stage if (maxNumberOfRawDatasetsPerStage > 0) { for (int k = kMax - 1; k >= 0; k--) { if (rawDataPerStage[k] < maxNumberOfRawDatasetsPerStage && stepResults(k, 9) > 0) { int start = k * maxNumberOfSubjects + pi1Index * kMax * maxNumberOfSubjects + rawDataPerStage[k] * n * kMax * maxNumberOfSubjects; double observationTime = stepResults(k, 15); if (R_IsNA(observationTime)) { break; } List logRankResult = logRankTest( accrualTime, survivalTime, dropoutTime, treatmentGroup, observationTime, directionUpper, thetaH0, true); NumericVector timeUnderObservation = logRankResult["timeUnderObservation"]; LogicalVector event = logRankResult["event"]; LogicalVector dropoutEvent = logRankResult["dropoutEvent"]; for (int i = 0; i < maxNumberOfSubjects; i++) { rawDataPi1Values[start + i] = pi1; rawDataIterationNumbers[start + i] = iterationIndex + 1; rawDataStageNumbers[start + i] = k + 1; rawDataSubjectIds[start + i] = i + 1; rawDataAccrualTime[start + i] = accrualTime[i]; rawDataTreatmentGroups[start + i] = treatmentGroup[i]; rawDataSurvivalTime[start + i] = survivalTime[i]; rawDataDropoutTime[start + i] = dropoutTime[i]; rawDataObservationTime[start + i] = observationTime; rawDataTimeUnderObservation[start + i] = timeUnderObservation[i]; rawDataEvent[start + i] = event[i]; rawDataDropoutEvent[start + i] = dropoutEvent[i]; if (survivalTime[i] >= dropoutTime[i]) { rawDataCensorIndicator[start + i] = 0; } else { rawDataCensorIndicator[start + i] = 1; } } rawDataPerStage[k]++; break; } } } } } NumericVector overallRejections = NumericVector(n, 0.0); NumericVector overallFutilityStops = NumericVector(n, 0.0); NumericVector duration = NumericVector(n, 0.0); NumericVector rejectionsRelative = vectorDivide(rejectionsSum, maxNumberOfIterations); NumericVector futilityStopsRelative = vectorDivide(futilityStopsSum, maxNumberOfIterations); for (int i = 0; i < n; i++) { double s1 = 0; double s2 = 0; double s3 = 0; for (int j = 0; j < kMax; j++) { s1 += rejectionsRelative[i * kMax + j]; s2 += futilityStopsRelative[i * kMax + j]; s3 += durationsSum[i * kMax + j]; } overallRejections[i] = s1; overallFutilityStops[i] = s2; duration[i] = s3 / maxNumberOfIterations; } DataFrame overview = DataFrame::create( Named("stages") = stages, Named("pi2") = NumericVector(sumVectorLength, pi2), Named("pi1") = pi1Column, Named("hazardRatioEstimate1") = hazardRatioColumn, Named("iterations") = iterationsSum, Named("eventsPerStage") = vectorDivide(eventsSum, iterationsSum), Named("eventsNotAchieved") = vectorDivide(eventsNotAchievedSum, maxNumberOfIterations), Named("numberOfSubjects") = vectorDivide(subjectsSum, iterationsSum), Named("rejectPerStage") = rejectionsRelative, Named("overallReject") = vectorRepEachValue(overallRejections, kMax), Named("futilityPerStage") = futilityStopsRelative, Named("futilityStop") = vectorRepEachValue(overallFutilityStops, kMax), Named("analysisTime") = vectorDivide(analysisTimeSum, iterationsSum), Named("studyDuration") = vectorRepEachValue(duration, kMax), Named("conditionalPowerAchieved") = vectorDivide(conditionalPowerAchievedSum, iterationsSum) ); DataFrame data = DataFrame::create( Named("iterationNumber") = iterationNumbers, Named("stageNumber") = stageNumbers, Named("pi1") = pi1Values, Named("pi2") = NumericVector(simResultsVectorLength, pi2), Named("hazardRatio") = hazardRatios, Named("analysisTime") = analysisTime, Named("numberOfSubjects") = subjects, Named("overallEvents1") = events1, Named("overallEvents2") = events2, Named("eventsPerStage") = events, Named("rejectPerStage") = rejections, Named("eventsNotAchieved") = eventsNotAchieved, Named("futilityPerStage") = futilityStops, Named("testStatistic") = testStatistics, Named("logRankStatistic") = logRankStatistics, Named("conditionalPowerAchieved") = conditionalPowerAchieved, Named("pValuesSeparate") = pValuesSeparate ); if (maxNumberOfRawDatasetsPerStage > 0) { DataFrame rawData = DataFrame::create( Named("iterationNumber") = rawDataIterationNumbers, Named("stopStage") = rawDataStageNumbers, Named("pi1") = rawDataPi1Values, Named("pi2") = NumericVector(rawDataVectorLength, pi2), Named("subjectId") = rawDataSubjectIds, Named("accrualTime") = rawDataAccrualTime, Named("treatmentGroup") = rawDataTreatmentGroups, Named("survivalTime") = rawDataSurvivalTime, Named("dropoutTime") = rawDataDropoutTime, Named("observationTime") = rawDataObservationTime, Named("timeUnderObservation") = rawDataTimeUnderObservation, Named("event") = rawDataEvent, Named("dropoutEvent") = rawDataDropoutEvent, Named("censorIndicator") = rawDataCensorIndicator ); return List::create( _["overview"] = overview, _["data"] = data, _["rawData"] = rawData ); } return List::create( _["overview"] = overview, _["data"] = data ); } rpact/src/f_utilities.h0000644000175000017500000000470314142674707015015 0ustar nileshnilesh/** * * -- Simulation utilities -- * * This file is part of the R package rpact: * Confirmatory Adaptive Clinical Trial Design and Analysis * * Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD * Licensed under "GNU Lesser General Public License" version 3 * License text can be found here: https://www.r-project.org/Licenses/LGPL-3 * * RPACT company website: https://www.rpact.com * rpact package website: https://www.rpact.org * * Contact us for information about our services: info@rpact.com * * File version: $Revision: 4248 $ * Last changed: $Date: 2021-01-22 15:57:53 +0100 (Fri, 22 Jan 2021) $ * Last changed by: $Author: pahlke $ * */ #include using namespace Rcpp; #ifndef PKG_RPACT_H #define PKG_RPACT_H std::string getCipheredValue(String x); IntegerVector getOrder(SEXP x, bool desc = false); NumericVector vectorSum(NumericVector x, NumericVector y); NumericVector vectorSub(NumericVector x, NumericVector y); double vectorSum(NumericVector x); NumericVector vectorSqrt(NumericVector x); NumericVector vectorDivide(NumericVector x, double value); NumericVector vectorDivide(NumericMatrix x, int rowIndex, double value); NumericVector vectorDivide(NumericVector x, NumericVector y); NumericVector vectorMultiply(NumericVector x, double multiplier); NumericVector vectorMultiply(NumericVector x, NumericVector y); NumericVector vectorPow(NumericVector x, NumericVector y); NumericVector vectorPow2(NumericVector y, double exp); NumericVector vectorRepEachValue(NumericVector x, int kMax); double vectorProduct(NumericVector x); double vectorProduct(NumericVector x, NumericVector y); double round(double value, int digits); void vectorSumC(int i, int j, int kMax, double* x, NumericMatrix y); void vectorInitC(int i, int kMax, double* x, double value); NumericVector concat(NumericVector a, NumericVector b); NumericMatrix matrixAdd(NumericMatrix x, NumericMatrix y); NumericMatrix matrixSub(NumericMatrix x, NumericMatrix y); NumericMatrix matrixMultiply(NumericMatrix x, double y); NumericVector repInt(int x, int y); std::string vectorToString(NumericVector x); double secant(std::function f, double x0, double x1, double tolerance, int maxIter); double max(NumericVector x); double min(NumericVector x); NumericVector range(int from, int to); NumericVector rangeVector(NumericVector x, int from, int to); NumericVector append(NumericVector x, NumericVector y); void logDebug(std::string s); #endif rpact/src/f_design_group_sequential_probabilities.cpp0000644000175000017500000003336314123271113023147 0ustar nileshnilesh/** * * -- Group sequential design -- * * This file is part of the R package rpact: * Confirmatory Adaptive Clinical Trial Design and Analysis * * Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD * Licensed under "GNU Lesser General Public License" version 3 * License text can be found here: https://www.r-project.org/Licenses/LGPL-3 * * RPACT company website: https://www.rpact.com * rpact package website: https://www.rpact.org * * Contact us for information about our services: info@rpact.com * * File version: $Revision: 5327 $ * Last changed: $Date: 2021-09-24 08:38:02 +0200 (Fr, 24 Sep 2021) $ * Last changed by: $Author: pahlke $ * */ #include #include #include "f_utilities.h" using namespace Rcpp; double dnorm2(const double x, const double mean, const double stDev) { static const double inv_sqrt_2pi = 0.3989422804014327; double a = (x - mean) / stDev; return inv_sqrt_2pi / stDev * exp(-0.5f * a * a); } double getDensityValue(const double x, int k, NumericVector informationRates, NumericVector epsilonVec, NumericVector x2, NumericVector dn2, int n) { k--; double part1 = sqrt((double) informationRates[k - 1] / epsilonVec[k - 1]); double sqrtInfRates1 = sqrt((double) informationRates[k - 1]); double sqrtInfRates2 = sqrt((double) informationRates[k - 2]); const double mean = 0; const double stDev = 1; double prod1 = x * sqrtInfRates1; double divisor = sqrt((double) epsilonVec[k - 1]); double resultValue = 0; for (int i = 0; i < n; i++) { double dnormValue = dnorm2((prod1 - (x2[i] * sqrtInfRates2)) / divisor, mean, stDev); double prod = part1 * dnormValue * dn2[i]; resultValue += prod; } return resultValue; } NumericVector getDensityValues(const NumericVector x, const int k, const NumericVector informationRates, const NumericVector epsilonVec, const NumericVector x2, const NumericVector dn2) { const int n = x.size(); NumericVector results = NumericVector(n, NA_REAL); for (int i = 0; i < n; i++) { if (k == 2) { results[i] = dnorm2((double) x[i], 0.0, 1.0); } else { results[i] = getDensityValue((double) x[i], k, informationRates, epsilonVec, x2, dn2, n); } } return results; } // [[Rcpp::export]] NumericVector getW(double dx, const int M) { NumericVector vec = NumericVector::create(492.0, 1296.0, 162.0, 1632.0, 162.0, 1296.0); vec = vec * dx / 840; int repFactor = (int) ((double) M / 6); // 15 vec = rep(vec, repFactor); // M %/% 6 = 91 %/% 6 = 15 const double x = 246.0 * dx / 840.0; NumericVector result = NumericVector(vec.size() + 1, NA_REAL); result[0] = x; for (int i = 1; i < vec.size(); i++) { result[i] = vec[i]; } result[result.size() - 1] = x; return result; } double getSeqValue(int paramIndex, int k, NumericVector dn, NumericVector x, NumericMatrix decisionMatrix, NumericVector informationRates, NumericVector epsilonVec) { int kIndex = k - 1; NumericVector vec = NumericVector(x.size(), NA_REAL); for (int i = 0; i < x.size(); i++) { double value = decisionMatrix(paramIndex, kIndex); vec[i] = (value * sqrt((double) informationRates[kIndex]) - x[i] * sqrt((double) informationRates[kIndex - 1])) / sqrt((double) epsilonVec[kIndex]); } vec = pnorm(as(vec)); return vectorProduct(vec, dn); } double getDxValue(NumericMatrix decisionMatrix, int k, int M, int rowIndex) { double a = decisionMatrix(rowIndex + 1, k - 2); double b = decisionMatrix(rowIndex, k - 2); return (a - b) / (M - 1); } NumericVector getXValues(NumericMatrix decisionMatrix, int k, int M, int rowIndex) { NumericVector x = rep(decisionMatrix(rowIndex, k - 2), M); double dx = getDxValue(decisionMatrix, k, M, rowIndex); for (int i = 0; i < x.size(); i++) { x[i] = x[i] + i * dx; } return x; } // [[Rcpp::export]] NumericMatrix getGroupSequentialProbabilitiesCpp( NumericMatrix decisionMatrix, NumericVector informationRates) { const double C_UPPER_BOUNDS_DEFAULT = 8; const double C_FUTILITY_BOUNDS_DEFAULT = -6; NumericMatrix decMatrix(Rcpp::clone(decisionMatrix)); for (int i = 0; i < decMatrix.nrow(); i++) { for (int j = 0; j < decMatrix.ncol(); j++) { if (!R_IsNA(decMatrix(i, j)) && decMatrix(i, j) >= C_UPPER_BOUNDS_DEFAULT) { decMatrix(i, j) = C_UPPER_BOUNDS_DEFAULT; } } } // maximum number of stages int kMax = informationRates.size(); // probability matrix output NumericMatrix probs(decMatrix.nrow() + 1, kMax); NumericVector pnormValues = pnorm(decMatrix(_, 0)); for (int i = 0; i < pnormValues.size(); i++) { probs(i, 0) = pnormValues[i]; } probs(probs.nrow() - 1, 0) = 1; if (kMax <= 1) { return probs; } NumericVector epsilonVec = NumericVector(informationRates.size(), NA_REAL); epsilonVec[0] = informationRates[0]; for (int i = 1; i < epsilonVec.size(); i++) { epsilonVec[i] = informationRates[i] - informationRates[i - 1]; } if (decMatrix.nrow() == 2) { for (int i = 0; i < decMatrix.nrow(); i++) { for (int j = 0; j < decMatrix.ncol(); j++) { if (!R_IsNA(decMatrix(i, j)) && decMatrix(i, j) <= C_FUTILITY_BOUNDS_DEFAULT) { decMatrix(i, j) = C_FUTILITY_BOUNDS_DEFAULT; } } } const int C_CONST_NEWTON_COTES = 15; // number of grid points with constant of Newton Cotes algorithm (n * 6 + 1) const int M = C_CONST_NEWTON_COTES * 6 + 1; // density values in recursion NumericVector dn2 = NumericVector(M, NA_REAL); // grid points in recursion NumericVector x2 = NumericVector(M, NA_REAL); for (int k = 2; k <= kMax; k++) { double dx = getDxValue(decMatrix, k, M, 0); NumericVector x = getXValues(decMatrix, k, M, 0); NumericVector w = getW(dx, M); NumericVector densityValues = getDensityValues(x, k, informationRates, epsilonVec, x2, dn2); NumericVector dn = vectorMultiply(w, densityValues); double seq1 = getSeqValue(0, k, dn, x, decMatrix, informationRates, epsilonVec); double seq2 = getSeqValue(1, k, dn, x, decMatrix, informationRates, epsilonVec); x2 = x; dn2 = dn; probs(0, k - 1) = seq1; probs(1, k - 1) = seq2; probs(2, k - 1) = probs(1, k - 2) - probs(0, k - 2); } } else if (decMatrix.nrow() == 4) { for (int i = 0; i < decMatrix.nrow(); i++) { for (int j = 0; j < decMatrix.ncol(); j++) { if (!R_IsNA(decMatrix(i, j)) && decMatrix(i, j) <= -C_UPPER_BOUNDS_DEFAULT) { decMatrix(i, j) = -C_UPPER_BOUNDS_DEFAULT; } } } const int C_CONST_NEWTON_COTES = 8; // number of grid points with constant of Newton Cotes algorithm (n * 6 + 1) const int M = C_CONST_NEWTON_COTES * 6 + 1; // density values in recursion NumericVector dn2 = NumericVector(2 * M, NA_REAL); // grid points in recursion NumericVector x2 = NumericVector(2 * M, NA_REAL); for (int k = 2; k <= kMax; k++) { double dx0 = getDxValue(decMatrix, k, M, 0); double dx1 = getDxValue(decMatrix, k, M, 2); NumericVector x0 = getXValues(decMatrix, k, M, 0); NumericVector x1 = getXValues(decMatrix, k, M, 2); NumericVector x = concat(x0, x1); NumericVector w0 = getW(dx0, M); NumericVector w1 = getW(dx1, M); NumericVector w = concat(w0, w1); NumericVector densityValues = getDensityValues(x, k, informationRates, epsilonVec, x2, dn2); NumericVector dn = vectorMultiply(w, densityValues); double seq1 = getSeqValue(0, k, dn, x, decMatrix, informationRates, epsilonVec); double seq2 = getSeqValue(1, k, dn, x, decMatrix, informationRates, epsilonVec); double seq3 = getSeqValue(2, k, dn, x, decMatrix, informationRates, epsilonVec); double seq4 = getSeqValue(3, k, dn, x, decMatrix, informationRates, epsilonVec); x2 = x; dn2 = dn; probs(0, k - 1) = seq1; probs(1, k - 1) = seq2; probs(2, k - 1) = seq3; probs(3, k - 1) = seq4; probs(4, k - 1) = probs(3, k - 2) - probs(2, k - 2) + probs(1, k - 2) - probs(0, k - 2); } } return probs; } // [[Rcpp::export]] List getDesignGroupSequentialPampallonaTsiatisCpp( double tolerance, double beta, double alpha, double kMax, double deltaPT0, double deltaPT1, NumericVector informationRates, int sided, bool bindingFutility) { NumericVector futilityBounds(kMax); NumericVector rejectionBounds(kMax); NumericMatrix probs(5, kMax); int rows = sided == 1 ? 2 : 4; double size; double prec2 = 1; double cLower2 = 0; double cUpper2 = 10; double c2m; double delst; double power; double prec1 = 1; double cUpper1 = 10; double cLower1 = 0; NumericMatrix helper(rows, kMax); NumericVector sqrtInformationRates = sqrt(informationRates); NumericVector deltaPT0KMaxInformationRates = pow(informationRates * kMax, deltaPT0 - 0.5); NumericVector deltaPT1KMaxInformationRates = pow(informationRates * kMax, deltaPT1 - 0.5); double pow1 = pow(kMax, deltaPT0 - 0.5); double pow2 = pow(kMax, deltaPT1 - 0.5); if (bindingFutility) { NumericMatrix decisionMatrix(rows, kMax); while (prec2 > tolerance) { c2m = (cLower2 + cUpper2) / 2; prec1 = 1; cUpper1 = 10; cLower1 = 0; double c1m; while (prec1 > tolerance) { c1m = (cLower1 + cUpper1) / 2; delst = c2m * pow1 + c1m * pow2; futilityBounds = sqrtInformationRates * delst - deltaPT0KMaxInformationRates * c2m; rejectionBounds = deltaPT1KMaxInformationRates * c1m; for (int i = 0; i < futilityBounds.length(); i++) { if (futilityBounds[i] > rejectionBounds[i]) { futilityBounds[i] = rejectionBounds[i]; } if (sided == 2 && futilityBounds[i] < 0) { futilityBounds[i] = 0; } } if (sided == 1) { decisionMatrix.row(0) = futilityBounds; decisionMatrix.row(1) = rejectionBounds; } else { decisionMatrix.row(0) = -rejectionBounds; decisionMatrix.row(1) = -futilityBounds; decisionMatrix.row(2) = futilityBounds; decisionMatrix.row(3) = rejectionBounds; } probs = getGroupSequentialProbabilitiesCpp(decisionMatrix, informationRates); if (sided == 1) { size = sum(probs.row(2) - probs.row(1)); } else { size = sum(probs.row(4) - probs.row(3) + probs.row(0)); } if (size < alpha) { cUpper1 = c1m; } else { cLower1 = c1m; } prec1 = cUpper1 - cLower1; } for (int i = 0; i < rows; i++) { helper.row(i) = sqrtInformationRates * delst; } NumericMatrix decisionMatrixH1 = matrixSub(decisionMatrix, helper); probs = getGroupSequentialProbabilitiesCpp(decisionMatrixH1, informationRates); if (sided == 1) { power = sum(probs.row(2) - probs.row(1)); } else { power = sum(probs.row(4) - probs.row(3) + probs.row(0)); } if (power > 1.0 - beta) { cUpper2 = c2m; } else { cLower2 = c2m; } prec2 = cUpper2 - cLower2; } } else { double c1m = 0; while (prec1 > tolerance) { c1m = (cLower1 + cUpper1) / 2; rejectionBounds = deltaPT1KMaxInformationRates * c1m; NumericMatrix decisionMatrix(2, kMax); if (sided == 1) { decisionMatrix.row(0) = rep(-6, kMax); } else { decisionMatrix.row(0) = -rejectionBounds; } decisionMatrix.row(1) = rejectionBounds; probs = getGroupSequentialProbabilitiesCpp(decisionMatrix, informationRates); size = sum(probs.row(2) - probs.row(1)); if (sided != 1) size += sum(probs.row(0)); if (size < alpha) { cUpper1 = c1m; } else { cLower1 = c1m; } prec1 = cUpper1 - cLower1; } rejectionBounds = deltaPT1KMaxInformationRates * c1m; while (prec2 > tolerance) { c2m = (cLower2 + cUpper2) / 2; delst = c2m * pow1 + c1m * pow2; futilityBounds = sqrtInformationRates * delst - deltaPT0KMaxInformationRates * c2m; for (int i = 0; i < futilityBounds.length(); i++) { if (futilityBounds[i] > rejectionBounds[i]) { futilityBounds[i] = rejectionBounds[i]; } } NumericMatrix decisionMatrix(rows,kMax); if (sided == 1) { decisionMatrix.row(0) = futilityBounds; decisionMatrix.row(1) = rejectionBounds; } else { for (int i = 0; i < futilityBounds.length(); i++) { if (futilityBounds[i] < 0) { futilityBounds[i] = 0; } } decisionMatrix.row(0) = -rejectionBounds; decisionMatrix.row(1) = -futilityBounds; decisionMatrix.row(2) = futilityBounds; decisionMatrix.row(3) = rejectionBounds; } for(int i = 0; i < helper.nrow();i++) { helper.row(i) = sqrtInformationRates * delst; } NumericMatrix decisionMatrixH1 = matrixSub(decisionMatrix,helper); probs = getGroupSequentialProbabilitiesCpp(decisionMatrixH1, informationRates); if (sided == 1) power = sum(probs.row(2) - probs.row(1)); else power = sum(probs.row(4) + probs.row(0) - probs.row(3)); if (power > 1 - beta) { cUpper2 = c2m; } else { cLower2 = c2m; } prec2 = cUpper2 - cLower2; } } return List::create(futilityBounds, rejectionBounds, probs); } rpact/src/f_utilities.cpp0000644000175000017500000002020114160357107015327 0ustar nileshnilesh/** * * -- Simulation of survival data with group sequential and combination test -- * * This file is part of the R package rpact: * Confirmatory Adaptive Clinical Trial Design and Analysis * * Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD * Licensed under "GNU Lesser General Public License" version 3 * License text can be found here: https://www.r-project.org/Licenses/LGPL-3 * * RPACT company website: https://www.rpact.com * rpact package website: https://www.rpact.org * * Contact us for information about our services: info@rpact.com * * File version: $Revision: 4248 $ * Last changed: $Date: 2021-01-22 15:57:53 +0100 (Fri, 22 Jan 2021) $ * Last changed by: $Author: pahlke $ * */ // [[Rcpp::plugins(cpp11)]] #include using namespace Rcpp; // [[Rcpp::export]] std::string getCipheredValue(String x) { std::size_t hashValue = std::hash{}(x); return std::to_string(hashValue); } std::string toString(const double i) { std::ostringstream ostr; ostr << i; return ostr.str(); } template IntegerVector order_impl(const Vector& x, bool desc) { auto n = x.size(); IntegerVector idx = no_init(n); std::iota(idx.begin(), idx.end(), static_cast(1)); if (desc) { auto comparator = [&x](size_t a, size_t b){ return x[a - 1] > x[b - 1]; }; std::stable_sort(idx.begin(), idx.end(), comparator); } else { auto comparator = [&x](size_t a, size_t b){ return x[a - 1] < x[b - 1]; }; std::stable_sort(idx.begin(), idx.end(), comparator); // simulate na.last size_t nas = 0; for (int i = 0; i < n; ++i, ++nas) if (!Vector::is_na(x[idx[i] - 1])) break; std::rotate(idx.begin(), idx.begin() + nas, idx.end()); } return idx; } // identical to the R function base::order() IntegerVector getOrder(SEXP x, bool desc = false) { switch(TYPEOF(x)) { case INTSXP: return order_impl(x, desc); case REALSXP: return order_impl(x, desc); case STRSXP: return order_impl(x, desc); default: stop("Unsupported type."); } return IntegerVector::create(); } NumericVector vectorSum(NumericVector x, NumericVector y) { int n = x.size(); NumericVector result = NumericVector(n, NA_REAL); for (int i = 0; i < n; i++) { result[i] = x[i] + y[i]; } return result; } NumericVector vectorSub(NumericVector x, NumericVector y) { int n = x.size(); NumericVector result = NumericVector(n, NA_REAL); for (int i = 0; i < n; i++) { result[i] = x[i] - y[i]; } return result; } double vectorSum(NumericVector x) { int n = x.size(); if (n <= 1) { return n == 0 ? 0 : x[0]; } double s = x[0]; for (int i = 1; i < n; i++) { s += x[i]; } return s; } NumericVector vectorSqrt(NumericVector x) { int n = x.size(); NumericVector result = NumericVector(n, NA_REAL); for (int i = 0; i < n; i++) { result[i] = sqrt((double) x[i]); } return result; } NumericVector vectorDivide(NumericVector x, double value) { int n = x.size(); NumericVector result = NumericVector(n, NA_REAL); for (int i = 0; i < n; i++) { result[i] = x[i] / value; } return result; } NumericVector vectorDivide(NumericMatrix x, int rowIndex, double value) { int n = x.size(); NumericVector result = NumericVector(n, NA_REAL); for (int i = 0; i < n; i++) { result[i] = x(rowIndex, i) / value; } return result; } NumericVector vectorDivide(NumericVector x, NumericVector y) { int n = x.size(); NumericVector result = NumericVector(n, NA_REAL); for (int i = 0; i < n; i++) { if (y[i] != 0.0) { result[i] = x[i] / y[i]; } } return result; } NumericVector vectorMultiply(NumericVector x, double multiplier) { int n = x.size(); NumericVector result = NumericVector(n, NA_REAL); for (int i = 0; i < n; i++) { result[i] = x[i] * multiplier; } return result; } NumericVector vectorMultiply(NumericVector x, NumericVector y) { int n = x.size(); NumericVector result = NumericVector(n, NA_REAL); for (int i = 0; i < n; i++) { result[i] = x[i] * y[i]; } return result; } NumericVector vectorPow(NumericVector x, NumericVector y) { int n = x.size(); NumericVector result = NumericVector(n, NA_REAL); for (int i = 0; i < n; i++) { result[i] = pow((double) x[i], (double) y[i]); } return result; } NumericVector vectorPow(double x, NumericVector y) { int n = y.size(); NumericVector result = NumericVector(n, NA_REAL); for (int i = 0; i < n; i++) { result[i] = pow(x, (double) y[i]); } return result; } NumericVector vectorPow2(NumericVector y, double exp) { int n = y.size(); NumericVector result = NumericVector(n, NA_REAL); for (int i = 0; i < n; i++) { result[i] = pow((double) y[i], exp); } return result; } NumericVector vectorRepEachValue(NumericVector x, int kMax) { int n = x.size(); NumericVector result = NumericVector(n * kMax, NA_REAL); for (int i = 0; i < n; i++) { for (int j = 0; j < kMax; j++) { result[i * kMax + j] = x[i]; } } return result; } double vectorProduct(NumericVector x) { int n = x.size(); if (n == 0) { return 0; } if (n == 1) { return x[0]; } double s = x[0]; for (int i = 1; i < n; i++) { s *= x[i]; } return s; } double vectorProduct(NumericVector x, NumericVector y) { int n = x.size(); double s = 0; for (int i = 0; i < n; i++) { s += x[i] * y[i]; } return s; } double round(double value, int digits) { double mult = std::pow(10.0, (double)digits); return round(value * mult) / mult; } void vectorSumC(int i, int j, int kMax, double* x, NumericMatrix y) { for (int k = 0; k < kMax; k++) { x[i * kMax + k] += y(k, j); } } void vectorInitC(int i, int kMax, double* x, double value) { for (int k = 0; k < kMax; k++) { x[i * kMax + k] = value; } } NumericVector concat(NumericVector a, NumericVector b) { for (int i = 0; i < b.size(); i++) { a.insert( a.end(), b[i] ); } return a; } NumericMatrix matrixAdd(NumericMatrix x, NumericMatrix y) { NumericMatrix result(x.nrow(),x.ncol()); for (int i = 0; i < x.nrow(); ++i) { for (int j = 0; j < x.ncol(); ++j) { result(i,j) = x(i,j) + y(i,j); } } return result; } NumericMatrix matrixSub(NumericMatrix x, NumericMatrix y) { NumericMatrix result(x.nrow(), x.ncol()); for (int i = 0; i < x.nrow(); ++i) { for (int j = 0; j < x.ncol(); ++j) { result(i, j) = x(i, j) - y(i, j); } } return result; } NumericMatrix matrixMultiply(NumericMatrix x, double y) { NumericMatrix result(x.nrow(),x.ncol()); for (int i = 0; i < x.nrow(); ++i) { for (int j = 0; j < x.ncol(); ++j) { result(i,j) = x(i,j) * y; } } return result; } NumericVector repInt(int x, int y) { NumericVector result(y); for(int i = 0; i < y ; i++) { result[i] = x; } return result; } std::string vectorToString(NumericVector x) { if (x.length() == 0) return "[]"; std::ostringstream os; os << "["; for(int i = 0; i < x.length(); i++) { os << x[i]; if(i + 1 < x.length()) os << ", "; } os << "]"; return os.str(); } double max(NumericVector x) { if(x.length() == 0) throw std::invalid_argument("Vector is Empty."); double max = x[0]; for(int i = 1; i < x.length(); i++) { if(x[i] > max) max = x[i]; } return max; } double min(NumericVector x) { if(x.length() == 0) throw std::invalid_argument("Vector is Empty."); double min = x[0]; for(int i = 1; i < x.length(); i++) { if(x[i] < min) min = x[i]; } return min; } NumericVector range(int from, int to) { NumericVector res; if(from <= to) { for(int i = from; i <= to; i++) { res.push_back(i); } } else { for(int i = from; i >= to; i--) { res.push_back(i); } } return res; } NumericVector rangeVector(NumericVector x, int from, int to) { NumericVector res; if(from <= to) { for(int i = from; i <= to; i++) { res.push_back(x[i]); } } else { for(int i = from; i >= to; i--) { res.push_back(x[i]); } } return res; } NumericVector append(NumericVector x, NumericVector y) { NumericVector res = clone(x); for(NumericVector::iterator i = y.begin(); i != y.end(); i++) { res.push_back(*i); } return res; } void logDebug(std::string s) { Rcout << s << std::endl; } rpact/src/RcppExports.cpp0000644000175000017500000002732114165524620015313 0ustar nileshnilesh// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include using namespace Rcpp; #ifdef RCPP_USE_GLOBAL_ROSTREAM Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); #endif // getW NumericVector getW(double dx, const int M); RcppExport SEXP _rpact_getW(SEXP dxSEXP, SEXP MSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< double >::type dx(dxSEXP); Rcpp::traits::input_parameter< const int >::type M(MSEXP); rcpp_result_gen = Rcpp::wrap(getW(dx, M)); return rcpp_result_gen; END_RCPP } // getGroupSequentialProbabilitiesCpp NumericMatrix getGroupSequentialProbabilitiesCpp(NumericMatrix decisionMatrix, NumericVector informationRates); RcppExport SEXP _rpact_getGroupSequentialProbabilitiesCpp(SEXP decisionMatrixSEXP, SEXP informationRatesSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type decisionMatrix(decisionMatrixSEXP); Rcpp::traits::input_parameter< NumericVector >::type informationRates(informationRatesSEXP); rcpp_result_gen = Rcpp::wrap(getGroupSequentialProbabilitiesCpp(decisionMatrix, informationRates)); return rcpp_result_gen; END_RCPP } // getDesignGroupSequentialPampallonaTsiatisCpp List getDesignGroupSequentialPampallonaTsiatisCpp(double tolerance, double beta, double alpha, double kMax, double deltaPT0, double deltaPT1, NumericVector informationRates, int sided, bool bindingFutility); RcppExport SEXP _rpact_getDesignGroupSequentialPampallonaTsiatisCpp(SEXP toleranceSEXP, SEXP betaSEXP, SEXP alphaSEXP, SEXP kMaxSEXP, SEXP deltaPT0SEXP, SEXP deltaPT1SEXP, SEXP informationRatesSEXP, SEXP sidedSEXP, SEXP bindingFutilitySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< double >::type tolerance(toleranceSEXP); Rcpp::traits::input_parameter< double >::type beta(betaSEXP); Rcpp::traits::input_parameter< double >::type alpha(alphaSEXP); Rcpp::traits::input_parameter< double >::type kMax(kMaxSEXP); Rcpp::traits::input_parameter< double >::type deltaPT0(deltaPT0SEXP); Rcpp::traits::input_parameter< double >::type deltaPT1(deltaPT1SEXP); Rcpp::traits::input_parameter< NumericVector >::type informationRates(informationRatesSEXP); Rcpp::traits::input_parameter< int >::type sided(sidedSEXP); Rcpp::traits::input_parameter< bool >::type bindingFutility(bindingFutilitySEXP); rcpp_result_gen = Rcpp::wrap(getDesignGroupSequentialPampallonaTsiatisCpp(tolerance, beta, alpha, kMax, deltaPT0, deltaPT1, informationRates, sided, bindingFutility)); return rcpp_result_gen; END_RCPP } // getSimulationSurvivalCpp List getSimulationSurvivalCpp(int designNumber, int kMax, int sided, NumericVector criticalValues, NumericVector informationRates, double conditionalPower, NumericVector plannedEvents, double thetaH1, NumericVector minNumberOfEventsPerStage, NumericVector maxNumberOfEventsPerStage, bool directionUpper, double allocation1, double allocation2, NumericVector accrualTime, IntegerVector treatmentGroup, double thetaH0, NumericVector futilityBounds, NumericVector alpha0Vec, NumericVector pi1Vec, double pi2, double eventTime, NumericVector piecewiseSurvivalTime, NumericVector cdfValues1, NumericVector cdfValues2, NumericVector lambdaVec1, NumericVector lambdaVec2, NumericVector phi, int maxNumberOfSubjects, int maxNumberOfIterations, int maxNumberOfRawDatasetsPerStage, double kappa); RcppExport SEXP _rpact_getSimulationSurvivalCpp(SEXP designNumberSEXP, SEXP kMaxSEXP, SEXP sidedSEXP, SEXP criticalValuesSEXP, SEXP informationRatesSEXP, SEXP conditionalPowerSEXP, SEXP plannedEventsSEXP, SEXP thetaH1SEXP, SEXP minNumberOfEventsPerStageSEXP, SEXP maxNumberOfEventsPerStageSEXP, SEXP directionUpperSEXP, SEXP allocation1SEXP, SEXP allocation2SEXP, SEXP accrualTimeSEXP, SEXP treatmentGroupSEXP, SEXP thetaH0SEXP, SEXP futilityBoundsSEXP, SEXP alpha0VecSEXP, SEXP pi1VecSEXP, SEXP pi2SEXP, SEXP eventTimeSEXP, SEXP piecewiseSurvivalTimeSEXP, SEXP cdfValues1SEXP, SEXP cdfValues2SEXP, SEXP lambdaVec1SEXP, SEXP lambdaVec2SEXP, SEXP phiSEXP, SEXP maxNumberOfSubjectsSEXP, SEXP maxNumberOfIterationsSEXP, SEXP maxNumberOfRawDatasetsPerStageSEXP, SEXP kappaSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< int >::type designNumber(designNumberSEXP); Rcpp::traits::input_parameter< int >::type kMax(kMaxSEXP); Rcpp::traits::input_parameter< int >::type sided(sidedSEXP); Rcpp::traits::input_parameter< NumericVector >::type criticalValues(criticalValuesSEXP); Rcpp::traits::input_parameter< NumericVector >::type informationRates(informationRatesSEXP); Rcpp::traits::input_parameter< double >::type conditionalPower(conditionalPowerSEXP); Rcpp::traits::input_parameter< NumericVector >::type plannedEvents(plannedEventsSEXP); Rcpp::traits::input_parameter< double >::type thetaH1(thetaH1SEXP); Rcpp::traits::input_parameter< NumericVector >::type minNumberOfEventsPerStage(minNumberOfEventsPerStageSEXP); Rcpp::traits::input_parameter< NumericVector >::type maxNumberOfEventsPerStage(maxNumberOfEventsPerStageSEXP); Rcpp::traits::input_parameter< bool >::type directionUpper(directionUpperSEXP); Rcpp::traits::input_parameter< double >::type allocation1(allocation1SEXP); Rcpp::traits::input_parameter< double >::type allocation2(allocation2SEXP); Rcpp::traits::input_parameter< NumericVector >::type accrualTime(accrualTimeSEXP); Rcpp::traits::input_parameter< IntegerVector >::type treatmentGroup(treatmentGroupSEXP); Rcpp::traits::input_parameter< double >::type thetaH0(thetaH0SEXP); Rcpp::traits::input_parameter< NumericVector >::type futilityBounds(futilityBoundsSEXP); Rcpp::traits::input_parameter< NumericVector >::type alpha0Vec(alpha0VecSEXP); Rcpp::traits::input_parameter< NumericVector >::type pi1Vec(pi1VecSEXP); Rcpp::traits::input_parameter< double >::type pi2(pi2SEXP); Rcpp::traits::input_parameter< double >::type eventTime(eventTimeSEXP); Rcpp::traits::input_parameter< NumericVector >::type piecewiseSurvivalTime(piecewiseSurvivalTimeSEXP); Rcpp::traits::input_parameter< NumericVector >::type cdfValues1(cdfValues1SEXP); Rcpp::traits::input_parameter< NumericVector >::type cdfValues2(cdfValues2SEXP); Rcpp::traits::input_parameter< NumericVector >::type lambdaVec1(lambdaVec1SEXP); Rcpp::traits::input_parameter< NumericVector >::type lambdaVec2(lambdaVec2SEXP); Rcpp::traits::input_parameter< NumericVector >::type phi(phiSEXP); Rcpp::traits::input_parameter< int >::type maxNumberOfSubjects(maxNumberOfSubjectsSEXP); Rcpp::traits::input_parameter< int >::type maxNumberOfIterations(maxNumberOfIterationsSEXP); Rcpp::traits::input_parameter< int >::type maxNumberOfRawDatasetsPerStage(maxNumberOfRawDatasetsPerStageSEXP); Rcpp::traits::input_parameter< double >::type kappa(kappaSEXP); rcpp_result_gen = Rcpp::wrap(getSimulationSurvivalCpp(designNumber, kMax, sided, criticalValues, informationRates, conditionalPower, plannedEvents, thetaH1, minNumberOfEventsPerStage, maxNumberOfEventsPerStage, directionUpper, allocation1, allocation2, accrualTime, treatmentGroup, thetaH0, futilityBounds, alpha0Vec, pi1Vec, pi2, eventTime, piecewiseSurvivalTime, cdfValues1, cdfValues2, lambdaVec1, lambdaVec2, phi, maxNumberOfSubjects, maxNumberOfIterations, maxNumberOfRawDatasetsPerStage, kappa)); return rcpp_result_gen; END_RCPP } // getStratifiedLogRankTestCpp List getStratifiedLogRankTestCpp(DataFrame survivalDataSet, double time, bool directionUpper, double thetaH0); RcppExport SEXP _rpact_getStratifiedLogRankTestCpp(SEXP survivalDataSetSEXP, SEXP timeSEXP, SEXP directionUpperSEXP, SEXP thetaH0SEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< DataFrame >::type survivalDataSet(survivalDataSetSEXP); Rcpp::traits::input_parameter< double >::type time(timeSEXP); Rcpp::traits::input_parameter< bool >::type directionUpper(directionUpperSEXP); Rcpp::traits::input_parameter< double >::type thetaH0(thetaH0SEXP); rcpp_result_gen = Rcpp::wrap(getStratifiedLogRankTestCpp(survivalDataSet, time, directionUpper, thetaH0)); return rcpp_result_gen; END_RCPP } // getSimulationStratifiedLogRankCpp List getSimulationStratifiedLogRankCpp(int kMax, NumericVector criticalValues, NumericVector lambda2, NumericVector lambda1, NumericVector prevalences, bool directionUpper, int maxNumberOfSubjects, NumericVector accrualTime, NumericVector plannedEvents, double allocation1, double allocation2, int maxIterations, DataFrame survivalDataSet); RcppExport SEXP _rpact_getSimulationStratifiedLogRankCpp(SEXP kMaxSEXP, SEXP criticalValuesSEXP, SEXP lambda2SEXP, SEXP lambda1SEXP, SEXP prevalencesSEXP, SEXP directionUpperSEXP, SEXP maxNumberOfSubjectsSEXP, SEXP accrualTimeSEXP, SEXP plannedEventsSEXP, SEXP allocation1SEXP, SEXP allocation2SEXP, SEXP maxIterationsSEXP, SEXP survivalDataSetSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< int >::type kMax(kMaxSEXP); Rcpp::traits::input_parameter< NumericVector >::type criticalValues(criticalValuesSEXP); Rcpp::traits::input_parameter< NumericVector >::type lambda2(lambda2SEXP); Rcpp::traits::input_parameter< NumericVector >::type lambda1(lambda1SEXP); Rcpp::traits::input_parameter< NumericVector >::type prevalences(prevalencesSEXP); Rcpp::traits::input_parameter< bool >::type directionUpper(directionUpperSEXP); Rcpp::traits::input_parameter< int >::type maxNumberOfSubjects(maxNumberOfSubjectsSEXP); Rcpp::traits::input_parameter< NumericVector >::type accrualTime(accrualTimeSEXP); Rcpp::traits::input_parameter< NumericVector >::type plannedEvents(plannedEventsSEXP); Rcpp::traits::input_parameter< double >::type allocation1(allocation1SEXP); Rcpp::traits::input_parameter< double >::type allocation2(allocation2SEXP); Rcpp::traits::input_parameter< int >::type maxIterations(maxIterationsSEXP); Rcpp::traits::input_parameter< DataFrame >::type survivalDataSet(survivalDataSetSEXP); rcpp_result_gen = Rcpp::wrap(getSimulationStratifiedLogRankCpp(kMax, criticalValues, lambda2, lambda1, prevalences, directionUpper, maxNumberOfSubjects, accrualTime, plannedEvents, allocation1, allocation2, maxIterations, survivalDataSet)); return rcpp_result_gen; END_RCPP } // getCipheredValue std::string getCipheredValue(String x); RcppExport SEXP _rpact_getCipheredValue(SEXP xSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< String >::type x(xSEXP); rcpp_result_gen = Rcpp::wrap(getCipheredValue(x)); return rcpp_result_gen; END_RCPP } static const R_CallMethodDef CallEntries[] = { {"_rpact_getW", (DL_FUNC) &_rpact_getW, 2}, {"_rpact_getGroupSequentialProbabilitiesCpp", (DL_FUNC) &_rpact_getGroupSequentialProbabilitiesCpp, 2}, {"_rpact_getDesignGroupSequentialPampallonaTsiatisCpp", (DL_FUNC) &_rpact_getDesignGroupSequentialPampallonaTsiatisCpp, 9}, {"_rpact_getSimulationSurvivalCpp", (DL_FUNC) &_rpact_getSimulationSurvivalCpp, 31}, {"_rpact_getStratifiedLogRankTestCpp", (DL_FUNC) &_rpact_getStratifiedLogRankTestCpp, 4}, {"_rpact_getSimulationStratifiedLogRankCpp", (DL_FUNC) &_rpact_getSimulationStratifiedLogRankCpp, 13}, {"_rpact_getCipheredValue", (DL_FUNC) &_rpact_getCipheredValue, 1}, {NULL, NULL, 0} }; RcppExport void R_init_rpact(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } rpact/src/f_simulation_survival_utilities.cpp0000644000175000017500000001105414153641706021537 0ustar nileshnilesh/** * * -- Simulation of survival data with group sequential and combination test -- * * This file is part of the R package rpact: * Confirmatory Adaptive Clinical Trial Design and Analysis * * Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD * Licensed under "GNU Lesser General Public License" version 3 * License text can be found here: https://www.r-project.org/Licenses/LGPL-3 * * RPACT company website: https://www.rpact.com * rpact package website: https://www.rpact.org * * Contact us for information about our services: info@rpact.com * * File version: $Revision: 5428 $ * Last changed: $Date: 2021-10-27 20:23:49 +0200 (Mi, 27 Okt 2021) $ * Last changed by: $Author: pahlke $ * */ #include #include "f_utilities.h" using namespace Rcpp; double findObservationTime( NumericVector accrualTime, NumericVector survivalTime, NumericVector dropoutTime, double requiredStageEvents) { int numberOfSubjects = accrualTime.size(); double upperBound = 1; double numberOfEvents; while (true) { numberOfEvents = 0; for (int i = 0; i < numberOfSubjects; i++) { if (accrualTime[i] + survivalTime[i] < upperBound && (R_IsNA((double) dropoutTime[i]) || dropoutTime[i] > survivalTime[i])) { numberOfEvents = numberOfEvents + 1; } } upperBound = 2 * upperBound; if (numberOfEvents > requiredStageEvents || upperBound > 1E12) { break; } } if (upperBound > 1E12) { return NA_REAL; } double lower = 0; double upper = upperBound; double time; while (true) { time = (lower + upper) / 2; numberOfEvents = 0; for (int i = 0; i < numberOfSubjects; i++) { if (accrualTime[i] + survivalTime[i] <= time && (R_IsNA((double) dropoutTime[i]) || dropoutTime[i] > survivalTime[i])) { numberOfEvents = numberOfEvents + 1; } } if (numberOfEvents >= requiredStageEvents) { upper = time; } else { lower = time; } if (upper - lower < 1E-05) { break; } } if (numberOfEvents > requiredStageEvents) { time -= 1E-05; } else if (numberOfEvents < requiredStageEvents) { time += 1E-05; } return time; } /** * ::Rf_pnorm5 identical to R::pnorm */ double getNormalDistribution(double p) { return R::pnorm(p, 0.0, 1.0, 1, 0); // p, mu, sigma, lt, lg } /** * ::Rf_qnorm5 identical to R::qnorm */ double getNormalQuantile(double p) { return R::qnorm(p, 0.0, 1.0, 1, 0); // p, mu, sigma, lt, lg } /** * ::Rf_rexp identical to * R::rexp(rate); * Rcpp::rexp(1, rate)[0]; */ double getRandomExponentialDistribution(double rate) { return Rcpp::rexp(1, rate)[0]; } /** * Weibull: (-log(1 - runif(0.0, 1.0)))^(1 / kappa) / rate */ double getRandomSurvivalDistribution(double rate, double kappa) { return pow(-log(1 - R::runif(0.0, 1.0)), 1 / kappa) / rate; } /** * [[Rcpp::export]] */ double getRandomPiecewiseExponentialDistribution( NumericVector cdfValues, NumericVector piecewiseLambda, NumericVector piecewiseSurvivalTime) { double y; NumericVector s; double p = R::runif(0.0, 1.0); int n = piecewiseSurvivalTime.size(); if (n == 0) { return -log(1 - p) / piecewiseLambda[0]; } for (int i = 0; i < n; i++) { if (p <= cdfValues[i]) { if (i == 0) { return -log(1 - p) / piecewiseLambda[0]; } y = piecewiseLambda[0] * piecewiseSurvivalTime[0]; if (i > 1) { s = vectorSum(piecewiseSurvivalTime[seq(1, i - 1)], -piecewiseSurvivalTime[seq(0, i - 2)]); y += vectorProduct(piecewiseLambda[seq(1, i - 1)], s); } return piecewiseSurvivalTime[i - 1] - (log(1 - p) + y) / piecewiseLambda[i]; } } if (n == 1) { return piecewiseSurvivalTime[0] - (log(1 - p) + piecewiseLambda[0] * piecewiseSurvivalTime[0]) / piecewiseLambda[1]; } s = vectorSum(piecewiseSurvivalTime[seq(1, n - 1)], -piecewiseSurvivalTime[seq(0, n - 2)]); y = piecewiseLambda[0] * piecewiseSurvivalTime[0] + vectorProduct(piecewiseLambda[seq(1, n - 1)], s); return piecewiseSurvivalTime[n - 1] - (log(1 - p) + y) / piecewiseLambda[n]; } bool isPiecewiseExponentialSurvivalEnabled(NumericVector lambdaVec2) { if (lambdaVec2.size() <= 1) { return false; } for (int i = 0; i < lambdaVec2.size(); i++) { if (R_IsNA((double) lambdaVec2[i])) { return false; } } return true; } double getLambdaByPi(double pi, double eventTime, double kappa) { return pow(-log(1 - pi), 1 / kappa) / eventTime; } double getPiByLambda(double lambda, double eventTime, double kappa) { return 1 - exp(-pow(lambda * eventTime, kappa)); } double getHazardRatio(double pi1, double pi2, double eventTime, double kappa) { return pow(getLambdaByPi(pi1, eventTime, kappa) / getLambdaByPi(pi2, eventTime, kappa), kappa); } rpact/src/f_simulation_enrichment_survival.cpp0000644000175000017500000002110714136712715021660 0ustar nileshnilesh/** * * -- Simulation of survival data with group sequential and combination test -- * * This file is part of the R package rpact: * Confirmatory Adaptive Clinical Trial Design and Analysis * * Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD * Licensed under "GNU Lesser General Public License" version 3 * License text can be found here: https://www.r-project.org/Licenses/LGPL-3 * * RPACT company website: https://www.rpact.com * rpact package website: https://www.rpact.org * * Contact us for information about our services: info@rpact.com * * File version: $Revision: 5428 $ * Last changed: $Date: 2021-10-27 20:23:49 +0200 (Mi, 27 Okt 2021) $ * Last changed by: $Author: pahlke $ * */ #include #include "f_utilities.h" #include "f_simulation_survival_utilities.h" using namespace Rcpp; Function subset("[.data.frame"); // [[Rcpp::export]] List getStratifiedLogRankTestCpp(DataFrame survivalDataSet, double time, bool directionUpper, double thetaH0 = 1.0) { double numerator = 0, denominator = 0, eventNumber = 0; int subjectsNumber = 0; NumericVector strata = survivalDataSet["stratum"]; for (int iStratum = 1; iStratum <= max(strata); iStratum++) { NumericVector survivalDataSetStratumVec = survivalDataSet["stratum"]; LogicalVector stratumEqualsi(survivalDataSetStratumVec.length()); for (int i = 0; i < stratumEqualsi.length(); i++) { stratumEqualsi[i] = survivalDataSetStratumVec[i] == iStratum; } DataFrame survivalDataSetStratum = subset(survivalDataSet, stratumEqualsi, R_MissingArg); NumericVector survivalDataSetStratumAccrualTime = survivalDataSetStratum["accrualTime"]; int numberOfSubjects = survivalDataSetStratumAccrualTime.length(); NumericVector survivalDataSetStratumTreatmentGroup = survivalDataSetStratum["treatmentGroup"]; NumericVector survivalDataSetStratumSurvivalTime = survivalDataSetStratum["survivalTime"]; LogicalVector survivalDataSetStratumEvent(numberOfSubjects); //needs to be generated NumericVector survivalDataSetStratumTimeUnderObservation(numberOfSubjects); //needs to be generated double subjectsT1 = 0; double subjectsT2 = 0; for (int i = 0; i < numberOfSubjects; i++) { if (survivalDataSetStratumAccrualTime[i] > time) { survivalDataSetStratumTreatmentGroup[i] = 0; survivalDataSetStratumEvent[i] = false; } else { if (survivalDataSetStratumTreatmentGroup[i] == 1) { subjectsT1++; } else if (survivalDataSetStratumTreatmentGroup[i] == 2) { subjectsT2++; } } if (survivalDataSetStratumAccrualTime[i] + survivalDataSetStratumSurvivalTime[i] < time && survivalDataSetStratumTreatmentGroup[i] > 0) { survivalDataSetStratumEvent[i] = true; } else { survivalDataSetStratumEvent[i] = false; } if (survivalDataSetStratumEvent[i]) { survivalDataSetStratumTimeUnderObservation[i] = survivalDataSetStratumSurvivalTime[i]; } else { survivalDataSetStratumTimeUnderObservation[i] = time - survivalDataSetStratumAccrualTime[i]; } } survivalDataSetStratum = DataFrame::create( _["accrualTime"] = survivalDataSetStratumAccrualTime, _["treatmentGroup"] = survivalDataSetStratumTreatmentGroup, _["survivalTime"] = survivalDataSetStratumSurvivalTime, _["event"] = survivalDataSetStratumEvent, _["timeUnderObservation"] = survivalDataSetStratumTimeUnderObservation); IntegerVector sortedIndex = getOrder(survivalDataSetStratumTimeUnderObservation, false); DataFrame survivalDataSetSorted = subset(survivalDataSetStratum, sortedIndex, R_MissingArg); NumericVector survivalDataSetSortedEvent = survivalDataSetSorted["event"]; NumericVector survivalDataSetSortedTreatmentGroup = survivalDataSetSorted["treatmentGroup"]; int events1 = 0, events2 = 0; for (int i = 0; i < numberOfSubjects; i++) { if (survivalDataSetSortedEvent[i]) { if (survivalDataSetSortedTreatmentGroup[i] == 1) { if (subjectsT1 + subjectsT2 > 0) { numerator += -thetaH0 * subjectsT2 / (subjectsT1 + thetaH0 * subjectsT2); } events1++; } else if (survivalDataSetSortedTreatmentGroup[i] == 2) { if (subjectsT1 + subjectsT2 > 0) { numerator += 1 - thetaH0 * subjectsT2 / (subjectsT1 + thetaH0 * subjectsT2); } events2++; } if (subjectsT1 + subjectsT2 > 0) { denominator += thetaH0 * subjectsT1 * subjectsT2 / pow(subjectsT1 + thetaH0 * subjectsT2, 2); } } if (survivalDataSetSortedTreatmentGroup[i] == 1) { subjectsT1--; } else if (survivalDataSetSortedTreatmentGroup[i] == 2) { subjectsT2--; } } eventNumber += events1 + events2; subjectsNumber += numberOfSubjects; } double strLogRank = denominator > 0 ? -numerator / sqrt(denominator) : R_NegInf; if (!directionUpper) { strLogRank = -strLogRank; } return List::create( _["strLogRank"] = strLogRank, _["thetaH0"] = thetaH0, _["directionUpper"] = directionUpper, _["eventNumber"] = eventNumber, _["subjectsNumber"] = subjectsNumber); } // [[Rcpp::export]] List getSimulationStratifiedLogRankCpp( int kMax, NumericVector criticalValues, NumericVector lambda2, NumericVector lambda1, NumericVector prevalences, bool directionUpper, int maxNumberOfSubjects, NumericVector accrualTime, NumericVector plannedEvents, double allocation1, double allocation2, int maxIterations, DataFrame survivalDataSet) { NumericVector simulatedAnalysisTime(kMax); NumericVector simulatedSubjects(kMax); NumericVector simulatedEvents(kMax); NumericVector simulatedRejections(kMax); NumericVector simulatedEventsNotAchieved(kMax); double simulatedDuration = 0; NumericVector iterations(kMax); IntegerVector survivalDataSetTreatmentGroup = survivalDataSet["treatmentGroup"]; NumericVector survivalDataSetSurvivalTime(maxNumberOfSubjects); NumericVector survivalDataSetStratum = survivalDataSet["stratum"]; for (int j = 1; j <= maxIterations; j++) { for (int iSubject = 0; iSubject < maxNumberOfSubjects; iSubject++) { double lambda; if (survivalDataSetTreatmentGroup[iSubject] == 1) { lambda = lambda1[survivalDataSetStratum[iSubject] - 1]; } else { lambda = lambda2[survivalDataSetStratum[iSubject] - 1]; } //double x = rexp(1.0, lambda)[0]; double x = getRandomExponentialDistribution(lambda); if (Rcpp::traits::is_nan(x)) { x = R_PosInf; } survivalDataSetSurvivalTime[iSubject] = x; } survivalDataSet["survivalTime"] = survivalDataSetSurvivalTime; for (int k = 0; k < kMax; k++) { double observationTime = findObservationTime( survivalDataSet["accrualTime"], survivalDataSetSurvivalTime, survivalDataSet["dropoutTime"], (double) plannedEvents[k]); if (R_IsNA(observationTime)) { simulatedEventsNotAchieved[k]++; break; // trial stop } List survivalResult = getStratifiedLogRankTestCpp( survivalDataSet, observationTime, directionUpper); simulatedEvents[k] += (double) survivalResult["eventNumber"]; simulatedAnalysisTime[k] += observationTime; iterations[k]++; if ((double) survivalResult["strLogRank"] >= criticalValues[k]) { simulatedRejections[k]++; simulatedDuration += observationTime; simulatedSubjects[k] += (int) survivalResult["subjectsNumber"]; break; // trial stop } else { simulatedSubjects[k] += (int) survivalResult["subjectsNumber"]; if (k == kMax - 1) { simulatedDuration += observationTime; } } } } return List::create( _["iterations"] = iterations, _["events"] = simulatedEvents / iterations, _["eventsNotAchieved"] = simulatedEventsNotAchieved / maxIterations, _["rejectPerStage"] = simulatedRejections / maxIterations, _["overallReject"] = vectorSum(simulatedRejections / maxIterations), _["analysisTime"] = simulatedAnalysisTime / iterations, _["duration"] = simulatedDuration / maxIterations, _["numberOfSubjects"] = simulatedSubjects / iterations); } rpact/src/f_simulation_survival_utilities.h0000644000175000017500000000301314153641601021172 0ustar nileshnilesh/** * * -- Simulation survival utilities -- * * This file is part of the R package rpact: * Confirmatory Adaptive Clinical Trial Design and Analysis * * Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD * Licensed under "GNU Lesser General Public License" version 3 * License text can be found here: https://www.r-project.org/Licenses/LGPL-3 * * RPACT company website: https://www.rpact.com * rpact package website: https://www.rpact.org * * Contact us for information about our services: info@rpact.com * * File version: $Revision: 4248 $ * Last changed: $Date: 2021-01-22 15:57:53 +0100 (Fri, 22 Jan 2021) $ * Last changed by: $Author: pahlke $ * */ #include using namespace Rcpp; #ifndef PKG_RPACT_H2 #define PKG_RPACT_H2 double findObservationTime( NumericVector accrualTime, NumericVector survivalTime, NumericVector dropoutTime, double requiredStageEvents); double getNormalDistribution(double p); double getNormalQuantile(double p); double getRandomExponentialDistribution(double rate); double getRandomSurvivalDistribution(double rate, double kappa); double getRandomPiecewiseExponentialDistribution( NumericVector cdfValues, NumericVector piecewiseLambda, NumericVector piecewiseSurvivalTime); bool isPiecewiseExponentialSurvivalEnabled(NumericVector lambdaVec2); double getLambdaByPi(double pi, double eventTime, double kappa); double getPiByLambda(double lambda, double eventTime, double kappa); double getHazardRatio(double pi1, double pi2, double eventTime, double kappa); #endif rpact/vignettes/0000755000175000017500000000000014165536076013542 5ustar nileshnileshrpact/vignettes/rpact_getting_started.Rmd0000644000175000017500000001550614156312023020555 0ustar nileshnilesh--- title: "Getting started with rpact" author: "Friedrich Pahlke and Gernot Wassmer" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Getting started with rpact} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` Confirmatory Adaptive Clinical Trial Design, Simulation, and Analysis. ## Functional Range * Sample size and power calculation for + means (continuous endpoint) + rates (binary endpoint) + survival trials with - piecewise accrual time and intensity - piecewise exponential survival time - survival times that follow a Weibull distribution * Fixed sample design and designs with interim analysis stages * Simulation tool for means, rates, and survival data + Assessment of adaptive sample size/event number recalculations based on conditional power + Assessment of treatment selection strategies in multi-arm trials * Adaptive analysis of means, rates, and survival data * Adaptive designs and analysis for multi-arm trials * Simulation and analysis for enrichment designs testing means, rates, and hazard ratios ## Learn to use rpact We recommend three ways to learn how to use `rpact`: > 1. Use the Shiny app: [shiny.rpact.com](https://www.rpact.com/products#public-rpact-shiny-app) > 2. Use the Vignettes: > [www.rpact.com/vignettes](https://www.rpact.com/vignettes) > 3. Book a training: > [www.rpact.com](https://www.rpact.com/services#learning-and-training) ### Vignettes The vignettes are hosted at [www.rpact.com/vignettes](https://www.rpact.com/vignettes) and cover the following topics: 1. Defining group-sequential boundaries 2. Designing group-sequential trials with two groups and a continuous endpoint 3. Designing group-sequential trials with a binary endpoint 4. Designing group-sequential trials with two groups and a survival endpoint 5. Simulation-based design of group-sequential trials with a survival endpoint 6. An example to illustrate boundary re-calculations during the trial 7. Analysis of a group-sequential trial with a survival endpoint 8. Defining accrual time and accrual intensity 9. How to use R generics with `rpact` 10. How to create admirable plots with `rpact` 11. Comparing sample size and power calculation results for a group-sequential trial with a survival endpoint: [rpact](https://cran.r-project.org/package=rpact) vs. [gsDesign](https://cran.r-project.org/package=gsDesign) 12. Supplementing and enhancing rpact's graphical capabilities with [ggplot2](https://cran.r-project.org/package=ggplot2) 13. Using the inverse normal combination test for analyzing a trial with continuous endpoint and potential sample size reassessment 14. Planning a trial with binary endpoints 15. Planning a survival trial 16. Simulation of a trial with a binary endpoint and unblinded sample size re-calculation 17. How to create summaries 18. How to create analysis result (one- and multi-arm) plots 19. How to create simulation result (one- and multi-arm) plots 20. Simulating multi-arm designs with a continuous endpoint 21. Analysis of a multi-arm design with a binary endpoint 22. Step-by-Step rpact Tutorial 23. Planning and Analyzing a Group-Sequential Multi-Arm-Multi-Stage Design with Binary Endpoint using rpact 24. Two-arm analysis for continuous data with covariates from raw data (*exclusive*) 25. How to install the latest developer version (*exclusive*) ## User Concept ### Workflow * Everything is starting with a design, e.g.: `design <- getDesignGroupSequential()` * Find the optimal design parameters with help of `rpact` comparison tools: `getDesignSet` * Calculate the required sample size, e.g.: `getSampleSizeMeans()`, `getPowerMeans()` * Simulate specific characteristics of an adaptive design, e.g.: `getSimulationMeans()` * Collect your data, import it into R and create a dataset: `data <- getDataset()` * Analyze your data: `getAnalysisResults(design, data)` ### Focus on Usability The most important `rpact` functions have intuitive names: * `getDesign`[`GroupSequential`/`InverseNormal`/`Fisher`]`()` * `getDesignCharacteristics()` * `getSampleSize`[`Means`/`Rates`/`Survival`]`()` * `getPower`[`Means`/`Rates`/`Survival`]`()` * `getSimulation`[`MultiArm`/`Enrichment`]``[`Means`/`Rates`/`Survival`]`()` * `getDataSet()` * `getAnalysisResults()` * `getStageResults()` RStudio/Eclipse: auto code completion makes it easy to use these functions. ### R generics In general, everything runs with the R standard functions which are always present in R: so-called R generics, e.g., `print`, `summary`, `plot`, `as.data.frame`, `names`, `length` ### Utilities Several utility functions are available, e.g. * `getAccrualTime()` * `getPiecewiseSurvivalTime()` * `getNumberOfSubjects()` * `getEventProbabilities()` * `getPiecewiseExponentialDistribution()` * survival helper functions for conversion of `pi`, `lambda` and `median`, e.g., `getLambdaByMedian()` * `testPackage()`: installation qualification on a client computer or company server (via unit tests) ## Validation Please [contact](https://www.rpact.com/contact) us to learn how to use `rpact` on FDA/GxP-compliant validated corporate computer systems and how to get a copy of the formal validation documentation that is customized and licensed for exclusive use by your company, e.g., to fulfill regulatory requirements. ## About * **rpact** is a comprehensive validated^[The rpact validation documentation is available exclusively for our customers and supporting companies. For more information visit [www.rpact.com/services/sla](https://www.rpact.com/services/sla)] R package for clinical research which + enables the design and analysis of confirmatory adaptive group sequential designs + is a powerful sample size calculator + is a free of charge open-source software licensed under [LGPL-3](https://cran.r-project.org/web/licenses/LGPL-3) + particularly, implements the methods described in the recent monograph by [Wassmer and Brannath (2016)](https://doi.org/10.1007%2F978-3-319-32562-0) > For more information please visit [www.rpact.org](https://www.rpact.org) * **RPACT** is a company which offers + enterprise software development services + technical support for the `rpact` package + consultancy and user training for clinical research using R + validated software solutions and R package development for clinical research > For more information please visit [www.rpact.com](https://www.rpact.com) ## Contact * [info@rpact.com](mailto:info@rpact.com) * [www.rpact.com/contact](https://www.rpact.com/contact) rpact/build/0000755000175000017500000000000014165536100012615 5ustar nileshnileshrpact/build/vignette.rds0000644000175000017500000000033514165536076015171 0ustar nileshnileshuK @GBx: b.!n*bn}l|En60?fBT+*Q5L5CWNL<1H8 r&Ӏ8#4)$N D4DZp4] Zx =J+I6ghJ1if12f|{Ms.?J S6)ƝvvТɋFE-Fwn7%\rpact/build/partial.rdb0000644000175000017500000001057014165536075014760 0ustar nileshnilesh=kwƕ8NHKu%%)Nl+V[~'RRr"M@`HN(Jfu?cO~nv-<"^ wdP(F0 aϗ# nԤQ:ı^w\['EL#Tgh^(kǪ|oĮ9٘| 칪į3rtGdX}l~n3@$񨩶 ]01~l x{Κ;{/^i^+18(x ^yRǭF#~zjeTO[v읽{[j ~M]V5RM+Wæ.7s0rǰ'?UzL;4_6ld+t!\ @7F~L'ɮAU[ZEMOefj>hQ~{c" ?rbJl`aĽ@mЄLADx Kiu\4f!![,Au33J :7f-72t_ʶsU#RS!^nJOd rļ&w#S׶eaet\NVk*N>K9]Omp6_9rRgP⇝ 0Exu-#e-(+;@3)A<2jEkM[E@t%*X\f' "Hiѵ e65]m;5)/~IŔq5{t5y\餔/!m1^8ku"O#&,ָ*϶zb/XFWWySzl#c-Uįff!p' ֖3 Hgɛss, 6Pd8]AoҎgqwMuX~kn~AȠqt'x9OBI;c֘Yج.h34ƣ(?DDfŋ&]=T͡yEDФI1c: :ggH>< 8W8t)Tcuq=iMq62o t do}-<.>ݯGsHp^?sYʩ~NiBv:Y~fnbe_[cns \xL)/[xiyTfV#:3rO*/P_*'Ki[y^F?2ؓ&M 2m!%8݉oDجR&.0٧OZ}ز`*lKʷ'ueIYgSO `ZrAlwR9::*k-j2p4F8}*hk[**MA9mķ3;Y1q"A<{N:V_R;qwquD!xy;XYmO`]ISLm]w3K^>َ~ >fŢ6̀>+j^bnarq, HJ:%L@ x ?E-~~ sH@0눯}џC `>E*.k !5,_ O/!C{v_ `>KEB+T"j)Fh+fa%KyNX ,8k_Kpܕ|N;e1%f#=-(i~Gy<|q>y;E5ɮ4hHxEҍz_%oq}!3nx1q l rSp\.1\ y +2 _ )@w[PU"  :=-//%X"K- Kwex.<(-gb_R>E#|̢=ffxYpx-drI4̷$; Lj?N-Gje?8mKx#cϲ w}}t[[]|7R^]YWyp;}J|/VmVwbD")HQ:3ʵXa+\Xg^6w=)O7gR(TKk*bp.=aa=Jq SU[ֶtF@8\v$̣e #d|e #d-hDԶ w@axY8rc0yM .`k"}@07$GN"rʮ(}R&6Z1vp)wb:3gfWYWQ+z0.J=4[mJz}ikߘ(v!@1Ҥw-6'*On? '5?U\CzE+#D(T|3y?t~BŻ|D4"mǹn*r{XQ CSRvDv%kM]>-j.ht %Dމ-(e7u\8Tux}Z|{uث]sŚ&QDTSdc,*շ8ڄvL_%_7QLz[nj-ӃpZyP=:JrrDu1j>Q"0:O,0ϼ0jPsT"3H2@Wq.l*rVdvyḨ.)X=$1aR 5'Cd#t)nyf4x2~M`ӊCOYLӟ&*歶 Ne8MuowKTN]d~Xԩʳ}%D:$+izUBVLMY-)zJDr=BX-[+br`6ȋ¸,#Doڽ@sF» 6@l.T Pe??㊧~r NSOOc.ab"RU}IP vءMwNgq]l r2Q܌() Tc|ALz۶ޜ,> 0勞~82gq XG~2gYѾYOߏÀP<oHݩidx_mWjy6UVzş3V܎stL~Gj@tʯ0'}^nuan5W>DqiV?*CLmR+IkIXis Sc7oHk(usqϲ=#T5 ~< # ֫n VP-٬>V$<$\4w̵0mpA! #D?v."F ވ_%ITQ+d׈jx_&ê_&fb*=ϪSu|0u&<4ur 1x?N{/vG)zx}o}N=zx;y*W⥟E*+C|/30/q̔{[e&m4'o&yBwgм`:,Owm| ZӝCJ}OUd{-orpact/tests/0000755000175000017500000000000014165535756012700 5ustar nileshnileshrpact/tests/testthat/0000755000175000017500000000000014165541122014520 5ustar nileshnileshrpact/tests/testthat/test-f_analysis_enrichment_survival.R0000644000175000017500000007317614154142422024133 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_analysis_enrichment_survival.R ## | Creation date: 08 December 2021, 09:05:31 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Analysis Enrichment Survival Function") test_that("'getAnalysisResults': enrichment survival, one sub-population, non-stratified analysis, select S1 at second, gMax = 2", { # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentSurvival} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedTestEnrichmentSurvival} # @refFS[Formula]{fs:testStatisticEnrichmentSurvival} S1 <- getDataset( events = c(37, 35, 22), logRanks = c(1.66, 1.38, 1.22), allocationRatios = c(1,1,1) ) F <- getDataset( events = c(66, 55, NA), logRanks = c(1.98, 1.57, NA), allocationRatios = c(1,1,NA) ) dataInput1 <- getDataset(S1 = S1, F = F) ## Comparison of the results of DatasetSurvival object 'dataInput1' with expected results expect_equal(dataInput1$events, c(37, 66, 35, 55, 22, NA_real_)) expect_equal(dataInput1$allocationRatios, c(1, 1, 1, 1, 1, NA_real_), tolerance = 1e-07) expect_equal(dataInput1$logRanks, c(1.66, 1.98, 1.38, 1.57, 1.22, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(dataInput1), NA))) expect_output(print(dataInput1)$show()) invisible(capture.output(expect_error(summary(dataInput1), NA))) expect_output(summary(dataInput1)$show()) dataInput1CodeBased <- eval(parse(text = getObjectRCode(dataInput1, stringWrapParagraphWidth = NULL))) expect_equal(dataInput1CodeBased$events, dataInput1$events, tolerance = 1e-05) expect_equal(dataInput1CodeBased$allocationRatios, dataInput1$allocationRatios, tolerance = 1e-05) expect_equal(dataInput1CodeBased$logRanks, dataInput1$logRanks, tolerance = 1e-05) expect_type(names(dataInput1), "character") df <- as.data.frame(dataInput1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(dataInput1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design1 <- getDesignInverseNormal(kMax = 3, typeOfDesign = "asP", typeBetaSpending = "bsKD", gammaB = 1.3, alpha = 0.025, informationRates = c(0.4, 0.7, 1), bindingFutility = FALSE, beta = 0.1) x1 <- getAnalysisResults(design = design1, dataInput = dataInput1, directionUpper = TRUE, stage = 3, allocationRatioPlanned = 1, intersectionTest = "SpiessensDebois") ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results expect_equal(x1$thetaH1[1, ], 1.6657832, tolerance = 1e-07) expect_equal(x1$thetaH1[2, ], NA_real_) expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.082268614, 0.17873234, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.10062364, 0.20651274, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(0.77807449, 0.90042909, 0.98057908), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(0.89663713, 0.9859619, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(3.8287647, 3.0779079, 2.8418481), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(2.9564481, 2.5412465, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[1, ], c(0.09262834, 0.035310721, 0.016798032), tolerance = 1e-07) expect_equal(x1$repeatedPValues[2, ], c(0.074049848, 0.03027247, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$thetaH1, x1$thetaH1, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() x2 <- getAnalysisResults(design = design1, dataInput = dataInput1, directionUpper = TRUE, stage = 3, allocationRatioPlanned = 1, intersectionTest = "Sidak") ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x2' with expected results expect_equal(x2$thetaH1[1, ], 1.6657832, tolerance = 1e-07) expect_equal(x2$thetaH1[2, ], NA_real_) expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.082268614, 0.14135111, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.08442718, 0.14135111, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(0.76355966, 0.87078132, 0.95099133), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(0.88408367, 0.96064864, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(3.9015478, 3.1815164, 2.9283489), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(2.9984283, 2.606883, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[1, ], c(0.09262834, 0.044241863, 0.02067471), tolerance = 1e-07) expect_equal(x2$repeatedPValues[2, ], c(0.090100155, 0.044241863, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$thetaH1, x2$thetaH1, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design2 <- getDesignFisher(kMax = 3, method = "equalAlpha", alpha = 0.025, informationRates = c(0.4, 0.7, 1)) x3 <- getAnalysisResults(design = design2, dataInput = dataInput1, stratifiedAnalysis = TRUE, directionUpper = TRUE, stage = 2, nPlanned = 30, allocationRatioPlanned = 1, intersectionTest = "SpiessensDebois") ## Comparison of the results of AnalysisResultsEnrichmentFisher object 'x3' with expected results expect_equal(x3$thetaH1[1, ], 1.6607445, tolerance = 1e-07) expect_equal(x3$thetaH1[2, ], 1.5814324, tolerance = 1e-07) expect_equal(x3$conditionalRejectionProbabilities[1, ], c(0.058300881, 0.080849353, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalRejectionProbabilities[2, ], c(0.073230522, 0.100897, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalPower[1, ], c(NA_real_, NA_real_, 0.49594042), tolerance = 1e-07) expect_equal(x3$conditionalPower[2, ], c(NA_real_, NA_real_, 0.49151681), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalLowerBounds[1, ], c(0.77887144, 0.87495484, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalLowerBounds[2, ], c(0.89732462, 0.9655584, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds[1, ], c(3.8248463, 3.1694643, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds[2, ], c(2.9541829, 2.6004038, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues[1, ], c(0.086600177, 0.047636937, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues[2, ], c(0.070085432, 0.040358509, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$thetaH1, x3$thetaH1, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults': enrichment survival, one sub-population, stratified data input, select S1 at first, gMax = 2", { # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentSurvival} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedTestEnrichmentSurvival} # @refFS[Formula]{fs:testStatisticEnrichmentSurvival} S1 <- getDataset( overallExpectedEvents = c(13.4, 35.4, 43.7), overallEvents = c(16, 38, 47), overallVarianceEvents = c(2.8, 4.7, 3.4), overallAllocationRatios = c(1, 1, 1) ) R <- getDataset( overallExpectedEvents = c(23.3, NA, NA), overallEvents = c(27, NA, NA), overallVarianceEvents = c(3.9, NA, NA), overallAllocationRatios = c(1, NA, NA) ) dataInput2 <- getDataset(S1 = S1, R = R) ## Comparison of the results of DatasetEnrichmentSurvival object 'dataInput2' with expected results expect_equal(dataInput2$events, c(16, 27, 22, NA_real_, 9, NA_real_)) expect_equal(dataInput2$allocationRatios, c(1, 1, 1, NA_real_, 1, NA_real_), tolerance = 1e-07) expect_equal(dataInput2$expectedEvents, c(13.4, 23.3, 22, NA_real_, 8.3, NA_real_), tolerance = 1e-07) expect_equal(dataInput2$varianceEvents, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(dataInput2), NA))) expect_output(print(dataInput2)$show()) invisible(capture.output(expect_error(summary(dataInput2), NA))) expect_output(summary(dataInput2)$show()) dataInput2CodeBased <- eval(parse(text = getObjectRCode(dataInput2, stringWrapParagraphWidth = NULL))) expect_equal(dataInput2CodeBased$events, dataInput2$events, tolerance = 1e-05) expect_equal(dataInput2CodeBased$allocationRatios, dataInput2$allocationRatios, tolerance = 1e-05) expect_equal(dataInput2CodeBased$expectedEvents, dataInput2$expectedEvents, tolerance = 1e-05) expect_equal(dataInput2CodeBased$varianceEvents, dataInput2$varianceEvents, tolerance = 1e-05) expect_type(names(dataInput2), "character") df <- as.data.frame(dataInput2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(dataInput2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design1 <- getDesignInverseNormal(kMax = 3, typeOfDesign = "asP", typeBetaSpending = "bsKD", gammaB = 1.3, alpha = 0.025, informationRates = c(0.4, 0.7, 1), bindingFutility = FALSE, beta = 0.1) x4 <- getAnalysisResults(design = design1, dataInput = dataInput2, stratifiedAnalysis = TRUE, directionUpper = TRUE, stage = 2, nPlanned = 30, thetaH1 = 2.5, allocationRatioPlanned = 1, intersectionTest = "SpiessensDebois") ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x4' with expected results expect_equal(x4$conditionalRejectionProbabilities[1, ], c(0.066531397, 0.014937437, NA_real_), tolerance = 1e-07) expect_equal(x4$conditionalRejectionProbabilities[2, ], c(0.21112037, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$conditionalPower[1, ], c(NA_real_, NA_real_, 0.63217527), tolerance = 1e-07) expect_equal(x4$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x4$repeatedConfidenceIntervalLowerBounds[1, ], c(0.63929986, 0.68758318, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalLowerBounds[2, ], c(0.99553926, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalUpperBounds[1, ], c(7.397772, 3.5674257, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalUpperBounds[2, ], c(4.4332688, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedPValues[1, ], c(0.11491566, 0.11491566, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedPValues[2, ], c(0.026005739, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults': enrichment survival, two sub-populations, non-stratified analysis, select S1 and S2 at first IA, select S1 at second, gMax = 3", { .skipTestIfDisabled() # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} # @refFS[Formula]{fs:testStatisticEnrichmentRates} design1 <- getDesignInverseNormal(kMax = 3, typeOfDesign = "asP", typeBetaSpending = "bsKD", gammaB = 1.3, alpha = 0.02, informationRates = c(0.4, 0.7, 1), bindingFutility = FALSE, beta = 0.1) F <- getDataset( events = c(66, NA, NA), logRanks = -c(2.18, NA, NA) ) S1 <- getDataset( events = c(37, 13, 26), logRanks = -c(1.66, 1.239, 0.785) ) S2 <- getDataset( events = c(31, 18, NA), logRanks = -c(1.98, 1.064, NA) ) dataInput3 <- getDataset(S1 = S1, S2 = S2, F = F) ## Comparison of the results of DatasetSurvival object 'dataInput3' with expected results expect_equal(dataInput3$events, c(37, 31, 66, 13, 18, NA_real_, 26, NA_real_, NA_real_)) expect_equal(dataInput3$allocationRatios, c(1, 1, 1, 1, 1, NA_real_, 1, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(dataInput3$logRanks, c(-1.66, -1.98, -2.18, -1.239, -1.064, NA_real_, -0.785, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(dataInput3), NA))) expect_output(print(dataInput3)$show()) invisible(capture.output(expect_error(summary(dataInput3), NA))) expect_output(summary(dataInput3)$show()) dataInput3CodeBased <- eval(parse(text = getObjectRCode(dataInput3, stringWrapParagraphWidth = NULL))) expect_equal(dataInput3CodeBased$events, dataInput3$events, tolerance = 1e-05) expect_equal(dataInput3CodeBased$allocationRatios, dataInput3$allocationRatios, tolerance = 1e-05) expect_equal(dataInput3CodeBased$logRanks, dataInput3$logRanks, tolerance = 1e-05) expect_type(names(dataInput3), "character") df <- as.data.frame(dataInput3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(dataInput3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x1 <- getAnalysisResults(design = design1, dataInput = dataInput3, directionUpper = FALSE, stage = 2, nPlanned = 30, allocationRatioPlanned = 1, intersectionTest = "Sidak") ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results expect_equal(x1$thetaH1[1, ], 0.55845203, tolerance = 1e-07) expect_equal(x1$thetaH1[2, ], 0.53035001, tolerance = 1e-07) expect_equal(x1$thetaH1[3, ], NA_real_) expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.063444982, 0.051842822, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.065210902, 0.051842822, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalRejectionProbabilities[3, ], c(0.070888966, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.48733039), tolerance = 1e-07) expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, 0.54365075), tolerance = 1e-07) expect_equal(x1$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(0.23870488, 0.23701869, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(0.18637801, 0.22932092, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[3, ], c(0.30101343, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(1.406238, 1.2861572, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(1.2936975, 1.2386982, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[3, ], c(1.1356924, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[1, ], c(0.09262834, 0.074349301, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[2, ], c(0.090100155, 0.074349301, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[3, ], c(0.082670093, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$thetaH1, x1$thetaH1, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults': enrichment survival, two sub-populations, stratified analysis, select S1 and S2 at first IA, select S1 at second, gMax = 3", { # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} # @refFS[Formula]{fs:testStatisticEnrichmentRates} S1 <- getDataset( overallExpectedEvents = c(13.4, 35.4, 43.7), overallEvents = c(16, 37, 47), overallVarianceEvents = c(2.8, 4.7, 3.4), overallAllocationRatios = c(1, 1, 1) ) S2 <- getDataset( overallExpectedEvents = c(11.5, 31.1, NA), overallEvents = c(15, 33, NA), overallVarianceEvents = c(2.2, 4.4, NA), overallAllocationRatios = c(1, 1, NA) ) S12 <- getDataset( overallExpectedEvents = c(10.1, 29.6, 39.1), overallEvents = c(11, 31, 42), overallVarianceEvents = c(2.8, 4.7, 3.4), overallAllocationRatios = c(1, 1, 1) ) R <- getDataset( overallExpectedEvents = c(23.3, NA, NA), overallEvents = c(25, NA, NA), overallVarianceEvents = c(3.9, NA, NA), overallAllocationRatios = c(1, NA, NA) ) dataInput4 <- getDataset(S1 = S1, S2 = S2, S12 = S12, R = R) ## Comparison of the results of DatasetEnrichmentSurvival object 'dataInput4' with expected results expect_equal(dataInput4$events, c(16, 15, 11, 25, 21, 18, 20, NA_real_, 10, NA_real_, 11, NA_real_)) expect_equal(dataInput4$allocationRatios, c(1, 1, 1, 1, 1, 1, 1, NA_real_, 1, NA_real_, 1, NA_real_), tolerance = 1e-07) expect_equal(dataInput4$expectedEvents, c(13.4, 11.5, 10.1, 23.3, 22, 19.6, 19.5, NA_real_, 8.3, NA_real_, 9.5, NA_real_), tolerance = 1e-07) expect_equal(dataInput4$varianceEvents, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(dataInput4), NA))) expect_output(print(dataInput4)$show()) invisible(capture.output(expect_error(summary(dataInput4), NA))) expect_output(summary(dataInput4)$show()) dataInput4CodeBased <- eval(parse(text = getObjectRCode(dataInput4, stringWrapParagraphWidth = NULL))) expect_equal(dataInput4CodeBased$events, dataInput4$events, tolerance = 1e-05) expect_equal(dataInput4CodeBased$allocationRatios, dataInput4$allocationRatios, tolerance = 1e-05) expect_equal(dataInput4CodeBased$expectedEvents, dataInput4$expectedEvents, tolerance = 1e-05) expect_equal(dataInput4CodeBased$varianceEvents, dataInput4$varianceEvents, tolerance = 1e-05) expect_type(names(dataInput4), "character") df <- as.data.frame(dataInput4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(dataInput4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design1 <- getDesignInverseNormal(kMax = 3, typeOfDesign = "asP", typeBetaSpending = "bsKD", gammaB = 1.3, alpha = 0.02, informationRates = c(0.4, 0.7, 1), bindingFutility = FALSE, beta = 0.1) x2 <- getAnalysisResults(design = design1, dataInput = dataInput4, stratifiedAnalysis = TRUE, directionUpper = TRUE, stage = 2, nPlanned = 30, thetaH1 = 2, allocationRatioPlanned = 1, intersectionTest = "Sidak") ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x2' with expected results expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.04301093, 0.0010677592, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.063395249, 0.0010677592, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalRejectionProbabilities[3, ], c(0.15397803, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, 0.12050895), tolerance = 1e-07) expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, 0.12050895), tolerance = 1e-07) expect_equal(x2$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(0.62578554, 0.64439023, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(0.75127376, 0.66639091, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[3, ], c(0.96321371, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(4.9893102, 2.8192192, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(6.2314391, 3.096928, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[3, ], c(3.5981379, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[1, ], c(0.13298203, 0.13298203, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[2, ], c(0.092701773, 0.092701773, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[3, ], c(0.031299575, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) rpact/tests/testthat/test-f_design_fisher_combination_test.R0000644000175000017500000006135114154142422024363 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_design_fisher_combination_test.R ## | Creation date: 08 December 2021, 09:08:49 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing the Fisher Design Functionality") test_that("'getDesignFisher' with default parameters: parameters and results are as expected", { # @refFS[Tab.]{fs:tab:output:getDesignFisher} # @refFS[Formula]{fs:FisherCombinationEqualAlpha} designFisher0 <- getDesignFisher() ## Comparison of the results of TrialDesignFisher object 'designFisher0' with expected results expect_equal(designFisher0$alphaSpent, c(0.012308547, 0.01962413, 0.025), tolerance = 1e-07) expect_equal(designFisher0$criticalValues, c(0.012308547, 0.0016635923, 0.00029106687), tolerance = 1e-07) expect_equal(designFisher0$stageLevels, c(0.012308547, 0.012308547, 0.012308547), tolerance = 1e-07) expect_equal(designFisher0$scale, c(1, 1)) expect_equal(designFisher0$nonStochasticCurtailment, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(designFisher0), NA))) expect_output(print(designFisher0)$show()) invisible(capture.output(expect_error(summary(designFisher0), NA))) expect_output(summary(designFisher0)$show()) designFisher0CodeBased <- eval(parse(text = getObjectRCode(designFisher0, stringWrapParagraphWidth = NULL))) expect_equal(designFisher0CodeBased$alphaSpent, designFisher0$alphaSpent, tolerance = 1e-05) expect_equal(designFisher0CodeBased$criticalValues, designFisher0$criticalValues, tolerance = 1e-05) expect_equal(designFisher0CodeBased$stageLevels, designFisher0$stageLevels, tolerance = 1e-05) expect_equal(designFisher0CodeBased$scale, designFisher0$scale, tolerance = 1e-05) expect_equal(designFisher0CodeBased$nonStochasticCurtailment, designFisher0$nonStochasticCurtailment, tolerance = 1e-05) expect_type(names(designFisher0), "character") df <- as.data.frame(designFisher0) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(designFisher0) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getDesignFisher' with kMax = 4: parameters and results are as expected for different arguments", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getDesignFisher} # @refFS[Formula]{fs:FisherCombinationEqualAlpha} designFisher1 <- getDesignFisher(kMax = 4) ## Comparison of the results of TrialDesignFisher object 'designFisher1' with expected results expect_equal(designFisher1$alphaSpent, c(0.010404785, 0.016661203, 0.021286477, 0.025), tolerance = 1e-07) expect_equal(designFisher1$criticalValues, c(0.010404785, 0.0013703718, 0.00023506069, 4.5812899e-05), tolerance = 1e-07) expect_equal(designFisher1$stageLevels, c(0.010404785, 0.010404785, 0.010404785, 0.010404785), tolerance = 1e-07) expect_equal(designFisher1$scale, c(1, 1, 1)) expect_equal(designFisher1$nonStochasticCurtailment, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(designFisher1), NA))) expect_output(print(designFisher1)$show()) invisible(capture.output(expect_error(summary(designFisher1), NA))) expect_output(summary(designFisher1)$show()) designFisher1CodeBased <- eval(parse(text = getObjectRCode(designFisher1, stringWrapParagraphWidth = NULL))) expect_equal(designFisher1CodeBased$alphaSpent, designFisher1$alphaSpent, tolerance = 1e-05) expect_equal(designFisher1CodeBased$criticalValues, designFisher1$criticalValues, tolerance = 1e-05) expect_equal(designFisher1CodeBased$stageLevels, designFisher1$stageLevels, tolerance = 1e-05) expect_equal(designFisher1CodeBased$scale, designFisher1$scale, tolerance = 1e-05) expect_equal(designFisher1CodeBased$nonStochasticCurtailment, designFisher1$nonStochasticCurtailment, tolerance = 1e-05) expect_type(names(designFisher1), "character") df <- as.data.frame(designFisher1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(designFisher1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getDesignFisher} # @refFS[Formula]{fs:FisherCombinationEqualAlpha} designFisher2 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7,0.6,0.5), informationRates = c(0.1,0.3,0.7,1)) ## Comparison of the results of TrialDesignFisher object 'designFisher2' with expected results expect_equal(designFisher2$alphaSpent, c(0.010565317, 0.017774885, 0.022713904, 0.025), tolerance = 1e-07) expect_equal(designFisher2$criticalValues, c(0.010565317, 0.00031144789, 2.8609076e-06, 1.4533579e-07), tolerance = 1e-07) expect_equal(designFisher2$stageLevels, c(0.010565317, 0.010565317, 0.010565317, 0.010565317), tolerance = 1e-07) expect_equal(designFisher2$scale, c(1.4142136, 2, 1.7320508), tolerance = 1e-07) expect_equal(designFisher2$nonStochasticCurtailment, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(designFisher2), NA))) expect_output(print(designFisher2)$show()) invisible(capture.output(expect_error(summary(designFisher2), NA))) expect_output(summary(designFisher2)$show()) designFisher2CodeBased <- eval(parse(text = getObjectRCode(designFisher2, stringWrapParagraphWidth = NULL))) expect_equal(designFisher2CodeBased$alphaSpent, designFisher2$alphaSpent, tolerance = 1e-05) expect_equal(designFisher2CodeBased$criticalValues, designFisher2$criticalValues, tolerance = 1e-05) expect_equal(designFisher2CodeBased$stageLevels, designFisher2$stageLevels, tolerance = 1e-05) expect_equal(designFisher2CodeBased$scale, designFisher2$scale, tolerance = 1e-05) expect_equal(designFisher2CodeBased$nonStochasticCurtailment, designFisher2$nonStochasticCurtailment, tolerance = 1e-05) expect_type(names(designFisher2), "character") df <- as.data.frame(designFisher2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(designFisher2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getDesignFisher} # @refFS[Formula]{fs:FisherCombinationFullAlpha} designFisher3 <- getDesignFisher(kMax = 4, method = "fullAlpha") ## Comparison of the results of TrialDesignFisher object 'designFisher3' with expected results expect_equal(designFisher3$alphaSpent, c(0.00015574772, 0.0015212305, 0.0075070105, 0.025), tolerance = 1e-07) expect_equal(designFisher3$criticalValues, c(0.00015574772, 0.00015574772, 0.00015574772, 0.00015574772), tolerance = 1e-07) expect_equal(designFisher3$stageLevels, c(0.00015574772, 0.0015212305, 0.0075070105, 0.025), tolerance = 1e-07) expect_equal(designFisher3$scale, c(1, 1, 1)) expect_equal(designFisher3$nonStochasticCurtailment, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(designFisher3), NA))) expect_output(print(designFisher3)$show()) invisible(capture.output(expect_error(summary(designFisher3), NA))) expect_output(summary(designFisher3)$show()) designFisher3CodeBased <- eval(parse(text = getObjectRCode(designFisher3, stringWrapParagraphWidth = NULL))) expect_equal(designFisher3CodeBased$alphaSpent, designFisher3$alphaSpent, tolerance = 1e-05) expect_equal(designFisher3CodeBased$criticalValues, designFisher3$criticalValues, tolerance = 1e-05) expect_equal(designFisher3CodeBased$stageLevels, designFisher3$stageLevels, tolerance = 1e-05) expect_equal(designFisher3CodeBased$scale, designFisher3$scale, tolerance = 1e-05) expect_equal(designFisher3CodeBased$nonStochasticCurtailment, designFisher3$nonStochasticCurtailment, tolerance = 1e-05) expect_type(names(designFisher3), "character") df <- as.data.frame(designFisher3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(designFisher3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getDesignFisher} # @refFS[Formula]{fs:FisherCombinationFullAlpha} designFisher4 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7,0.6,0.5), informationRates = c(0.1,0.3,0.7,1), method = "fullAlpha") ## Comparison of the results of TrialDesignFisher object 'designFisher4' with expected results expect_equal(designFisher4$alphaSpent, c(0.0075234886, 0.012807964, 0.016496254, 0.025), tolerance = 1e-07) expect_equal(designFisher4$criticalValues, c(0.0075234886, 0.00019010097, 1.4149989e-06, 1.0550077e-06), tolerance = 1e-07) expect_equal(designFisher4$stageLevels, c(0.0075234886, 0.0075234886, 0.0075234886, 0.025), tolerance = 1e-07) expect_equal(designFisher4$scale, c(1.4142136, 2, 1.7320508), tolerance = 1e-07) expect_equal(designFisher4$nonStochasticCurtailment, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(designFisher4), NA))) expect_output(print(designFisher4)$show()) invisible(capture.output(expect_error(summary(designFisher4), NA))) expect_output(summary(designFisher4)$show()) designFisher4CodeBased <- eval(parse(text = getObjectRCode(designFisher4, stringWrapParagraphWidth = NULL))) expect_equal(designFisher4CodeBased$alphaSpent, designFisher4$alphaSpent, tolerance = 1e-05) expect_equal(designFisher4CodeBased$criticalValues, designFisher4$criticalValues, tolerance = 1e-05) expect_equal(designFisher4CodeBased$stageLevels, designFisher4$stageLevels, tolerance = 1e-05) expect_equal(designFisher4CodeBased$scale, designFisher4$scale, tolerance = 1e-05) expect_equal(designFisher4CodeBased$nonStochasticCurtailment, designFisher4$nonStochasticCurtailment, tolerance = 1e-05) expect_type(names(designFisher4), "character") df <- as.data.frame(designFisher4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(designFisher4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getDesignFisher} # @refFS[Formula]{fs:FisherCombinationNoTreatmentStageInteraction} designFisher5 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7,0.6,0.5), method = "noInteraction") ## Comparison of the results of TrialDesignFisher object 'designFisher5' with expected results expect_equal(designFisher5$alphaSpent, c(0.0098603693, 0.012073314, 0.018133935, 0.025), tolerance = 1e-07) expect_equal(designFisher5$criticalValues, c(0.0098603693, 0.00051915905, 0.00031149543, 0.00015574772), tolerance = 1e-07) expect_equal(designFisher5$stageLevels, c(0.0098603693, 0.0044457148, 0.012979977, 0.025), tolerance = 1e-07) expect_equal(designFisher5$scale, c(1, 1, 1)) expect_equal(designFisher5$nonStochasticCurtailment, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(designFisher5), NA))) expect_output(print(designFisher5)$show()) invisible(capture.output(expect_error(summary(designFisher5), NA))) expect_output(summary(designFisher5)$show()) designFisher5CodeBased <- eval(parse(text = getObjectRCode(designFisher5, stringWrapParagraphWidth = NULL))) expect_equal(designFisher5CodeBased$alphaSpent, designFisher5$alphaSpent, tolerance = 1e-05) expect_equal(designFisher5CodeBased$criticalValues, designFisher5$criticalValues, tolerance = 1e-05) expect_equal(designFisher5CodeBased$stageLevels, designFisher5$stageLevels, tolerance = 1e-05) expect_equal(designFisher5CodeBased$scale, designFisher5$scale, tolerance = 1e-05) expect_equal(designFisher5CodeBased$nonStochasticCurtailment, designFisher5$nonStochasticCurtailment, tolerance = 1e-05) expect_type(names(designFisher5), "character") df <- as.data.frame(designFisher5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(designFisher5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getDesignFisher} # @refFS[Formula]{fs:FisherCombinationNoTreatmentStageInteraction} designFisher6 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7,0.6,0.5), informationRates = c(0.1,0.3,0.7,1), method = "noInteraction") ## Comparison of the results of TrialDesignFisher object 'designFisher6' with expected results expect_equal(designFisher6$alphaSpent, c(0.01128689, 0.011490625, 0.016266616, 0.025), tolerance = 1e-07) expect_equal(designFisher6$criticalValues, c(0.01128689, 2.0322622e-06, 1.5741835e-06, 1.0550077e-06), tolerance = 1e-07) expect_equal(designFisher6$stageLevels, c(0.01128689, 0.0003175156, 0.0079214091, 0.025), tolerance = 1e-07) expect_equal(designFisher6$scale, c(1.4142136, 2, 1.7320508), tolerance = 1e-07) expect_equal(designFisher6$nonStochasticCurtailment, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(designFisher6), NA))) expect_output(print(designFisher6)$show()) invisible(capture.output(expect_error(summary(designFisher6), NA))) expect_output(summary(designFisher6)$show()) designFisher6CodeBased <- eval(parse(text = getObjectRCode(designFisher6, stringWrapParagraphWidth = NULL))) expect_equal(designFisher6CodeBased$alphaSpent, designFisher6$alphaSpent, tolerance = 1e-05) expect_equal(designFisher6CodeBased$criticalValues, designFisher6$criticalValues, tolerance = 1e-05) expect_equal(designFisher6CodeBased$stageLevels, designFisher6$stageLevels, tolerance = 1e-05) expect_equal(designFisher6CodeBased$scale, designFisher6$scale, tolerance = 1e-05) expect_equal(designFisher6CodeBased$nonStochasticCurtailment, designFisher6$nonStochasticCurtailment, tolerance = 1e-05) expect_type(names(designFisher6), "character") df <- as.data.frame(designFisher6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(designFisher6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getDesignFisher} # @refFS[Formula]{fs:FisherCombinationUserDefinedAlphaSpending} designFisher7 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7,0.6,0.5), method = "userDefinedAlpha", userAlphaSpending = c(0.01,0.015,0.02,0.025)) ## Comparison of the results of TrialDesignFisher object 'designFisher7' with expected results expect_equal(designFisher7$alphaSpent, c(0.01, 0.015, 0.02, 0.025), tolerance = 1e-07) expect_equal(designFisher7$criticalValues, c(0.01, 0.0011768873, 0.00031357454, 0.00011586425), tolerance = 1e-07) expect_equal(designFisher7$stageLevels, c(0.01, 0.0091148534, 0.013047692, 0.020300118), tolerance = 1e-07) expect_equal(designFisher7$scale, c(1, 1, 1)) expect_equal(designFisher7$nonStochasticCurtailment, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(designFisher7), NA))) expect_output(print(designFisher7)$show()) invisible(capture.output(expect_error(summary(designFisher7), NA))) expect_output(summary(designFisher7)$show()) designFisher7CodeBased <- eval(parse(text = getObjectRCode(designFisher7, stringWrapParagraphWidth = NULL))) expect_equal(designFisher7CodeBased$alphaSpent, designFisher7$alphaSpent, tolerance = 1e-05) expect_equal(designFisher7CodeBased$criticalValues, designFisher7$criticalValues, tolerance = 1e-05) expect_equal(designFisher7CodeBased$stageLevels, designFisher7$stageLevels, tolerance = 1e-05) expect_equal(designFisher7CodeBased$scale, designFisher7$scale, tolerance = 1e-05) expect_equal(designFisher7CodeBased$nonStochasticCurtailment, designFisher7$nonStochasticCurtailment, tolerance = 1e-05) expect_type(names(designFisher7), "character") df <- as.data.frame(designFisher7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(designFisher7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getDesignFisher} # @refFS[Formula]{fs:FisherCombinationUserDefinedAlphaSpending} designFisher8 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7,0.6,0.5), informationRates = c(0.1,0.3,0.7,1), method = "userDefinedAlpha", userAlphaSpending = c(0.01,0.015,0.02,0.025)) ## Comparison of the results of TrialDesignFisher object 'designFisher8' with expected results expect_equal(designFisher8$alphaSpent, c(0.01, 0.015, 0.02, 0.025), tolerance = 1e-07) expect_equal(designFisher8$criticalValues, c(0.01, 0.00018389153, 2.6484943e-06, 5.2344628e-07), tolerance = 1e-07) expect_equal(designFisher8$stageLevels, c(0.01, 0.0073532156, 0.0101804, 0.018500415), tolerance = 1e-07) expect_equal(designFisher8$scale, c(1.4142136, 2, 1.7320508), tolerance = 1e-07) expect_equal(designFisher8$nonStochasticCurtailment, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(designFisher8), NA))) expect_output(print(designFisher8)$show()) invisible(capture.output(expect_error(summary(designFisher8), NA))) expect_output(summary(designFisher8)$show()) designFisher8CodeBased <- eval(parse(text = getObjectRCode(designFisher8, stringWrapParagraphWidth = NULL))) expect_equal(designFisher8CodeBased$alphaSpent, designFisher8$alphaSpent, tolerance = 1e-05) expect_equal(designFisher8CodeBased$criticalValues, designFisher8$criticalValues, tolerance = 1e-05) expect_equal(designFisher8CodeBased$stageLevels, designFisher8$stageLevels, tolerance = 1e-05) expect_equal(designFisher8CodeBased$scale, designFisher8$scale, tolerance = 1e-05) expect_equal(designFisher8CodeBased$nonStochasticCurtailment, designFisher8$nonStochasticCurtailment, tolerance = 1e-05) expect_type(names(designFisher8), "character") df <- as.data.frame(designFisher8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(designFisher8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getDesignFisher': illegal arguments throw exceptions as expected", { expect_error(getDesignFisher(method = C_FISHER_METHOD_USER_DEFINED_ALPHA, userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.025), kMax = 4), paste0("Conflicting arguments: length of 'userAlphaSpending' (5) ", "must be equal to 'kMax' (4)"), fixed = TRUE) expect_error(getDesignFisher(method = C_FISHER_METHOD_USER_DEFINED_ALPHA, userAlphaSpending = c(0.01, 0.02, 0.025), informationRates = c(0.5, 1)), paste0("Conflicting arguments: length of 'userAlphaSpending' (3) ", "must be equal to length of 'informationRates' (2)"), fixed = TRUE) expect_error(getDesignFisher(method = C_FISHER_METHOD_USER_DEFINED_ALPHA, userAlphaSpending = c(0.01, 0.02, 0.025), informationRates = c(0.4, 1)), paste0("Conflicting arguments: length of 'userAlphaSpending' (3) ", "must be equal to length of 'informationRates' (2)"), fixed = TRUE) expect_error(getDesignFisher(method = C_FISHER_METHOD_USER_DEFINED_ALPHA, userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.021)), paste0("'userAlphaSpending' = c(0.01, 0.02, 0.023, 0.023, 0.021) must be a vector that ", "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_5 <= alpha = 0.021"), fixed = TRUE) expect_error(getDesignFisher(method = C_FISHER_METHOD_USER_DEFINED_ALPHA, userAlphaSpending = c(0.01, 0.02, 0.023), alpha = 0.02), paste0("'userAlphaSpending' = c(0.01, 0.02, 0.023) must be a vector that ", "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_3 <= alpha = 0.02"), fixed = TRUE) expect_equal(getDesignFisher(method = C_FISHER_METHOD_USER_DEFINED_ALPHA, userAlphaSpending = c(0.01, 0.02, 0.023))$alpha, 0.023) expect_error(getDesignFisher(method = C_FISHER_METHOD_USER_DEFINED_ALPHA), "Missing argument: parameter 'userAlphaSpending' must be specified in design", fixed = TRUE) expect_error(getDesignFisher(kMax = Inf), paste0("Argument out of bounds: 'kMax' (Inf) is out of bounds [1; ", C_KMAX_UPPER_BOUND_FISHER, "]"), fixed = TRUE) expect_error(getDesignFisher(kMax = -Inf), paste0("Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; ", C_KMAX_UPPER_BOUND_FISHER, "]"), fixed = TRUE) expect_error(getDesignFisher(kMax = -Inf), "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = -10), "Argument out of bounds: 'kMax' (-10) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = -9), "Argument out of bounds: 'kMax' (-9) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = -8), "Argument out of bounds: 'kMax' (-8) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = -7), "Argument out of bounds: 'kMax' (-7) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = -6), "Argument out of bounds: 'kMax' (-6) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = -5), "Argument out of bounds: 'kMax' (-5) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = -4), "Argument out of bounds: 'kMax' (-4) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = -3), "Argument out of bounds: 'kMax' (-3) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = -2), "Argument out of bounds: 'kMax' (-2) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = -1), "Argument out of bounds: 'kMax' (-1) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = 0), "Argument out of bounds: 'kMax' (0) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = 7), "Argument out of bounds: 'kMax' (7) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = 8), "Argument out of bounds: 'kMax' (8) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = 9), "Argument out of bounds: 'kMax' (9) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = 10), "Argument out of bounds: 'kMax' (10) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = 11), "Argument out of bounds: 'kMax' (11) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = 12), "Argument out of bounds: 'kMax' (12) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = 13), "Argument out of bounds: 'kMax' (13) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = 14), "Argument out of bounds: 'kMax' (14) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = 15), "Argument out of bounds: 'kMax' (15) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = 16), "Argument out of bounds: 'kMax' (16) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = Inf), "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; 6]", fixed = TRUE) expect_error(getDesignFisher(kMax = 2, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (2)", fixed = TRUE) expect_error(getDesignFisher(kMax = 3, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (3)", fixed = TRUE) expect_error(getDesignFisher(kMax = 5, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (5)", fixed = TRUE) expect_error(getDesignFisher(kMax = 6, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (6)", fixed = TRUE) expect_error(getDesignFisher(alpha0Vec = c(0, 1)), "Argument out of bounds: 'alpha0Vec' (0, 1) is out of bounds (0; 1]", fixed = TRUE) expect_error(getDesignFisher(alpha0Vec = c(0.1, 1.01)), "Argument out of bounds: 'alpha0Vec' (0.1, 1.01) is out of bounds (0; 1]", fixed = TRUE) }) rpact/tests/testthat/test-f_analysis_enrichment_rates.R0000644000175000017500000010712414154142422023365 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_analysis_enrichment_rates.R ## | Creation date: 08 December 2021, 09:04:57 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Analysis Enrichment Rates Function") test_that("'getAnalysisResults': enrichment rates, one sub-population, non-stratified input, select S1 at second IA, directionUpper = FALSE, gMax = 2", { # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} # @refFS[Formula]{fs:testStatisticEnrichmentRates} design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.02, typeOfDesign = "P", informationRates = c(0.4,0.7,1)) S1 <- getDataset( sampleSize1 = c( 22, 31, 37), sampleSize2 = c( 28, 33, 39), events1 = c( 7, 16, 17), events2 = c( 18, 21, 19) ) F <- getDataset( sampleSize1 = c( 46, 54, NA), sampleSize2 = c( 49, 62, NA), events1 = c( 16, 31, NA), events2 = c( 29, 35, NA) ) dataInput1 <- getDataset(S1 = S1, F = F) ## Comparison of the results of DatasetRates object 'dataInput1' with expected results expect_equal(dataInput1$overallSampleSizes, c(22, 46, 28, 49, 53, 100, 61, 111, 90, NA_real_, 100, NA_real_)) expect_equal(dataInput1$overallEvents, c(7, 16, 18, 29, 23, 47, 39, 64, 40, NA_real_, 58, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(dataInput1), NA))) expect_output(print(dataInput1)$show()) invisible(capture.output(expect_error(summary(dataInput1), NA))) expect_output(summary(dataInput1)$show()) dataInput1CodeBased <- eval(parse(text = getObjectRCode(dataInput1, stringWrapParagraphWidth = NULL))) expect_equal(dataInput1CodeBased$overallSampleSizes, dataInput1$overallSampleSizes, tolerance = 1e-05) expect_equal(dataInput1CodeBased$overallEvents, dataInput1$overallEvents, tolerance = 1e-05) expect_type(names(dataInput1), "character") df <- as.data.frame(dataInput1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(dataInput1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x1 <- getAnalysisResults(design1, dataInput1, stratifiedAnalysis = FALSE, intersectionTest = "SpiessensDebois", allocationRatioPlanned = 0.5, directionUpper = FALSE, normalApproximation = TRUE, stage = 2, nPlanned = c(80)) ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results expect_equal(x1$piTreatments[1, ], 0.43396226, tolerance = 1e-07) expect_equal(x1$piTreatments[2, ], 0.47, tolerance = 1e-07) expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.17935206, 0.13861438, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.17935206, 0.047432959, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.74825599), tolerance = 1e-07) expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, 0.22069678), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.61149697, -0.44933646, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.47492289, -0.29773449, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(0.040178239, 0.029773309, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(0.01873388, 0.065139268, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[1, ], c(0.031827909, 0.031827909, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[2, ], c(0.031827909, 0.031827909, NA_real_), tolerance = 1e-07) expect_equal(x1$piControls[1, ], 0.63934426, tolerance = 1e-07) expect_equal(x1$piControls[2, ], 0.57657658, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$piTreatments, x1$piTreatments, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_equal(x1CodeBased$piControls, x1$piControls, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x2 <- getAnalysisResults(design1, dataInput1, stratifiedAnalysis = FALSE, intersectionTest = "Bonferroni", allocationRatioPlanned = 0.5, directionUpper = FALSE, normalApproximation = TRUE, stage = 2, nPlanned = c(80)) ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x2' with expected results expect_equal(x2$piTreatments[1, ], 0.43396226, tolerance = 1e-07) expect_equal(x2$piTreatments[2, ], 0.47, tolerance = 1e-07) expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.16289564, 0.075460476, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.16289564, 0.047432959, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, 0.62405214), tolerance = 1e-07) expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, 0.22069678), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.61554796, -0.46343398, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.47860094, -0.31516619, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(0.046721663, 0.04412038, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(0.02350439, 0.08157416, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[1, ], c(0.036684009, 0.036684009, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[2, ], c(0.036684009, 0.036684009, NA_real_), tolerance = 1e-07) expect_equal(x2$piControls[1, ], 0.63934426, tolerance = 1e-07) expect_equal(x2$piControls[2, ], 0.57657658, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$piTreatments, x2$piTreatments, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_equal(x2CodeBased$piControls, x2$piControls, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults': enrichment rates, one sub-population, stratified input, select S1 at second IA, directionUpper = FALSE, gMax = 2", { .skipTestIfDisabled() # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} # @refFS[Formula]{fs:testStatisticEnrichmentRates} design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.05, typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.4,0.7,1)) S1 <- getDataset( sampleSize1 = c( 22, 31, 37), sampleSize2 = c( 28, 33, 39), events1 = c( 7, 16, 10), events2 = c( 18, 21, 19) ) R <- getDataset( sampleSize1 = c( 24, 23, NA), sampleSize2 = c( 21, 29, NA), events1 = c( 9, 15, NA), events2 = c( 11, 14, NA) ) dataInput2 <- getDataset(S1 = S1, R = R) ## Comparison of the results of DatasetRates object 'dataInput2' with expected results expect_equal(dataInput2$overallSampleSizes, c(22, 24, 28, 21, 53, 47, 61, 50, 90, NA_real_, 100, NA_real_)) expect_equal(dataInput2$overallEvents, c(7, 9, 18, 11, 23, 24, 39, 25, 33, NA_real_, 58, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(dataInput2), NA))) expect_output(print(dataInput2)$show()) invisible(capture.output(expect_error(summary(dataInput2), NA))) expect_output(summary(dataInput2)$show()) dataInput2CodeBased <- eval(parse(text = getObjectRCode(dataInput2, stringWrapParagraphWidth = NULL))) expect_equal(dataInput2CodeBased$overallSampleSizes, dataInput2$overallSampleSizes, tolerance = 1e-05) expect_equal(dataInput2CodeBased$overallEvents, dataInput2$overallEvents, tolerance = 1e-05) expect_type(names(dataInput2), "character") df <- as.data.frame(dataInput2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(dataInput2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x3 <- getAnalysisResults(design1, dataInput2, stratifiedAnalysis = FALSE, intersectionTest = "Simes", directionUpper = FALSE, normalApproximation = FALSE ) ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x3' with expected results expect_equal(x3$piTreatments[1, ], 0.36666667, tolerance = 1e-07) expect_equal(x3$piTreatments[2, ], NA_real_) expect_equal(x3$conditionalRejectionProbabilities[1, ], c(0.34476337, 0.21123906, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalRejectionProbabilities[2, ], c(0.34476337, 0.16889178, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.62776667, -0.44175544, -0.38366306), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.4897992, -0.29886578, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds[1, ], c(0.066751296, 0.016446874, -0.050014589), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds[2, ], c(0.038157455, 0.063536424, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues[1, ], c(0.10653002, 0.10653002, 0.014413851), tolerance = 1e-07) expect_equal(x3$repeatedPValues[2, ], c(0.10653002, 0.10653002, NA_real_), tolerance = 1e-07) expect_equal(x3$piControls[1, ], 0.58, tolerance = 1e-07) expect_equal(x3$piControls[2, ], NA_real_) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$piTreatments, x3$piTreatments, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-05) expect_equal(x3CodeBased$piControls, x3$piControls, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x4 <- getAnalysisResults(design1, dataInput2, stratifiedAnalysis = TRUE, intersectionTest = "Simes", directionUpper = FALSE, normalApproximation = TRUE ) ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x4' with expected results expect_equal(x4$piTreatments[1, ], 0.36666667, tolerance = 1e-07) expect_equal(x4$piTreatments[2, ], NA_real_) expect_equal(x4$conditionalRejectionProbabilities[1, ], c(0.4519333, 0.45336181, NA_real_), tolerance = 1e-07) expect_equal(x4$conditionalRejectionProbabilities[2, ], c(0.4519333, 0.2823056, NA_real_), tolerance = 1e-07) expect_equal(x4$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x4$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x4$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.62776667, -0.44175544, -0.38366306), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.48811635, -0.29740945, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalUpperBounds[1, ], c(0.066751296, 0.016446874, -0.050014589), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalUpperBounds[2, ], c(0.041874577, 0.064527802, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedPValues[1, ], c(0.07212343, 0.050354903, 0.0033350387), tolerance = 1e-07) expect_equal(x4$repeatedPValues[2, ], c(0.07212343, 0.065501128, NA_real_), tolerance = 1e-07) expect_equal(x4$piControls[1, ], 0.58, tolerance = 1e-07) expect_equal(x4$piControls[2, ], NA_real_) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$piTreatments, x4$piTreatments, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-05) expect_equal(x4CodeBased$piControls, x4$piControls, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults': enrichment rates, more sub-populations, select S1 and S2 at first IA, select S1 at second, directionUpper = TRUE, gMax = 3", { .skipTestIfDisabled() # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} # @refFS[Formula]{fs:testStatisticEnrichmentRates} S1 <- getDataset( sampleSize1 = c( 47, 33, 37), sampleSize2 = c( 48, 47, 39), events1 = c( 18, 13, 17), events2 = c( 12, 11, 9) ) S2 <- getDataset( sampleSize1 = c( 49, NA, NA), sampleSize2 = c( 45, NA, NA), events1 = c( 12, NA, NA), events2 = c( 13, NA, NA) ) S12 <- getDataset( sampleSize1 = c( 35, 42, NA), sampleSize2 = c( 36, 47, NA), events1 = c( 19, 10, NA), events2 = c( 13, 17, NA) ) R <- getDataset( sampleSize1 = c( 43, NA, NA), sampleSize2 = c( 39, NA, NA), events1 = c( 17, NA, NA), events2 = c( 14, NA, NA) ) dataInput3 <- getDataset(S1 = S1, S2 = S2, S12 = S12, R = R) ## Comparison of the results of DatasetRates object 'dataInput3' with expected results expect_equal(dataInput3$overallSampleSizes, c(47, 49, 35, 43, 48, 45, 36, 39, 80, NA_real_, 77, NA_real_, 95, NA_real_, 83, NA_real_, 117, NA_real_, NA_real_, NA_real_, 134, NA_real_, NA_real_, NA_real_)) expect_equal(dataInput3$overallEvents, c(18, 12, 19, 17, 12, 13, 13, 14, 31, NA_real_, 29, NA_real_, 23, NA_real_, 30, NA_real_, 48, NA_real_, NA_real_, NA_real_, 32, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(dataInput3), NA))) expect_output(print(dataInput3)$show()) invisible(capture.output(expect_error(summary(dataInput3), NA))) expect_output(summary(dataInput3)$show()) dataInput3CodeBased <- eval(parse(text = getObjectRCode(dataInput3, stringWrapParagraphWidth = NULL))) expect_equal(dataInput3CodeBased$overallSampleSizes, dataInput3$overallSampleSizes, tolerance = 1e-05) expect_equal(dataInput3CodeBased$overallEvents, dataInput3$overallEvents, tolerance = 1e-05) expect_type(names(dataInput3), "character") df <- as.data.frame(dataInput3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(dataInput3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.05, typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.4,0.7,1)) x1 <- getAnalysisResults(design1, dataInput3, directionUpper = TRUE, stratifiedAnalysis = FALSE, intersectionTest = "Sidak", allocationRatioPlanned = 3, normalApproximation = FALSE, nPlanned = c(80), piControls = c(0.2, NA, NA), piTreatments = c(0.55, NA, NA), stage = 2 ) ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.15297113, 0.049132584, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.034063149, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalRejectionProbabilities[3, ], c(0.064895921, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.89354539), tolerance = 1e-07) expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.062823455, -0.036086146, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.16425035, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[3, ], c(-0.078510363, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(0.35743976, 0.21982849, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(0.25557999, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[3, ], c(0.21491636, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[1, ], c(0.23298603, 0.23298603, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[3, ], c(0.389024, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design2 <- getDesignFisher(kMax = 3, method = "equalAlpha", alpha = 0.05, informationRates = c(0.4, 0.7, 1)) x2 <- getAnalysisResults(design2, dataInput3, directionUpper = TRUE, stratifiedAnalysis = FALSE, intersectionTest = "Sidak", normalApproximation = FALSE, stage = 3 ) ## Comparison of the results of AnalysisResultsEnrichmentFisher object 'x2' with expected results expect_equal(x2$piTreatments[1, ], 0.41025641, tolerance = 1e-07) expect_equal(x2$piTreatments[2, ], NA_real_) expect_equal(x2$piTreatments[3, ], NA_real_) expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.075105953, 0.018243594, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.020009021, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalRejectionProbabilities[3, ], c(0.031471245, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.023654531, -0.034180226, 0.008300518), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.12625532, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[3, ], c(-0.051634044, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(0.32239366, 0.19556, 0.21299371), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(0.21912956, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[3, ], c(0.1890798, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[1, ], c(0.14811777, 0.14811777, 0.07171335), tolerance = 1e-07) expect_equal(x2$repeatedPValues[2, ], c(0.46979052, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[3, ], c(0.32146776, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$piControls[1, ], 0.23880597, tolerance = 1e-07) expect_equal(x2$piControls[2, ], NA_real_) expect_equal(x2$piControls[3, ], NA_real_) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$piTreatments, x2$piTreatments, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_equal(x2CodeBased$piControls, x2$piControls, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults': enrichment rates, more sub-populations, non-stratified input, select S1 and S2 at first IA, select S1 at second, directionUpper = FALSE, gMax = 4", { # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} # @refFS[Formula]{fs:testStatisticEnrichmentRates} S1 <- getDataset( sampleSize1 = c( 84, 94, 25), sampleSize2 = c( 82, 75, 23), events1 = c( 21, 28, 13), events2 = c( 32, 23, 20) ) S2 <- getDataset( sampleSize1 = c( 81, 95, NA), sampleSize2 = c( 84, 64, NA), events1 = c( 26, 29, NA), events2 = c( 31, 26, NA) ) S3 <- getDataset( sampleSize1 = c( 71, NA, NA), sampleSize2 = c( 74, NA, NA), events1 = c( 16, NA, NA), events2 = c( 21, NA, NA) ) F <- getDataset( sampleSize1 =c( 248, NA, NA), sampleSize2 = c( 254, NA, NA), events1 = c( 75, NA, NA), events2 = c( 98, NA, NA) ) R <- getDataset( sampleSize1 =c( 12, NA, NA), sampleSize2 = c( 14, NA, NA), events1 = c( 12, NA, NA), events2 = c( 14, NA, NA) ) dataInput4 <- getDataset(S1 = S1, S2 = S2, S3 = S3, F = F) ## Comparison of the results of DatasetRates object 'dataInput4' with expected results expect_equal(dataInput4$overallSampleSizes, c(84, 81, 71, 248, 82, 84, 74, 254, 178, 176, NA_real_, NA_real_, 157, 148, NA_real_, NA_real_, 203, NA_real_, NA_real_, NA_real_, 180, NA_real_, NA_real_, NA_real_)) expect_equal(dataInput4$overallEvents, c(21, 26, 16, 75, 32, 31, 21, 98, 49, 55, NA_real_, NA_real_, 55, 57, NA_real_, NA_real_, 62, NA_real_, NA_real_, NA_real_, 75, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(dataInput4), NA))) expect_output(print(dataInput4)$show()) invisible(capture.output(expect_error(summary(dataInput4), NA))) expect_output(summary(dataInput4)$show()) dataInput4CodeBased <- eval(parse(text = getObjectRCode(dataInput4, stringWrapParagraphWidth = NULL))) expect_equal(dataInput4CodeBased$overallSampleSizes, dataInput4$overallSampleSizes, tolerance = 1e-05) expect_equal(dataInput4CodeBased$overallEvents, dataInput4$overallEvents, tolerance = 1e-05) expect_type(names(dataInput4), "character") df <- as.data.frame(dataInput4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(dataInput4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.05, typeOfDesign = "asKD", gammaA = 2, informationRates = c(0.4,0.7,1)) x3 <- getAnalysisResults(design1, dataInput4, directionUpper = FALSE, stratifiedAnalysis = FALSE, intersectionTest = "Sidak", allocationRatioPlanned = 1, stage = 3, normalApproximation = TRUE ) ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x3' with expected results expect_equal(x3$piTreatments[1, ], 0.30541872, tolerance = 1e-07) expect_equal(x3$piTreatments[2, ], NA_real_) expect_equal(x3$piTreatments[3, ], NA_real_) expect_equal(x3$piTreatments[4, ], NA_real_) expect_equal(x3$conditionalRejectionProbabilities[1, ], c(0.13745997, 0.082835151, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalRejectionProbabilities[2, ], c(0.023915975, 0.064596491, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalRejectionProbabilities[3, ], c(0.023915975, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalRejectionProbabilities[4, ], c(0.13745997, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$conditionalPower[4, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.33926099, -0.22469085, -0.248011), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.25513224, -0.21555042, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalLowerBounds[3, ], c(-0.26390722, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalLowerBounds[4, ], c(-0.20314824, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds[1, ], c(0.068268243, 0.059220123, -0.0081515649), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds[2, ], c(0.16378176, 0.075550882, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds[3, ], c(0.15232187, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds[4, ], c(0.038730825, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues[1, ], c(0.5, 0.26483774, 0.01063254), tolerance = 1e-07) expect_equal(x3$repeatedPValues[2, ], c(0.5, 0.30264322, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues[3, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues[4, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$piControls[1, ], 0.41666667, tolerance = 1e-07) expect_equal(x3$piControls[2, ], NA_real_) expect_equal(x3$piControls[3, ], NA_real_) expect_equal(x3$piControls[4, ], NA_real_) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$piTreatments, x3$piTreatments, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-05) expect_equal(x3CodeBased$piControls, x3$piControls, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults': enrichment rates, expected warning for empty subsets", { S1 <- getDataset( sampleSize1 = c( 84, 94, 25), sampleSize2 = c( 82, 75, 23), events1 = c( 21, 28, 13), events2 = c( 32, 23, 20) ) S2 <- getDataset( sampleSize1 = c( 81, 95, NA), sampleSize2 = c( 84, 64, NA), events1 = c( 26, 29, NA), events2 = c( 31, 26, NA) ) S3 <- getDataset( sampleSize1 = c( 71, NA, NA), sampleSize2 = c( 74, NA, NA), events1 = c( 16, NA, NA), events2 = c( 21, NA, NA) ) R <- getDataset( sampleSize1 =c( 12, NA, NA), sampleSize2 = c( 14, NA, NA), events1 = c( 12, NA, NA), events2 = c( 14, NA, NA) ) expect_warning(getDataset(S1 = S1, S2 = S2, S3 = S3, R = R), "The 4 undefined subsets S12, S13, S23, S123 were defined as empty subsets", fixed = TRUE) }) rpact/tests/testthat/helper-class_analysis_dataset.R0000644000175000017500000000270214145656365022654 0ustar nileshnilesh## | ## | *Unit tests helper functions* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | getMultipleStageResultsForDataset <- function(dataset, thetaH0 = NA_real_) { stage <- dataset$getNumberOfStages() kMax <- stage + 1 design1 <- getDesignGroupSequential(kMax = kMax) design2 <- getDesignInverseNormal(kMax = kMax) design3 <- getDesignFisher(kMax = kMax) stageResults1 <- getStageResults(design = design1, dataInput = dataset, stage = stage, thetaH0 = thetaH0) stageResults2 <- getStageResults(design = design2, dataInput = dataset, stage = stage, thetaH0 = thetaH0) stageResults3 <- getStageResults(design = design3, dataInput = dataset, stage = stage, thetaH0 = thetaH0) return(list( stageResults1 = stageResults1, stageResults2 = stageResults2, stageResults3 = stageResults3 )) }rpact/tests/testthat/helper-f_core_utilities.R0000644000175000017500000000544214145656365021473 0ustar nileshnilesh## | ## | *Unit tests helper functions* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | getTestInformationRatesDefault <- function(kMax) { return((1:kMax) / kMax) } getTestFutilityBoundsDefault <- function(kMax) { return(rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1)) } getTestAlpha0VecDefault <- function(kMax) { return(rep(C_ALPHA_0_VEC_DEFAULT, kMax - 1)) } getTestInformationRates <- function(kMax) { if (kMax == 1L) { return(1) } a <- 0.8 / kMax b <- c() for (i in 1:(kMax - 1)) { b <- c(b, a * i) } return(c(b, 1)) } getTestFutilityBounds <- function(kMax, fisherDesignEnabled = FALSE) { if (kMax < 2) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'kMax' must be >= 2") } if (kMax == 2 && fisherDesignEnabled) { return(0.5) } k <- kMax - 1 futilityBounds <- c(2) k <- k - 1 if (k > 0) { futilityBounds <- c(1, futilityBounds) k <- k - 1 } if (k > 0) { futilityBounds <- c(rep(0, k), futilityBounds) } if (fisherDesignEnabled) { futilityBounds[futilityBounds > 0] <- futilityBounds[futilityBounds > 0] / max(futilityBounds) futilityBounds[futilityBounds == 0] <- 0.01 } return(futilityBounds) } getTestDesign <- function(kMax = NA_real_, informationRates = NA_real_, futilityBounds = NA_real_, designClass = C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL) { design <- NULL currentWarningOption <- getOption("warn") options(warn = -1) if (designClass == C_CLASS_NAME_TRIAL_DESIGN_FISHER) { design <- getDesignFisher( kMax = as.integer(kMax), alpha0Vec = futilityBounds, informationRates = informationRates ) } else if (designClass == C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL) { design <- getDesignGroupSequential( kMax = as.integer(kMax), informationRates = informationRates, futilityBounds = futilityBounds, tolerance = 1e-06 ) } else { design <- getDesignInverseNormal( kMax = as.integer(kMax), informationRates = informationRates, futilityBounds = futilityBounds, tolerance = 1e-06 ) } options(warn = currentWarningOption) return(design) } rpact/tests/testthat/test-f_simulation_multiarm_means.R0000644000175000017500000041122314154142422023407 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_simulation_multiarm_means.R ## | Creation date: 08 December 2021, 09:09:45 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Simulation Multi-Arm Means Function") test_that("'getSimulationMultiArmMeans': several configurations", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmMeans} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmMeansGenerate} # @refFS[Formula]{fs:SimulationMultiArmMeansTestStatistics} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} x1 <- getSimulationMultiArmMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), typeOfShape = "linear", activeArms = 4, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x1' with expected results expect_equal(x1$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x1$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x1$iterations[3, ], c(9, 8, 8, 5)) expect_equal(x1$rejectAtLeastOne, c(0.3, 0.6, 0.8, 0.9), tolerance = 1e-07) expect_equal(unlist(as.list(x1$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0, 0, 0.1, 0.1, 0, 0, 0.1, 0, 0.2, 0.1, 0, 0, 0.3, 0, 0.1, 0, 0, 0.1, 0.1, 0, 0, 0.1, 0, 0.2, 0.3, 0, 0.3, 0.3), tolerance = 1e-07) expect_equal(x1$futilityStop, c(0, 0, 0, 0)) expect_equal(x1$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x1$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x1$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x1$earlyStop[2, ], c(0.1, 0.2, 0.2, 0.5), tolerance = 1e-07) expect_equal(x1$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x1$successPerStage[2, ], c(0.1, 0.2, 0.2, 0.5), tolerance = 1e-07) expect_equal(x1$successPerStage[3, ], c(0.2, 0.4, 0.6, 0.4), tolerance = 1e-07) expect_equal(unlist(as.list(x1$selectedArms)), c(1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0, 0, 1, 0.3, 0.3, 1, 0.4, 0.4, 1, 0, 0, 1, 0.3, 0.2, 1, 0.1, 0.1, 1, 0.3, 0.1, 1, 0.4, 0.4, 1, 0.1, 0, 1, 0.5, 0.4, 1, 0.2, 0.2, 1, 0.5, 0.3, 1, 0.6, 0.3, 1, 1, 0.9, 1, 1, 0.8, 1, 1, 0.8, 1, 1, 0.5), tolerance = 1e-07) expect_equal(x1$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x1$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x1$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x1$expectedNumberOfSubjects, c(268.55306, 310.74423, 296.80608, 214.56859), tolerance = 1e-07) expect_equal(unlist(as.list(x1$sampleSizes)), c(10, 1.1840544, 11.111111, 10, 10, 12.5, 10, 0.74314427, 1.9878756, 10, 0, 0, 10, 7.3350068, 25.517647, 10, 26.989766, 43.604406, 10, 0, 0, 10, 21.344686, 26.724319, 10, 2.6348908, 7.2351621, 10, 21.298615, 12.5, 10, 40, 44.643278, 10, 10, 0, 10, 33.493936, 27.945681, 10, 4.3287276, 16.089351, 10, 25.258173, 25.120998, 10, 23.39578, 28.363338, 10, 44.647888, 71.809601, 10, 62.617108, 84.693757, 10, 66.001318, 71.752151, 10, 54.740466, 55.087656), tolerance = 1e-07) expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$conditionalPowerAchieved[2, ], c(0.046651357, 0.022479034, 0.083769211, 0.082365248), tolerance = 1e-07) expect_equal(x1$conditionalPowerAchieved[3, ], c(0.49123587, 0.2668344, 0.64496483, 0.65218675), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-05) expect_equal(x1CodeBased$rejectAtLeastOne, x1$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x1CodeBased$rejectedArmsPerStage, x1$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$futilityStop, x1$futilityStop, tolerance = 1e-05) expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-05) expect_equal(x1CodeBased$successPerStage, x1$successPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$selectedArms, x1$selectedArms, tolerance = 1e-05) expect_equal(x1CodeBased$numberOfActiveArms, x1$numberOfActiveArms, tolerance = 1e-05) expect_equal(x1CodeBased$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x1CodeBased$sampleSizes, x1$sampleSizes, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x2 <- getSimulationMultiArmMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), typeOfShape = "userDefined", activeArms = 4, plannedSubjects = c(10, 30, 50), stDev = 1.2, adaptations = rep(TRUE, 2), effectMatrix = matrix(c(0.1,0.2,0.3,0.4,0.2,0.3,0.4,0.5), ncol = 4), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x2' with expected results expect_equal(x2$iterations[1, ], c(10, 10)) expect_equal(x2$iterations[2, ], c(10, 10)) expect_equal(x2$iterations[3, ], c(8, 8)) expect_equal(x2$rejectAtLeastOne, c(0.5, 0.6), tolerance = 1e-07) expect_equal(unlist(as.list(x2$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.3, 0, 0, 0, 0, 0.2, 0, 0, 0.2, 0.2, 0, 0, 0.1), tolerance = 1e-07) expect_equal(x2$futilityStop, c(0, 0)) expect_equal(x2$futilityPerStage[1, ], c(0, 0)) expect_equal(x2$futilityPerStage[2, ], c(0, 0)) expect_equal(x2$earlyStop[1, ], c(0, 0)) expect_equal(x2$earlyStop[2, ], c(0.2, 0.2), tolerance = 1e-07) expect_equal(x2$successPerStage[1, ], c(0, 0)) expect_equal(x2$successPerStage[2, ], c(0.2, 0.2), tolerance = 1e-07) expect_equal(x2$successPerStage[3, ], c(0.3, 0.4), tolerance = 1e-07) expect_equal(unlist(as.list(x2$selectedArms)), c(1, 0.1, 0.1, 1, 0.2, 0.2, 1, 0.3, 0.3, 1, 0.4, 0.4, 1, 0.1, 0.1, 1, 0.2, 0, 1, 0.5, 0.3, 1, 0.2, 0.2, 1, 1, 0.8, 1, 1, 0.8), tolerance = 1e-07) expect_equal(x2$numberOfActiveArms[1, ], c(4, 4)) expect_equal(x2$numberOfActiveArms[2, ], c(1, 1)) expect_equal(x2$numberOfActiveArms[3, ], c(1, 1)) expect_equal(x2$expectedNumberOfSubjects, c(238.96461, 281.13648), tolerance = 1e-07) expect_equal(unlist(as.list(x2$sampleSizes)), c(10, 1.1060693, 12.5, 10, 20, 25, 10, 4.7297328, 25.346201, 10, 18.776011, 38.686485, 10, 2.8470245, 10.408309, 10, 11.298615, 0, 10, 26.795872, 25.5, 10, 3.2314462, 14.141225, 10, 35.478699, 73.75451, 10, 53.306071, 77.82771), tolerance = 1e-07) expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_)) expect_equal(x2$conditionalPowerAchieved[2, ], c(0.064857702, 0.041878984), tolerance = 1e-07) expect_equal(x2$conditionalPowerAchieved[3, ], c(0.72573181, 0.45099208), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-05) expect_equal(x2CodeBased$rejectAtLeastOne, x2$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x2CodeBased$rejectedArmsPerStage, x2$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$futilityStop, x2$futilityStop, tolerance = 1e-05) expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-05) expect_equal(x2CodeBased$successPerStage, x2$successPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$selectedArms, x2$selectedArms, tolerance = 1e-05) expect_equal(x2CodeBased$numberOfActiveArms, x2$numberOfActiveArms, tolerance = 1e-05) expect_equal(x2CodeBased$expectedNumberOfSubjects, x2$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() x3 <- getSimulationMultiArmMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), typeOfShape = "sigmoidEmax", gED50 = 2, slope = 0.5, activeArms = 4, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x3' with expected results expect_equal(x3$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x3$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x3$iterations[3, ], c(10, 9, 9, 8)) expect_equal(x3$rejectAtLeastOne, c(0, 0.3, 0.6, 0.7), tolerance = 1e-07) expect_equal(unlist(as.list(x3$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0, 0, 0.1, 0.1, 0, 0, 0, 0, 0.1, 0, 0, 0, 0.2, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.2, 0, 0, 0.4), tolerance = 1e-07) expect_equal(x3$futilityStop, c(0, 0, 0, 0)) expect_equal(x3$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x3$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x3$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x3$earlyStop[2, ], c(0, 0.1, 0.1, 0.2), tolerance = 1e-07) expect_equal(x3$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x3$successPerStage[2, ], c(0, 0.1, 0.1, 0.2), tolerance = 1e-07) expect_equal(x3$successPerStage[3, ], c(0, 0.2, 0.5, 0.5), tolerance = 1e-07) expect_equal(unlist(as.list(x3$selectedArms)), c(1, 0.1, 0.1, 1, 0.3, 0.3, 1, 0.1, 0.1, 1, 0, 0, 1, 0.3, 0.3, 1, 0.3, 0.3, 1, 0, 0, 1, 0.3, 0.2, 1, 0.2, 0.2, 1, 0.2, 0.1, 1, 0.4, 0.4, 1, 0.1, 0, 1, 0.4, 0.4, 1, 0.2, 0.2, 1, 0.5, 0.4, 1, 0.6, 0.6, 1, 1, 1, 1, 1, 0.9, 1, 1, 0.9, 1, 1, 0.8), tolerance = 1e-07) expect_equal(x3$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x3$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x3$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x3$expectedNumberOfSubjects, c(295.76875, 343.71408, 335.10548, 281.56474), tolerance = 1e-07) expect_equal(unlist(as.list(x3$sampleSizes)), c(10, 1.0357205, 10, 10, 30, 33.333333, 10, 0.59871171, 1.0418812, 10, 0, 0, 10, 7.3350068, 22.965882, 10, 16.989766, 27.64836, 10, 0, 0, 10, 21.344686, 16.702699, 10, 13.17796, 20, 10, 15.323901, 2.6274327, 10, 40, 44.444444, 10, 10, 0, 10, 25.447372, 22.922435, 10, 7.2951578, 22.222222, 10, 38.282522, 25.259795, 10, 36.742398, 42.916408, 10, 46.996059, 75.888318, 10, 69.608825, 85.831349, 10, 78.881233, 70.74612, 10, 68.087084, 59.619107), tolerance = 1e-07) expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$conditionalPowerAchieved[2, ], c(0.042062266, 0.013174936, 0.075843331, 0.053971766), tolerance = 1e-07) expect_equal(x3$conditionalPowerAchieved[3, ], c(0.41527426, 0.27301585, 0.35639557, 0.62491311), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-05) expect_equal(x3CodeBased$rejectAtLeastOne, x3$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x3CodeBased$rejectedArmsPerStage, x3$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$futilityStop, x3$futilityStop, tolerance = 1e-05) expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-05) expect_equal(x3CodeBased$successPerStage, x3$successPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$selectedArms, x3$selectedArms, tolerance = 1e-05) expect_equal(x3CodeBased$numberOfActiveArms, x3$numberOfActiveArms, tolerance = 1e-05) expect_equal(x3CodeBased$expectedNumberOfSubjects, x3$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x3CodeBased$sampleSizes, x3$sampleSizes, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x4 <- getSimulationMultiArmMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "all", plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x4' with expected results expect_equal(x4$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x4$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x4$iterations[3, ], c(10, 10, 10, 10)) expect_equal(x4$rejectAtLeastOne, c(0.4, 0.8, 1, 1), tolerance = 1e-07) expect_equal(unlist(as.list(x4$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0.1, 0, 0, 0.1, 0.2, 0, 0, 0.1, 0, 0, 0.3, 0, 0.2, 0.3, 0, 0.6, 0.2, 0, 0, 0.4, 0, 0.1, 0.7, 0, 0.4, 0.6, 0, 0.7, 0.3), tolerance = 1e-07) expect_equal(x4$futilityStop, c(0, 0, 0, 0)) expect_equal(x4$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x4$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x4$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x4$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x4$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x4$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x4$successPerStage[3, ], c(0, 0.1, 0, 0), tolerance = 1e-07) expect_equal(unlist(as.list(x4$selectedArms)), c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)) expect_equal(x4$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x4$numberOfActiveArms[2, ], c(4, 4, 4, 4)) expect_equal(x4$numberOfActiveArms[3, ], c(4, 4, 4, 4)) expect_equal(x4$expectedNumberOfSubjects, c(1050, 891.96665, 849.19143, 705.05343), tolerance = 1e-07) expect_equal(unlist(as.list(x4$sampleSizes)), c(10, 100, 100, 10, 87.259377, 81.133954, 10, 94.901963, 64.936322, 10, 98.210686, 32.8, 10, 100, 100, 10, 87.259377, 81.133954, 10, 94.901963, 64.936322, 10, 98.210686, 32.8, 10, 100, 100, 10, 87.259377, 81.133954, 10, 94.901963, 64.936322, 10, 98.210686, 32.8, 10, 100, 100, 10, 87.259377, 81.133954, 10, 94.901963, 64.936322, 10, 98.210686, 32.8, 10, 100, 100, 10, 87.259377, 81.133954, 10, 94.901963, 64.936322, 10, 98.210686, 32.8), tolerance = 1e-07) expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x4$conditionalPowerAchieved[2, ], c(0.0086377938, 0.22005253, 0.081022458, 0.15135806), tolerance = 1e-07) expect_equal(x4$conditionalPowerAchieved[3, ], c(0.17779298, 0.23451185, 0.45925582, 0.77364695), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-05) expect_equal(x4CodeBased$rejectAtLeastOne, x4$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x4CodeBased$rejectedArmsPerStage, x4$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$futilityStop, x4$futilityStop, tolerance = 1e-05) expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-05) expect_equal(x4CodeBased$successPerStage, x4$successPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$selectedArms, x4$selectedArms, tolerance = 1e-05) expect_equal(x4CodeBased$numberOfActiveArms, x4$numberOfActiveArms, tolerance = 1e-05) expect_equal(x4CodeBased$expectedNumberOfSubjects, x4$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x4CodeBased$sampleSizes, x4$sampleSizes, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x5 <- getSimulationMultiArmMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "rBest", rValue = 2, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x5' with expected results expect_equal(x5$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x5$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x5$iterations[3, ], c(10, 9, 8, 8)) expect_equal(x5$rejectAtLeastOne, c(0.5, 0.9, 1, 0.9), tolerance = 1e-07) expect_equal(unlist(as.list(x5$rejectedArmsPerStage)), c(0, 0, 0, 0, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.2, 0.3, 0, 0.1, 0, 0, 0, 0.1, 0, 0, 0.3, 0, 0.3, 0.2, 0, 0.2, 0.2, 0, 0.1, 0.3, 0, 0.1, 0.4, 0, 0.1, 0.3, 0, 0.6, 0.3), tolerance = 1e-07) expect_equal(x5$futilityStop, c(0, 0, 0, 0)) expect_equal(x5$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x5$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x5$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x5$earlyStop[2, ], c(0, 0.1, 0.2, 0.2), tolerance = 1e-07) expect_equal(x5$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x5$successPerStage[2, ], c(0, 0.1, 0.2, 0.2), tolerance = 1e-07) expect_equal(x5$successPerStage[3, ], c(0, 0.1, 0.2, 0.3), tolerance = 1e-07) expect_equal(unlist(as.list(x5$selectedArms)), c(1, 0.5, 0.5, 1, 0.7, 0.6, 1, 0.1, 0.1, 1, 0.3, 0.3, 1, 0.3, 0.3, 1, 0.3, 0.3, 1, 0.9, 0.7, 1, 0.4, 0.4, 1, 0.5, 0.5, 1, 0.5, 0.5, 1, 0.6, 0.4, 1, 0.4, 0.2, 1, 0.7, 0.7, 1, 0.5, 0.4, 1, 0.4, 0.4, 1, 0.9, 0.7, 1, 1, 1, 1, 1, 0.9, 1, 1, 0.8, 1, 1, 0.8), tolerance = 1e-07) expect_equal(x5$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x5$numberOfActiveArms[2, ], c(2, 2, 2, 2)) expect_equal(x5$numberOfActiveArms[3, ], c(2, 2, 2, 2)) expect_equal(x5$expectedNumberOfSubjects, c(591.09538, 503.05596, 452.93301, 405.41488), tolerance = 1e-07) expect_equal(unlist(as.list(x5$sampleSizes)), c(10, 42.50248, 47.078471, 10, 45.384313, 50.975979, 10, 10, 12.5, 10, 29.554131, 37.5, 10, 15.855942, 30, 10, 22.437029, 19.843895, 10, 72.307665, 59.768075, 10, 30.61074, 15.281075, 10, 47.430714, 50, 10, 35.976108, 53.08315, 10, 50.052941, 40.398451, 10, 31.50186, 5.7250423, 10, 60.784176, 67.078471, 10, 46.971175, 44.173288, 10, 20.632484, 31.869624, 10, 71.666731, 33.506118, 10, 83.286657, 97.078471, 10, 75.384313, 84.038156, 10, 76.496545, 72.268075, 10, 81.666731, 46.006118), tolerance = 1e-07) expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x5$conditionalPowerAchieved[2, ], c(0.061919533, 0.10420825, 0.16753344, 0.13874821), tolerance = 1e-07) expect_equal(x5$conditionalPowerAchieved[3, ], c(0.29816652, 0.52092951, 0.66819594, 0.56533632), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x5), NA))) expect_output(print(x5)$show()) invisible(capture.output(expect_error(summary(x5), NA))) expect_output(summary(x5)$show()) x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-05) expect_equal(x5CodeBased$rejectAtLeastOne, x5$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x5CodeBased$rejectedArmsPerStage, x5$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$futilityStop, x5$futilityStop, tolerance = 1e-05) expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-05) expect_equal(x5CodeBased$successPerStage, x5$successPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$selectedArms, x5$selectedArms, tolerance = 1e-05) expect_equal(x5CodeBased$numberOfActiveArms, x5$numberOfActiveArms, tolerance = 1e-05) expect_equal(x5CodeBased$expectedNumberOfSubjects, x5$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x5CodeBased$sampleSizes, x5$sampleSizes, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x5), "character") df <- as.data.frame(x5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x6 <- getSimulationMultiArmMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "epsilon", epsilonValue = 0.1, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x6' with expected results expect_equal(x6$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x6$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x6$iterations[3, ], c(10, 9, 7, 6)) expect_equal(x6$rejectAtLeastOne, c(0.4, 0.6, 0.8, 0.8), tolerance = 1e-07) expect_equal(unlist(as.list(x6$rejectedArmsPerStage)), c(0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0, 0, 0.2, 0, 0, 0.1, 0, 0, 0, 0, 0.1, 0, 0, 0, 0.2, 0, 0.1, 0.4, 0, 0.3, 0.5, 0, 0.2, 0.3), tolerance = 1e-07) expect_equal(x6$futilityStop, c(0, 0, 0, 0)) expect_equal(x6$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x6$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x6$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x6$earlyStop[2, ], c(0, 0.1, 0.3, 0.4), tolerance = 1e-07) expect_equal(x6$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x6$successPerStage[2, ], c(0, 0.1, 0.3, 0.4), tolerance = 1e-07) expect_equal(x6$successPerStage[3, ], c(0.4, 0.5, 0.5, 0.4), tolerance = 1e-07) expect_equal(unlist(as.list(x6$selectedArms)), c(1, 0.1, 0.1, 1, 0.2, 0.1, 1, 0, 0, 1, 0.1, 0.1, 1, 0.5, 0.4, 1, 0.1, 0, 1, 0.3, 0.2, 1, 0.3, 0.2, 1, 0.3, 0.3, 1, 0.3, 0.3, 1, 0, 0, 1, 0.1, 0, 1, 0.4, 0.4, 1, 0.6, 0.5, 1, 0.8, 0.5, 1, 0.5, 0.3, 1, 1, 1, 1, 1, 0.9, 1, 1, 0.7, 1, 1, 0.6), tolerance = 1e-07) expect_equal(x6$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x6$numberOfActiveArms[2, ], c(1.3, 1.2, 1.1, 1), tolerance = 1e-07) expect_equal(x6$numberOfActiveArms[3, ], c(1.2, 1, 1, 1), tolerance = 1e-07) expect_equal(x6$expectedNumberOfSubjects, c(436.56282, 365.15193, 284.70045, 253.12175), tolerance = 1e-07) expect_equal(unlist(as.list(x6$sampleSizes)), c(10, 4.7999536, 10, 10, 16.971175, 11.111111, 10, 0, 0, 10, 10, 16.666667, 10, 35.332961, 40, 10, 10, 0, 10, 21.400604, 22.595075, 10, 21.344686, 22.270265, 10, 23.218148, 30, 10, 22.202225, 23.298934, 10, 0, 0, 10, 10, 0, 10, 29.860691, 40, 10, 41.405234, 49.459866, 10, 62.809861, 31.890295, 10, 22.672359, 23.636115, 10, 73.351063, 100, 10, 73.607458, 83.869911, 10, 74.210465, 54.485369, 10, 64.017046, 62.573047), tolerance = 1e-07) expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x6$conditionalPowerAchieved[2, ], c(0.024687171, 0.015314975, 0.045856815, 0.050229622), tolerance = 1e-07) expect_equal(x6$conditionalPowerAchieved[3, ], c(0.1883251, 0.40048173, 0.51841906, 0.54348956), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x6), NA))) expect_output(print(x6)$show()) invisible(capture.output(expect_error(summary(x6), NA))) expect_output(summary(x6)$show()) x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-05) expect_equal(x6CodeBased$rejectAtLeastOne, x6$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x6CodeBased$rejectedArmsPerStage, x6$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$futilityStop, x6$futilityStop, tolerance = 1e-05) expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-05) expect_equal(x6CodeBased$successPerStage, x6$successPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$selectedArms, x6$selectedArms, tolerance = 1e-05) expect_equal(x6CodeBased$numberOfActiveArms, x6$numberOfActiveArms, tolerance = 1e-05) expect_equal(x6CodeBased$expectedNumberOfSubjects, x6$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x6CodeBased$sampleSizes, x6$sampleSizes, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x6), "character") df <- as.data.frame(x6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x7 <- getSimulationMultiArmMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x7' with expected results expect_equal(x7$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x7$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x7$iterations[3, ], c(9, 8, 8, 5)) expect_equal(x7$rejectAtLeastOne, c(0.2, 0.4, 0.7, 0.8), tolerance = 1e-07) expect_equal(unlist(as.list(x7$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0.1, 0.1, 0, 0, 0, 0, 0.2, 0.1, 0, 0, 0.3, 0, 0.1, 0, 0, 0.1, 0.1, 0, 0, 0, 0, 0.2, 0.2, 0, 0.3, 0.2), tolerance = 1e-07) expect_equal(x7$futilityStop, c(0, 0, 0, 0)) expect_equal(x7$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x7$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x7$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x7$earlyStop[2, ], c(0.1, 0.2, 0.2, 0.5), tolerance = 1e-07) expect_equal(x7$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x7$successPerStage[2, ], c(0.1, 0.2, 0.2, 0.5), tolerance = 1e-07) expect_equal(x7$successPerStage[3, ], c(0.1, 0.2, 0.5, 0.3), tolerance = 1e-07) expect_equal(unlist(as.list(x7$selectedArms)), c(1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0, 0, 1, 0.3, 0.3, 1, 0.4, 0.4, 1, 0, 0, 1, 0.3, 0.2, 1, 0.1, 0.1, 1, 0.3, 0.1, 1, 0.4, 0.4, 1, 0.1, 0, 1, 0.5, 0.4, 1, 0.2, 0.2, 1, 0.5, 0.3, 1, 0.6, 0.3, 1, 1, 0.9, 1, 1, 0.8, 1, 1, 0.8, 1, 1, 0.5), tolerance = 1e-07) expect_equal(x7$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x7$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x7$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x7$expectedNumberOfSubjects, c(222.21727, 277.8712, 297.53775, 227.3405), tolerance = 1e-07) expect_equal(unlist(as.list(x7$sampleSizes)), c(10, 1.1840544, 1.315616, 10, 10, 12.5, 10, 0.74314427, 0.92893034, 10, 0, 0, 10, 7.3350068, 8.1500075, 10, 26.989766, 33.737207, 10, 0, 0, 10, 21.344686, 40, 10, 2.6348908, 2.9276564, 10, 21.298615, 12.5, 10, 40, 50, 10, 10, 0, 10, 33.493936, 33.674217, 10, 4.3287276, 5.4109095, 10, 25.258173, 21.280514, 10, 23.39578, 27.859565, 10, 44.647888, 46.067497, 10, 62.617108, 64.148116, 10, 66.001318, 72.209444, 10, 54.740466, 67.859565), tolerance = 1e-07) expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x7$conditionalPowerAchieved[2, ], c(0.046651357, 0.022479034, 0.083769211, 0.082365248), tolerance = 1e-07) expect_equal(x7$conditionalPowerAchieved[3, ], c(0.39772697, 0.18083546, 0.60828997, 0.66318671), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x7), NA))) expect_output(print(x7)$show()) invisible(capture.output(expect_error(summary(x7), NA))) expect_output(summary(x7)$show()) x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-05) expect_equal(x7CodeBased$rejectAtLeastOne, x7$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x7CodeBased$rejectedArmsPerStage, x7$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$futilityStop, x7$futilityStop, tolerance = 1e-05) expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-05) expect_equal(x7CodeBased$successPerStage, x7$successPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$selectedArms, x7$selectedArms, tolerance = 1e-05) expect_equal(x7CodeBased$numberOfActiveArms, x7$numberOfActiveArms, tolerance = 1e-05) expect_equal(x7CodeBased$expectedNumberOfSubjects, x7$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x7CodeBased$sampleSizes, x7$sampleSizes, tolerance = 1e-05) expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x7), "character") df <- as.data.frame(x7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x8 <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "all", plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x8' with expected results expect_equal(x8$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x8$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x8$iterations[3, ], c(10, 10, 10, 10)) expect_equal(x8$rejectAtLeastOne, c(0.3, 0.6, 1, 1), tolerance = 1e-07) expect_equal(unlist(as.list(x8$rejectedArmsPerStage)), c(0, 0, 0, 0, 0.1, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0.1, 0, 0.1, 0, 0.2, 0, 0, 0.2, 0.3, 0, 0, 0, 0.1, 0, 0.2, 0, 0.4, 0.2, 0, 0.7, 0.2, 0, 0.2, 0.1, 0.1, 0.2, 0.3, 0, 0.7, 0.3, 0, 0.8, 0.2), tolerance = 1e-07) expect_equal(x8$futilityStop, c(0, 0, 0, 0)) expect_equal(x8$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x8$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x8$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x8$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x8$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x8$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x8$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x8$selectedArms)), c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)) expect_equal(x8$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x8$numberOfActiveArms[2, ], c(4, 4, 4, 4)) expect_equal(x8$numberOfActiveArms[3, ], c(4, 4, 4, 4)) expect_equal(x8$expectedNumberOfSubjects, c(1050, 914.65115, 996.33236, 1027.6565), tolerance = 1e-07) expect_equal(unlist(as.list(x8$sampleSizes)), c(10, 100, 100, 10, 86.465115, 86.465115, 10, 94.633236, 94.633236, 10, 97.765652, 97.765652, 10, 100, 100, 10, 86.465115, 86.465115, 10, 94.633236, 94.633236, 10, 97.765652, 97.765652, 10, 100, 100, 10, 86.465115, 86.465115, 10, 94.633236, 94.633236, 10, 97.765652, 97.765652, 10, 100, 100, 10, 86.465115, 86.465115, 10, 94.633236, 94.633236, 10, 97.765652, 97.765652, 10, 100, 100, 10, 86.465115, 86.465115, 10, 94.633236, 94.633236, 10, 97.765652, 97.765652), tolerance = 1e-07) expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x8$conditionalPowerAchieved[2, ], c(0.015572779, 0.22941785, 0.084615364, 0.1668833), tolerance = 1e-07) expect_equal(x8$conditionalPowerAchieved[3, ], c(0.10350918, 0.24229761, 0.63483372, 0.79913622), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x8), NA))) expect_output(print(x8)$show()) invisible(capture.output(expect_error(summary(x8), NA))) expect_output(summary(x8)$show()) x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-05) expect_equal(x8CodeBased$rejectAtLeastOne, x8$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x8CodeBased$rejectedArmsPerStage, x8$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$futilityStop, x8$futilityStop, tolerance = 1e-05) expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-05) expect_equal(x8CodeBased$successPerStage, x8$successPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$selectedArms, x8$selectedArms, tolerance = 1e-05) expect_equal(x8CodeBased$numberOfActiveArms, x8$numberOfActiveArms, tolerance = 1e-05) expect_equal(x8CodeBased$expectedNumberOfSubjects, x8$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x8CodeBased$sampleSizes, x8$sampleSizes, tolerance = 1e-05) expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x8), "character") df <- as.data.frame(x8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x9 <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "rBest", rValue = 2, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x9' with expected results expect_equal(x9$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x9$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x9$iterations[3, ], c(10, 9, 8, 7)) expect_equal(x9$rejectAtLeastOne, c(0.4, 0.6, 0.7, 0.9), tolerance = 1e-07) expect_equal(unlist(as.list(x9$rejectedArmsPerStage)), c(0, 0, 0, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.2, 0.3, 0, 0.1, 0, 0, 0, 0.1, 0, 0, 0.2, 0, 0.5, 0, 0, 0.3, 0, 0, 0.2, 0.1, 0, 0.1, 0.1, 0, 0.1, 0, 0.1, 0.5, 0.3), tolerance = 1e-07) expect_equal(x9$futilityStop, c(0, 0, 0, 0)) expect_equal(x9$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x9$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x9$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x9$earlyStop[2, ], c(0, 0.1, 0.2, 0.3), tolerance = 1e-07) expect_equal(x9$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x9$successPerStage[2, ], c(0, 0.1, 0.2, 0.3), tolerance = 1e-07) expect_equal(x9$successPerStage[3, ], c(0, 0, 0.2, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x9$selectedArms)), c(1, 0.5, 0.5, 1, 0.7, 0.6, 1, 0.1, 0.1, 1, 0.3, 0.3, 1, 0.3, 0.3, 1, 0.3, 0.3, 1, 0.9, 0.7, 1, 0.4, 0.4, 1, 0.5, 0.5, 1, 0.5, 0.5, 1, 0.6, 0.4, 1, 0.4, 0.1, 1, 0.7, 0.7, 1, 0.5, 0.4, 1, 0.4, 0.4, 1, 0.9, 0.6, 1, 1, 1, 1, 1, 0.9, 1, 1, 0.8, 1, 1, 0.7), tolerance = 1e-07) expect_equal(x9$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x9$numberOfActiveArms[2, ], c(2, 2, 2, 2)) expect_equal(x9$numberOfActiveArms[3, ], c(2, 2, 2, 2)) expect_equal(x9$expectedNumberOfSubjects, c(541.86022, 465.03543, 438.85623, 427.93855), tolerance = 1e-07) expect_equal(unlist(as.list(x9$sampleSizes)), c(10, 42.315846, 42.315846, 10, 43.044196, 41.478749, 10, 10, 12.5, 10, 28.887554, 41.267934, 10, 15.358913, 15.358913, 10, 21.683959, 24.093288, 10, 70.857557, 63.571946, 10, 27.933797, 39.905424, 10, 46.61779, 46.61779, 10, 34.631951, 38.479946, 10, 49.194842, 36.493552, 10, 31.168408, 1.6691539, 10, 59.660857, 59.660857, 10, 44.698358, 43.316707, 10, 19.566345, 24.457932, 10, 67.989758, 54.271083, 10, 81.976703, 81.976703, 10, 72.029232, 73.684344, 10, 74.809372, 68.511715, 10, 77.989758, 68.556797), tolerance = 1e-07) expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x9$conditionalPowerAchieved[2, ], c(0.085169097, 0.1203719, 0.19239671, 0.15260753), tolerance = 1e-07) expect_equal(x9$conditionalPowerAchieved[3, ], c(0.20442999, 0.2985599, 0.51072411, 0.55234699), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x9), NA))) expect_output(print(x9)$show()) invisible(capture.output(expect_error(summary(x9), NA))) expect_output(summary(x9)$show()) x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-05) expect_equal(x9CodeBased$rejectAtLeastOne, x9$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x9CodeBased$rejectedArmsPerStage, x9$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$futilityStop, x9$futilityStop, tolerance = 1e-05) expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-05) expect_equal(x9CodeBased$successPerStage, x9$successPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$selectedArms, x9$selectedArms, tolerance = 1e-05) expect_equal(x9CodeBased$numberOfActiveArms, x9$numberOfActiveArms, tolerance = 1e-05) expect_equal(x9CodeBased$expectedNumberOfSubjects, x9$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x9CodeBased$sampleSizes, x9$sampleSizes, tolerance = 1e-05) expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x9), "character") df <- as.data.frame(x9) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x9) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x10 <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "epsilon", epsilonValue = 0.1, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), intersectionTest = "Bonferroni", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x10' with expected results expect_equal(x10$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x10$iterations[2, ], c(7, 8, 5, 9)) expect_equal(x10$iterations[3, ], c(7, 6, 4, 4)) expect_equal(x10$rejectAtLeastOne, c(0.2, 0.4, 0.2, 0.6), tolerance = 1e-07) expect_equal(unlist(as.list(x10$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0.1, 0.1, 0, 0, 0, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0.1, 0, 0, 0.2, 0, 0.1, 0.1, 0, 0.2, 0.1), tolerance = 1e-07) expect_equal(x10$futilityStop, c(0.3, 0.2, 0.5, 0.1), tolerance = 1e-07) expect_equal(x10$futilityPerStage[1, ], c(0.3, 0.2, 0.5, 0.1), tolerance = 1e-07) expect_equal(x10$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x10$earlyStop[1, ], c(0.3, 0.2, 0.5, 0.1), tolerance = 1e-07) expect_equal(x10$earlyStop[2, ], c(0, 0.2, 0.1, 0.5), tolerance = 1e-07) expect_equal(x10$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x10$successPerStage[2, ], c(0, 0.2, 0.1, 0.5), tolerance = 1e-07) expect_equal(x10$successPerStage[3, ], c(0.2, 0.2, 0.1, 0), tolerance = 1e-07) expect_equal(unlist(as.list(x10$selectedArms)), c(1, 0.1, 0.1, 1, 0, 0, 1, 0, 0, 1, 0.3, 0.3, 1, 0.3, 0.3, 1, 0.1, 0, 1, 0.2, 0.2, 1, 0.2, 0, 1, 0.1, 0.1, 1, 0.4, 0.3, 1, 0, 0, 1, 0.2, 0.1, 1, 0.4, 0.4, 1, 0.4, 0.4, 1, 0.4, 0.3, 1, 0.3, 0.1, 1, 0.7, 0.7, 1, 0.8, 0.6, 1, 0.5, 0.4, 1, 0.9, 0.4), tolerance = 1e-07) expect_equal(x10$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x10$numberOfActiveArms[2, ], c(1.2857143, 1.125, 1.2, 1.1111111), tolerance = 1e-07) expect_equal(x10$numberOfActiveArms[3, ], c(1.2857143, 1.1666667, 1.25, 1.25), tolerance = 1e-07) expect_equal(x10$expectedNumberOfSubjects, c(225.54374, 222.86662, 137.52897, 198.07751), tolerance = 1e-07) expect_equal(unlist(as.list(x10$sampleSizes)), c(10, 5.7796177, 5.7796177, 10, 0, 0, 10, 0, 0, 10, 21.972849, 49.43891, 10, 18.318062, 18.318062, 10, 4.015823, 0, 10, 19.919121, 24.898901, 10, 4.2855233, 0, 10, 4.0944014, 4.0944014, 10, 25.284305, 32.792226, 10, 0, 0, 10, 13.080039, 4.4300867, 10, 40.432794, 40.432794, 10, 33.32367, 44.431559, 10, 42.475692, 28.104858, 10, 18.985094, 14.869399, 10, 56.76351, 56.76351, 10, 50.123797, 60.557119, 10, 45.125964, 31.417698, 10, 51.714883, 53.868997), tolerance = 1e-07) expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x10$conditionalPowerAchieved[2, ], c(0.051011725, 0.14528092, 0.099325934, 0.10008765), tolerance = 1e-07) expect_equal(x10$conditionalPowerAchieved[3, ], c(0.1199627, 0.35325827, 0.33382798, 0.10956309), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x10), NA))) expect_output(print(x10)$show()) invisible(capture.output(expect_error(summary(x10), NA))) expect_output(summary(x10)$show()) x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-05) expect_equal(x10CodeBased$rejectAtLeastOne, x10$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x10CodeBased$rejectedArmsPerStage, x10$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$futilityStop, x10$futilityStop, tolerance = 1e-05) expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-05) expect_equal(x10CodeBased$successPerStage, x10$successPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$selectedArms, x10$selectedArms, tolerance = 1e-05) expect_equal(x10CodeBased$numberOfActiveArms, x10$numberOfActiveArms, tolerance = 1e-05) expect_equal(x10CodeBased$expectedNumberOfSubjects, x10$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x10CodeBased$sampleSizes, x10$sampleSizes, tolerance = 1e-05) expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x10), "character") df <- as.data.frame(x10) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x10) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x11 <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.1, 0.3, 0.1), intersectionTest = "Bonferroni", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x11' with expected results expect_equal(x11$iterations[1, ], c(10, 10, 10)) expect_equal(x11$iterations[2, ], c(9, 6, 6)) expect_equal(x11$iterations[3, ], c(9, 5, 4)) expect_equal(x11$rejectAtLeastOne, c(0, 0, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x11$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1), tolerance = 1e-07) expect_equal(x11$futilityStop, c(0.1, 0.5, 0.6), tolerance = 1e-07) expect_equal(x11$futilityPerStage[1, ], c(0.1, 0.4, 0.4), tolerance = 1e-07) expect_equal(x11$futilityPerStage[2, ], c(0, 0.1, 0.2), tolerance = 1e-07) expect_equal(x11$earlyStop[1, ], c(0.1, 0.4, 0.4), tolerance = 1e-07) expect_equal(x11$earlyStop[2, ], c(0, 0.1, 0.2), tolerance = 1e-07) expect_equal(x11$successPerStage[1, ], c(0, 0, 0)) expect_equal(x11$successPerStage[2, ], c(0, 0, 0)) expect_equal(x11$successPerStage[3, ], c(0, 0, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x11$selectedArms)), c(1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.1, 0, 1, 0.3, 0.3, 1, 0.3, 0.2, 1, 0.2, 0.1, 1, 0.2, 0.2, 1, 0.1, 0.1, 1, 0.2, 0.2, 1, 0.3, 0.3, 1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.9, 0.9, 1, 0.6, 0.5, 1, 0.6, 0.4), tolerance = 1e-07) expect_equal(x11$numberOfActiveArms[1, ], c(4, 4, 4)) expect_equal(x11$numberOfActiveArms[2, ], c(1, 1, 1)) expect_equal(x11$numberOfActiveArms[3, ], c(1, 1, 1)) expect_equal(x11$expectedNumberOfSubjects, c(293.83569, 240.03958, 175.41029), tolerance = 1e-07) expect_equal(unlist(as.list(x11$sampleSizes)), c(10, 1.428489, 11.111111, 10, 16.666667, 20, 10, 10.322237, 0, 10, 9.8699583, 33.333333, 10, 41.973847, 40, 10, 21.511686, 25, 10, 15.186109, 22.222222, 10, 6.5876644, 11.765765, 10, 17.33069, 33.465374, 10, 17.556106, 24.756944, 10, 16.666667, 20, 10, 2.0321899, 21.502286, 10, 44.040662, 91.42361, 10, 81.894844, 91.765765, 10, 51.196803, 79.96766), tolerance = 1e-07) expect_equal(x11$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x11$conditionalPowerAchieved[2, ], c(0.038698548, 0.10704476, 0.043430379), tolerance = 1e-07) expect_equal(x11$conditionalPowerAchieved[3, ], c(0.30869297, 0.27823314, 0.60162296), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x11), NA))) expect_output(print(x11)$show()) invisible(capture.output(expect_error(summary(x11), NA))) expect_output(summary(x11)$show()) x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) expect_equal(x11CodeBased$iterations, x11$iterations, tolerance = 1e-05) expect_equal(x11CodeBased$rejectAtLeastOne, x11$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x11CodeBased$rejectedArmsPerStage, x11$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$futilityStop, x11$futilityStop, tolerance = 1e-05) expect_equal(x11CodeBased$futilityPerStage, x11$futilityPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$earlyStop, x11$earlyStop, tolerance = 1e-05) expect_equal(x11CodeBased$successPerStage, x11$successPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$selectedArms, x11$selectedArms, tolerance = 1e-05) expect_equal(x11CodeBased$numberOfActiveArms, x11$numberOfActiveArms, tolerance = 1e-05) expect_equal(x11CodeBased$expectedNumberOfSubjects, x11$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x11CodeBased$sampleSizes, x11$sampleSizes, tolerance = 1e-05) expect_equal(x11CodeBased$conditionalPowerAchieved, x11$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x11), "character") df <- as.data.frame(x11) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x11) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x12 <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), typeOfShape = "linear", activeArms = 4, threshold = 0, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), intersectionTest = "Bonferroni", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x12' with expected results expect_equal(x12$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x12$iterations[2, ], c(10, 6, 8, 8)) expect_equal(x12$iterations[3, ], c(8, 5, 1, 2)) expect_equal(x12$rejectAtLeastOne, c(0.3, 0.1, 0.7, 0.7), tolerance = 1e-07) expect_equal(unlist(as.list(x12$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.1, 0.1, 0.1, 0.1, 0.1, 0, 0.1, 0, 0.2, 0.3, 0, 0.1, 0.3, 0), tolerance = 1e-07) expect_equal(x12$futilityStop, c(0, 0.4, 0.2, 0.2), tolerance = 1e-07) expect_equal(x12$futilityPerStage[1, ], c(0, 0.4, 0.2, 0.2), tolerance = 1e-07) expect_equal(x12$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x12$earlyStop[1, ], c(0, 0.4, 0.2, 0.2), tolerance = 1e-07) expect_equal(x12$earlyStop[2, ], c(0.2, 0.1, 0.7, 0.6), tolerance = 1e-07) expect_equal(x12$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x12$successPerStage[2, ], c(0.2, 0.1, 0.7, 0.6), tolerance = 1e-07) expect_equal(x12$successPerStage[3, ], c(0.1, 0, 0, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x12$selectedArms)), c(1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.1, 0, 1, 0, 0, 1, 0.3, 0.3, 1, 0.1, 0.1, 1, 0, 0, 1, 0.1, 0, 1, 0.1, 0.1, 1, 0.2, 0.2, 1, 0.1, 0, 1, 0.3, 0.2, 1, 0.5, 0.3, 1, 0.2, 0.1, 1, 0.6, 0.1, 1, 0.4, 0, 1, 1, 0.8, 1, 0.6, 0.5, 1, 0.8, 0.1, 1, 0.8, 0.2), tolerance = 1e-07) expect_equal(x12$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x12$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x12$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x12$expectedNumberOfSubjects, c(270.86167, 201.58944, 127.72687, 185.63922), tolerance = 1e-07) expect_equal(unlist(as.list(x12$sampleSizes)), c(10, 1.1167748, 12.5, 10, 8.9578499, 20, 10, 0.5, 0, 10, 0, 0, 10, 6.7277808, 32.819107, 10, 6.3724427, 20, 10, 0, 0, 10, 12.5, 0, 10, 2.4005123, 12.5, 10, 12.766635, 29.774077, 10, 11.503905, 0, 10, 27.658054, 100, 10, 28.865098, 31.331731, 10, 23.415877, 20, 10, 24.075387, 100, 10, 19.616461, 0, 10, 39.110166, 89.150838, 10, 51.512805, 89.774077, 10, 36.079292, 100, 10, 59.774515, 100), tolerance = 1e-07) expect_equal(x12$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x12$conditionalPowerAchieved[2, ], c(0.064552587, 0.074113563, 0.13271614, 0.12195746), tolerance = 1e-07) expect_equal(x12$conditionalPowerAchieved[3, ], c(0.41775137, 0.42792704, 0.6049542, 0.13870598), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x12), NA))) expect_output(print(x12)$show()) invisible(capture.output(expect_error(summary(x12), NA))) expect_output(summary(x12)$show()) x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) expect_equal(x12CodeBased$iterations, x12$iterations, tolerance = 1e-05) expect_equal(x12CodeBased$rejectAtLeastOne, x12$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x12CodeBased$rejectedArmsPerStage, x12$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$futilityStop, x12$futilityStop, tolerance = 1e-05) expect_equal(x12CodeBased$futilityPerStage, x12$futilityPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$earlyStop, x12$earlyStop, tolerance = 1e-05) expect_equal(x12CodeBased$successPerStage, x12$successPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$selectedArms, x12$selectedArms, tolerance = 1e-05) expect_equal(x12CodeBased$numberOfActiveArms, x12$numberOfActiveArms, tolerance = 1e-05) expect_equal(x12CodeBased$expectedNumberOfSubjects, x12$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x12CodeBased$sampleSizes, x12$sampleSizes, tolerance = 1e-05) expect_equal(x12CodeBased$conditionalPowerAchieved, x12$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x12), "character") df <- as.data.frame(x12) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x12) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x13 <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), typeOfShape = "userDefined", activeArms = 4, threshold = 0, plannedSubjects = c(10, 30, 50), stDev = 1.2, adaptations = rep(TRUE, 2), effectMatrix = matrix(c(0.1,0.2,0.3,0.4,0.2,0.3,0.4,0.5), ncol = 4), intersectionTest = "Sidak", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x13' with expected results expect_equal(x13$iterations[1, ], c(10, 10)) expect_equal(x13$iterations[2, ], c(10, 9)) expect_equal(x13$iterations[3, ], c(7, 7)) expect_equal(x13$rejectAtLeastOne, c(0.3, 0.3), tolerance = 1e-07) expect_equal(unlist(as.list(x13$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.2, 0, 0, 0.1, 0.1), tolerance = 1e-07) expect_equal(x13$futilityStop, c(0, 0.1), tolerance = 1e-07) expect_equal(x13$futilityPerStage[1, ], c(0, 0.1), tolerance = 1e-07) expect_equal(x13$futilityPerStage[2, ], c(0, 0)) expect_equal(x13$earlyStop[1, ], c(0, 0.1), tolerance = 1e-07) expect_equal(x13$earlyStop[2, ], c(0.3, 0.2), tolerance = 1e-07) expect_equal(x13$successPerStage[1, ], c(0, 0)) expect_equal(x13$successPerStage[2, ], c(0.3, 0.2), tolerance = 1e-07) expect_equal(x13$successPerStage[3, ], c(0, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x13$selectedArms)), c(1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.3, 0.3, 1, 0.5, 0.4, 1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.5, 0.2, 1, 0.2, 0.1, 1, 1, 0.7, 1, 0.9, 0.7), tolerance = 1e-07) expect_equal(x13$numberOfActiveArms[1, ], c(4, 4)) expect_equal(x13$numberOfActiveArms[2, ], c(1, 1)) expect_equal(x13$numberOfActiveArms[3, ], c(1, 1)) expect_equal(x13$expectedNumberOfSubjects, c(238.16649, 275.50348), tolerance = 1e-07) expect_equal(unlist(as.list(x13$sampleSizes)), c(10, 1.0395374, 14.285714, 10, 4.3933102, 11.199547, 10, 4.4634729, 31.899994, 10, 38.793234, 57.142857, 10, 2.5722467, 14.285714, 10, 5.3695979, 6.9814836, 10, 23.677991, 28.571429, 10, 11.241946, 8.8667681, 10, 31.753247, 89.042851, 10, 59.798088, 84.190656), tolerance = 1e-07) expect_equal(x13$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_)) expect_equal(x13$conditionalPowerAchieved[2, ], c(0.095374468, 0.085831831), tolerance = 1e-07) expect_equal(x13$conditionalPowerAchieved[3, ], c(0.56669649, 0.49770257), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x13), NA))) expect_output(print(x13)$show()) invisible(capture.output(expect_error(summary(x13), NA))) expect_output(summary(x13)$show()) x13CodeBased <- eval(parse(text = getObjectRCode(x13, stringWrapParagraphWidth = NULL))) expect_equal(x13CodeBased$iterations, x13$iterations, tolerance = 1e-05) expect_equal(x13CodeBased$rejectAtLeastOne, x13$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x13CodeBased$rejectedArmsPerStage, x13$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x13CodeBased$futilityStop, x13$futilityStop, tolerance = 1e-05) expect_equal(x13CodeBased$futilityPerStage, x13$futilityPerStage, tolerance = 1e-05) expect_equal(x13CodeBased$earlyStop, x13$earlyStop, tolerance = 1e-05) expect_equal(x13CodeBased$successPerStage, x13$successPerStage, tolerance = 1e-05) expect_equal(x13CodeBased$selectedArms, x13$selectedArms, tolerance = 1e-05) expect_equal(x13CodeBased$numberOfActiveArms, x13$numberOfActiveArms, tolerance = 1e-05) expect_equal(x13CodeBased$expectedNumberOfSubjects, x13$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x13CodeBased$sampleSizes, x13$sampleSizes, tolerance = 1e-05) expect_equal(x13CodeBased$conditionalPowerAchieved, x13$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x13), "character") df <- as.data.frame(x13) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x13) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x14 <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), typeOfShape = "sigmoidEmax", gED50 = 2, slope = 0.5, activeArms = 4, threshold = 0, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), intersectionTest = "Sidak", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x14' with expected results expect_equal(x14$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x14$iterations[2, ], c(10, 9, 8, 10)) expect_equal(x14$iterations[3, ], c(9, 9, 6, 7)) expect_equal(x14$rejectAtLeastOne, c(0.1, 0, 0.3, 0.4), tolerance = 1e-07) expect_equal(unlist(as.list(x14$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0.1, 0.1), tolerance = 1e-07) expect_equal(x14$futilityStop, c(0, 0.1, 0.2, 0), tolerance = 1e-07) expect_equal(x14$futilityPerStage[1, ], c(0, 0.1, 0.2, 0), tolerance = 1e-07) expect_equal(x14$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x14$earlyStop[1, ], c(0, 0.1, 0.2, 0), tolerance = 1e-07) expect_equal(x14$earlyStop[2, ], c(0.1, 0, 0.2, 0.3), tolerance = 1e-07) expect_equal(x14$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x14$successPerStage[2, ], c(0.1, 0, 0.2, 0.3), tolerance = 1e-07) expect_equal(x14$successPerStage[3, ], c(0, 0, 0.1, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x14$selectedArms)), c(1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.1, 0, 1, 0.3, 0.3, 1, 0.3, 0.3, 1, 0.4, 0.4, 1, 0.1, 0.1, 1, 0.1, 0, 1, 0.2, 0.2, 1, 0.3, 0.3, 1, 0.2, 0.1, 1, 0.2, 0.2, 1, 0.4, 0.3, 1, 0.1, 0.1, 1, 0.4, 0.4, 1, 0.4, 0.2, 1, 1, 0.9, 1, 0.9, 0.9, 1, 0.8, 0.6, 1, 1, 0.7), tolerance = 1e-07) expect_equal(x14$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x14$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x14$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x14$expectedNumberOfSubjects, c(302.82831, 359.55539, 205.66054, 326.21609), tolerance = 1e-07) expect_equal(unlist(as.list(x14$sampleSizes)), c(10, 0.96871141, 11.111111, 10, 4.8692533, 11.111111, 10, 0.5, 0, 10, 30, 42.857143, 10, 6.7277808, 29.172539, 10, 37.581628, 44.444444, 10, 12.5, 16.666667, 10, 10, 0, 10, 12.834638, 22.222222, 10, 21.991558, 33.249006, 10, 17.610119, 16.666667, 10, 12.962323, 28.571429, 10, 24.585127, 27.825125, 10, 7.6171061, 11.111111, 10, 20.182233, 28.660644, 10, 22.561443, 17.977538, 10, 45.116257, 90.330997, 10, 72.059546, 99.915673, 10, 50.792352, 61.993977, 10, 75.523767, 89.406109), tolerance = 1e-07) expect_equal(x14$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x14$conditionalPowerAchieved[2, ], c(0.054394525, 0.033810654, 0.16623293, 0.07472066), tolerance = 1e-07) expect_equal(x14$conditionalPowerAchieved[3, ], c(0.39787587, 0.27550431, 0.64928935, 0.24074486), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x14), NA))) expect_output(print(x14)$show()) invisible(capture.output(expect_error(summary(x14), NA))) expect_output(summary(x14)$show()) x14CodeBased <- eval(parse(text = getObjectRCode(x14, stringWrapParagraphWidth = NULL))) expect_equal(x14CodeBased$iterations, x14$iterations, tolerance = 1e-05) expect_equal(x14CodeBased$rejectAtLeastOne, x14$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x14CodeBased$rejectedArmsPerStage, x14$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x14CodeBased$futilityStop, x14$futilityStop, tolerance = 1e-05) expect_equal(x14CodeBased$futilityPerStage, x14$futilityPerStage, tolerance = 1e-05) expect_equal(x14CodeBased$earlyStop, x14$earlyStop, tolerance = 1e-05) expect_equal(x14CodeBased$successPerStage, x14$successPerStage, tolerance = 1e-05) expect_equal(x14CodeBased$selectedArms, x14$selectedArms, tolerance = 1e-05) expect_equal(x14CodeBased$numberOfActiveArms, x14$numberOfActiveArms, tolerance = 1e-05) expect_equal(x14CodeBased$expectedNumberOfSubjects, x14$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x14CodeBased$sampleSizes, x14$sampleSizes, tolerance = 1e-05) expect_equal(x14CodeBased$conditionalPowerAchieved, x14$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x14), "character") df <- as.data.frame(x14) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x14) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x15 <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, typeOfSelection = "all", plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), intersectionTest = "Sidak", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x15' with expected results expect_equal(x15$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x15$iterations[2, ], c(10, 9, 9, 10)) expect_equal(x15$iterations[3, ], c(10, 8, 8, 10)) expect_equal(x15$rejectAtLeastOne, c(0.1, 0.6, 0.9, 1), tolerance = 1e-07) expect_equal(unlist(as.list(x15$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0, 0.1, 0, 0, 0, 0, 0.2, 0, 0.1, 0.2, 0, 0, 0, 0, 0.2, 0.1, 0, 0.3, 0.3, 0, 0.3, 0.4, 0, 0.1, 0, 0, 0.3, 0.1, 0, 0.5, 0.2, 0.1, 0.4, 0.2), tolerance = 1e-07) expect_equal(x15$futilityStop, c(0, 0.1, 0.1, 0), tolerance = 1e-07) expect_equal(x15$futilityPerStage[1, ], c(0, 0.1, 0.1, 0), tolerance = 1e-07) expect_equal(x15$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x15$earlyStop[1, ], c(0, 0.1, 0.1, 0), tolerance = 1e-07) expect_equal(x15$earlyStop[2, ], c(0, 0.1, 0.1, 0), tolerance = 1e-07) expect_equal(x15$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x15$successPerStage[2, ], c(0, 0.1, 0.1, 0), tolerance = 1e-07) expect_equal(x15$successPerStage[3, ], c(0, 0, 0.3, 0.3), tolerance = 1e-07) expect_equal(unlist(as.list(x15$selectedArms)), c(1, 0.6, 0.6, 1, 0.6, 0.5, 1, 0.2, 0.1, 1, 0.7, 0.5, 1, 0.7, 0.6, 1, 0.8, 0.7, 1, 0.7, 0.7, 1, 0.7, 0.7, 1, 0.7, 0.7, 1, 0.8, 0.7, 1, 0.7, 0.7, 1, 0.9, 0.9, 1, 0.6, 0.6, 1, 0.6, 0.5, 1, 0.7, 0.6, 1, 0.8, 0.8, 1, 1, 1, 1, 0.9, 0.8, 1, 0.9, 0.8, 1, 1, 1), tolerance = 1e-07) expect_equal(x15$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x15$numberOfActiveArms[2, ], c(2.6, 3.1111111, 2.5555556, 3.1), tolerance = 1e-07) expect_equal(x15$numberOfActiveArms[3, ], c(2.5, 3, 2.625, 2.9), tolerance = 1e-07) expect_equal(x15$expectedNumberOfSubjects, c(690.38911, 619.77858, 554.02061, 670.88154), tolerance = 1e-07) expect_equal(unlist(as.list(x15$sampleSizes)), c(10, 54.180167, 50.4, 10, 57.917242, 50.5, 10, 16.188147, 12.5, 10, 64.800747, 25.135561, 10, 65.454083, 50.4, 10, 71.01474, 75.5, 10, 71.743702, 62.866861, 10, 64.800747, 45.135561, 10, 69.120607, 60.4, 10, 71.01474, 75.5, 10, 71.743702, 62.866861, 10, 84.800747, 55.535561, 10, 55.454083, 50.4, 10, 48.792518, 50.5, 10, 71.743702, 50.366861, 10, 74.800747, 45.535561, 10, 94.180167, 90.4, 10, 82.125851, 88, 10, 93.965925, 75.366861, 10, 94.800747, 65.535561), tolerance = 1e-07) expect_equal(x15$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x15$conditionalPowerAchieved[2, ], c(0.086326519, 0.23897424, 0.15375141, 0.19252038), tolerance = 1e-07) expect_equal(x15$conditionalPowerAchieved[3, ], c(0.19907656, 0.37086672, 0.52811383, 0.57866018), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x15), NA))) expect_output(print(x15)$show()) invisible(capture.output(expect_error(summary(x15), NA))) expect_output(summary(x15)$show()) x15CodeBased <- eval(parse(text = getObjectRCode(x15, stringWrapParagraphWidth = NULL))) expect_equal(x15CodeBased$iterations, x15$iterations, tolerance = 1e-05) expect_equal(x15CodeBased$rejectAtLeastOne, x15$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x15CodeBased$rejectedArmsPerStage, x15$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x15CodeBased$futilityStop, x15$futilityStop, tolerance = 1e-05) expect_equal(x15CodeBased$futilityPerStage, x15$futilityPerStage, tolerance = 1e-05) expect_equal(x15CodeBased$earlyStop, x15$earlyStop, tolerance = 1e-05) expect_equal(x15CodeBased$successPerStage, x15$successPerStage, tolerance = 1e-05) expect_equal(x15CodeBased$selectedArms, x15$selectedArms, tolerance = 1e-05) expect_equal(x15CodeBased$numberOfActiveArms, x15$numberOfActiveArms, tolerance = 1e-05) expect_equal(x15CodeBased$expectedNumberOfSubjects, x15$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x15CodeBased$sampleSizes, x15$sampleSizes, tolerance = 1e-05) expect_equal(x15CodeBased$conditionalPowerAchieved, x15$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x15), "character") df <- as.data.frame(x15) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x15) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x16 <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, typeOfSelection = "rBest", rValue = 2, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), intersectionTest = "Simes", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x16' with expected results expect_equal(x16$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x16$iterations[2, ], c(8, 8, 9, 10)) expect_equal(x16$iterations[3, ], c(8, 8, 8, 7)) expect_equal(x16$rejectAtLeastOne, c(0.1, 0.5, 0.7, 0.8), tolerance = 1e-07) expect_equal(unlist(as.list(x16$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.1, 0, 0.1, 0.1, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0, 0.2, 0.1, 0, 0.1, 0, 0.1, 0.2, 0.2, 0, 0.1, 0.4, 0.1, 0.6, 0), tolerance = 1e-07) expect_equal(x16$futilityStop, c(0.2, 0.2, 0.1, 0), tolerance = 1e-07) expect_equal(x16$futilityPerStage[1, ], c(0.2, 0.2, 0.1, 0), tolerance = 1e-07) expect_equal(x16$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x16$earlyStop[1, ], c(0.2, 0.2, 0.1, 0), tolerance = 1e-07) expect_equal(x16$earlyStop[2, ], c(0, 0, 0.1, 0.3), tolerance = 1e-07) expect_equal(x16$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x16$successPerStage[2, ], c(0, 0, 0.1, 0.3), tolerance = 1e-07) expect_equal(x16$successPerStage[3, ], c(0.1, 0.1, 0.2, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x16$selectedArms)), c(1, 0.2, 0.1, 1, 0.6, 0.6, 1, 0.4, 0.4, 1, 0.1, 0.1, 1, 0.3, 0.3, 1, 0.2, 0.2, 1, 0.3, 0.2, 1, 0.5, 0.5, 1, 0.3, 0.3, 1, 0.1, 0.1, 1, 0.4, 0.3, 1, 0.5, 0.3, 1, 0.8, 0.8, 1, 0.7, 0.7, 1, 0.5, 0.5, 1, 0.7, 0.4, 1, 0.8, 0.8, 1, 0.8, 0.8, 1, 0.9, 0.8, 1, 1, 0.7), tolerance = 1e-07) expect_equal(x16$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x16$numberOfActiveArms[2, ], c(2, 2, 1.7777778, 1.8), tolerance = 1e-07) expect_equal(x16$numberOfActiveArms[3, ], c(1.875, 2, 1.75, 1.8571429), tolerance = 1e-07) expect_equal(x16$expectedNumberOfSubjects, c(485.19749, 377.01763, 431.09127, 345.60572), tolerance = 1e-07) expect_equal(unlist(as.list(x16$sampleSizes)), c(10, 25, 12.5, 10, 52.984739, 51, 10, 38.255848, 50, 10, 5.1691192, 14.285714, 10, 28.803833, 37.5, 10, 25, 25, 10, 24.228929, 11.497164, 10, 28.635967, 34.757362, 10, 31.69512, 37.5, 10, 5.6938105, 1.5787961, 10, 40.9155, 37.5, 10, 42.851335, 17.605103, 10, 85.498953, 100, 10, 58.678549, 52.578796, 10, 35.341046, 48.997164, 10, 50.953751, 18.295116, 10, 85.498953, 100, 10, 71.178549, 65.078796, 10, 76.256545, 86.497164, 10, 73.805086, 49.614505), tolerance = 1e-07) expect_equal(x16$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x16$conditionalPowerAchieved[2, ], c(0.017664185, 0.17480419, 0.093445917, 0.088580327), tolerance = 1e-07) expect_equal(x16$conditionalPowerAchieved[3, ], c(0.16524243, 0.38443342, 0.48058247, 0.6510419), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x16), NA))) expect_output(print(x16)$show()) invisible(capture.output(expect_error(summary(x16), NA))) expect_output(summary(x16)$show()) x16CodeBased <- eval(parse(text = getObjectRCode(x16, stringWrapParagraphWidth = NULL))) expect_equal(x16CodeBased$iterations, x16$iterations, tolerance = 1e-05) expect_equal(x16CodeBased$rejectAtLeastOne, x16$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x16CodeBased$rejectedArmsPerStage, x16$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x16CodeBased$futilityStop, x16$futilityStop, tolerance = 1e-05) expect_equal(x16CodeBased$futilityPerStage, x16$futilityPerStage, tolerance = 1e-05) expect_equal(x16CodeBased$earlyStop, x16$earlyStop, tolerance = 1e-05) expect_equal(x16CodeBased$successPerStage, x16$successPerStage, tolerance = 1e-05) expect_equal(x16CodeBased$selectedArms, x16$selectedArms, tolerance = 1e-05) expect_equal(x16CodeBased$numberOfActiveArms, x16$numberOfActiveArms, tolerance = 1e-05) expect_equal(x16CodeBased$expectedNumberOfSubjects, x16$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x16CodeBased$sampleSizes, x16$sampleSizes, tolerance = 1e-05) expect_equal(x16CodeBased$conditionalPowerAchieved, x16$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x16), "character") df <- as.data.frame(x16) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x16) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x17 <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, typeOfSelection = "epsilon", epsilonValue = 0.1, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), intersectionTest = "Simes", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x17' with expected results expect_equal(x17$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x17$iterations[2, ], c(9, 10, 10, 10)) expect_equal(x17$iterations[3, ], c(7, 8, 5, 5)) expect_equal(x17$rejectAtLeastOne, c(0.3, 0.2, 0.9, 0.8), tolerance = 1e-07) expect_equal(unlist(as.list(x17$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.1, 0.1, 0, 0.2, 0, 0, 0.1, 0.4, 0, 0.2, 0, 0, 0, 0.1, 0, 0.1, 0, 0.2, 0.3, 0.1, 0, 0.2, 0.4), tolerance = 1e-07) expect_equal(x17$futilityStop, c(0.2, 0.1, 0, 0.1), tolerance = 1e-07) expect_equal(x17$futilityPerStage[1, ], c(0.1, 0, 0, 0), tolerance = 1e-07) expect_equal(x17$futilityPerStage[2, ], c(0.1, 0.1, 0, 0.1), tolerance = 1e-07) expect_equal(x17$earlyStop[1, ], c(0.1, 0, 0, 0), tolerance = 1e-07) expect_equal(x17$earlyStop[2, ], c(0.2, 0.2, 0.5, 0.5), tolerance = 1e-07) expect_equal(x17$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x17$successPerStage[2, ], c(0.1, 0.1, 0.5, 0.4), tolerance = 1e-07) expect_equal(x17$successPerStage[3, ], c(0.2, 0.1, 0.4, 0.3), tolerance = 1e-07) expect_equal(unlist(as.list(x17$selectedArms)), c(1, 0.1, 0.1, 1, 0.2, 0.2, 1, 0.1, 0.1, 1, 0.1, 0, 1, 0.4, 0.3, 1, 0.4, 0.2, 1, 0, 0, 1, 0.2, 0.1, 1, 0.2, 0.1, 1, 0.3, 0.2, 1, 0.6, 0.5, 1, 0.3, 0.1, 1, 0.4, 0.4, 1, 0.3, 0.3, 1, 0.6, 0.1, 1, 0.6, 0.4, 1, 0.9, 0.7, 1, 1, 0.8, 1, 1, 0.5, 1, 1, 0.5), tolerance = 1e-07) expect_equal(x17$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x17$numberOfActiveArms[2, ], c(1.2222222, 1.2, 1.3, 1.2), tolerance = 1e-07) expect_equal(x17$numberOfActiveArms[3, ], c(1.2857143, 1.125, 1.4, 1.2), tolerance = 1e-07) expect_equal(x17$expectedNumberOfSubjects, c(328.39002, 302.69421, 285.23022, 240.4545), tolerance = 1e-07) expect_equal(unlist(as.list(x17$sampleSizes)), c(10, 4.4952582, 14.285714, 10, 19.967039, 25, 10, 10, 20, 10, 10, 0, 10, 21.883735, 42.857143, 10, 26.51119, 25, 10, 0, 0, 10, 13.162215, 6.3433684, 10, 14.295646, 14.285714, 10, 12.191217, 8.9015119, 10, 34.361222, 100, 10, 22.260169, 5.4863466, 10, 27.97297, 57.142857, 10, 13.444855, 22.756787, 10, 23.167319, 20, 10, 26.747723, 50.618475, 10, 62.896861, 100, 10, 55.457645, 74.744525, 10, 47.701679, 100, 10, 59.007892, 56.104821), tolerance = 1e-07) expect_equal(x17$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x17$conditionalPowerAchieved[2, ], c(0.025620238, 0.099222073, 0.15711506, 0.067612991), tolerance = 1e-07) expect_equal(x17$conditionalPowerAchieved[3, ], c(0.2137719, 0.30848358, 0.15636561, 0.6965125), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x17), NA))) expect_output(print(x17)$show()) invisible(capture.output(expect_error(summary(x17), NA))) expect_output(summary(x17)$show()) x17CodeBased <- eval(parse(text = getObjectRCode(x17, stringWrapParagraphWidth = NULL))) expect_equal(x17CodeBased$iterations, x17$iterations, tolerance = 1e-05) expect_equal(x17CodeBased$rejectAtLeastOne, x17$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x17CodeBased$rejectedArmsPerStage, x17$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x17CodeBased$futilityStop, x17$futilityStop, tolerance = 1e-05) expect_equal(x17CodeBased$futilityPerStage, x17$futilityPerStage, tolerance = 1e-05) expect_equal(x17CodeBased$earlyStop, x17$earlyStop, tolerance = 1e-05) expect_equal(x17CodeBased$successPerStage, x17$successPerStage, tolerance = 1e-05) expect_equal(x17CodeBased$selectedArms, x17$selectedArms, tolerance = 1e-05) expect_equal(x17CodeBased$numberOfActiveArms, x17$numberOfActiveArms, tolerance = 1e-05) expect_equal(x17CodeBased$expectedNumberOfSubjects, x17$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x17CodeBased$sampleSizes, x17$sampleSizes, tolerance = 1e-05) expect_equal(x17CodeBased$conditionalPowerAchieved, x17$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x17), "character") df <- as.data.frame(x17) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x17) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x18 <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), intersectionTest = "Simes", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x18' with expected results expect_equal(x18$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x18$iterations[2, ], c(10, 9, 8, 10)) expect_equal(x18$iterations[3, ], c(7, 8, 1, 4)) expect_equal(x18$rejectAtLeastOne, c(0.3, 0.1, 0.7, 0.6), tolerance = 1e-07) expect_equal(unlist(as.list(x18$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.1, 0, 0.1, 0.2, 0, 0, 0.1, 0, 0.2, 0.3, 0, 0.1, 0.3, 0), tolerance = 1e-07) expect_equal(x18$futilityStop, c(0, 0.1, 0.2, 0), tolerance = 1e-07) expect_equal(x18$futilityPerStage[1, ], c(0, 0.1, 0.2, 0), tolerance = 1e-07) expect_equal(x18$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x18$earlyStop[1, ], c(0, 0.1, 0.2, 0), tolerance = 1e-07) expect_equal(x18$earlyStop[2, ], c(0.3, 0.1, 0.7, 0.6), tolerance = 1e-07) expect_equal(x18$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x18$successPerStage[2, ], c(0.3, 0.1, 0.7, 0.6), tolerance = 1e-07) expect_equal(x18$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x18$selectedArms)), c(1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.1, 0, 1, 0.1, 0.1, 1, 0.3, 0.3, 1, 0.4, 0.4, 1, 0, 0, 1, 0.1, 0, 1, 0.1, 0.1, 1, 0.2, 0.2, 1, 0.1, 0, 1, 0.4, 0.3, 1, 0.5, 0.2, 1, 0.2, 0.1, 1, 0.6, 0.1, 1, 0.4, 0, 1, 1, 0.7, 1, 0.9, 0.8, 1, 0.8, 0.1, 1, 1, 0.4), tolerance = 1e-07) expect_equal(x18$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x18$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x18$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x18$expectedNumberOfSubjects, c(179.95701, 273.63073, 113.26043, 249.89211), tolerance = 1e-07) expect_equal(unlist(as.list(x18$sampleSizes)), c(10, 1.1167748, 1.5953926, 10, 5.9718999, 6.7183874, 10, 0.5, 0, 10, 10, 25, 10, 6.7277808, 9.6111155, 10, 37.581628, 42.279332, 10, 0, 0, 10, 10, 0, 10, 2.4005123, 3.4293032, 10, 8.5110901, 9.5749763, 10, 11.503905, 0, 10, 32.126443, 55.316107, 10, 28.865098, 22.318956, 10, 15.610585, 5.061908, 10, 24.075387, 27.667829, 10, 15.693169, 0, 10, 39.110166, 36.954767, 10, 67.675203, 63.634604, 10, 36.079292, 27.667829, 10, 67.819612, 80.316107), tolerance = 1e-07) expect_equal(x18$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x18$conditionalPowerAchieved[2, ], c(0.064552587, 0.050542809, 0.13271614, 0.098246228), tolerance = 1e-07) expect_equal(x18$conditionalPowerAchieved[3, ], c(0.1164829, 0.22353174, 0.16556673, 0.12567304), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x18), NA))) expect_output(print(x18)$show()) invisible(capture.output(expect_error(summary(x18), NA))) expect_output(summary(x18)$show()) x18CodeBased <- eval(parse(text = getObjectRCode(x18, stringWrapParagraphWidth = NULL))) expect_equal(x18CodeBased$iterations, x18$iterations, tolerance = 1e-05) expect_equal(x18CodeBased$rejectAtLeastOne, x18$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x18CodeBased$rejectedArmsPerStage, x18$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x18CodeBased$futilityStop, x18$futilityStop, tolerance = 1e-05) expect_equal(x18CodeBased$futilityPerStage, x18$futilityPerStage, tolerance = 1e-05) expect_equal(x18CodeBased$earlyStop, x18$earlyStop, tolerance = 1e-05) expect_equal(x18CodeBased$successPerStage, x18$successPerStage, tolerance = 1e-05) expect_equal(x18CodeBased$selectedArms, x18$selectedArms, tolerance = 1e-05) expect_equal(x18CodeBased$numberOfActiveArms, x18$numberOfActiveArms, tolerance = 1e-05) expect_equal(x18CodeBased$expectedNumberOfSubjects, x18$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x18CodeBased$sampleSizes, x18$sampleSizes, tolerance = 1e-05) expect_equal(x18CodeBased$conditionalPowerAchieved, x18$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x18), "character") df <- as.data.frame(x18) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x18) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x19 <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, typeOfSelection = "all", plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), intersectionTest = "Hierarchical", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x19' with expected results expect_equal(x19$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x19$iterations[2, ], c(10, 7, 9, 10)) expect_equal(x19$iterations[3, ], c(6, 3, 4, 6)) expect_equal(x19$rejectAtLeastOne, c(0.1, 0, 0.1, 0), tolerance = 1e-07) expect_equal(unlist(as.list(x19$rejectedArmsPerStage)), c(0, 0.1, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0), tolerance = 1e-07) expect_equal(x19$futilityStop, c(0.4, 0.7, 0.6, 0.4), tolerance = 1e-07) expect_equal(x19$futilityPerStage[1, ], c(0, 0.3, 0.1, 0), tolerance = 1e-07) expect_equal(x19$futilityPerStage[2, ], c(0.4, 0.4, 0.5, 0.4), tolerance = 1e-07) expect_equal(x19$earlyStop[1, ], c(0, 0.3, 0.1, 0), tolerance = 1e-07) expect_equal(x19$earlyStop[2, ], c(0.4, 0.4, 0.5, 0.4), tolerance = 1e-07) expect_equal(x19$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x19$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x19$successPerStage[3, ], c(0, 0, 0.1, 0), tolerance = 1e-07) expect_equal(unlist(as.list(x19$selectedArms)), c(1, 0.6, 0.6, 1, 0.3, 0.3, 1, 0.4, 0.4, 1, 0.6, 0.6, 1, 0.6, 0.4, 1, 0.5, 0.2, 1, 0.7, 0.3, 1, 1, 0.6, 1, 0.6, 0.4, 1, 0.7, 0.3, 1, 0.7, 0.4, 1, 0.7, 0.4, 1, 0.7, 0.3, 1, 0.5, 0.2, 1, 0.9, 0.4, 1, 0.8, 0.5, 1, 1, 0.6, 1, 0.7, 0.3, 1, 0.9, 0.4, 1, 1, 0.6), tolerance = 1e-07) expect_equal(x19$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x19$numberOfActiveArms[2, ], c(2.5, 2.8571429, 3, 3.1), tolerance = 1e-07) expect_equal(x19$numberOfActiveArms[3, ], c(2.8333333, 3.3333333, 3.75, 3.5), tolerance = 1e-07) expect_equal(x19$expectedNumberOfSubjects, c(600.66781, 398.09964, 600, 634), tolerance = 1e-07) expect_equal(unlist(as.list(x19$sampleSizes)), c(10, 56.333476, 93.889127, 10, 42.857143, 100, 10, 44.444444, 100, 10, 50.4, 84, 10, 56.333476, 60.555794, 10, 52.89273, 66.666667, 10, 77.777778, 75, 10, 90.4, 84, 10, 60, 66.666667, 10, 81.464159, 100, 10, 77.777778, 100, 10, 60.4, 50.666667, 10, 66.333476, 43.889127, 10, 52.89273, 66.666667, 10, 100, 100, 10, 70.4, 67.333333, 10, 96.333476, 93.889127, 10, 81.464159, 100, 10, 100, 100, 10, 90.4, 84), tolerance = 1e-07) expect_equal(x19$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x19$conditionalPowerAchieved[2, ], c(0.014835699, 0.082104288, 0.088043543, 0.18689602), tolerance = 1e-07) expect_equal(x19$conditionalPowerAchieved[3, ], c(0.35039062, 0.35957167, 0.84477407, 0.62586447), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x19), NA))) expect_output(print(x19)$show()) invisible(capture.output(expect_error(summary(x19), NA))) expect_output(summary(x19)$show()) x19CodeBased <- eval(parse(text = getObjectRCode(x19, stringWrapParagraphWidth = NULL))) expect_equal(x19CodeBased$iterations, x19$iterations, tolerance = 1e-05) expect_equal(x19CodeBased$rejectAtLeastOne, x19$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x19CodeBased$rejectedArmsPerStage, x19$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x19CodeBased$futilityStop, x19$futilityStop, tolerance = 1e-05) expect_equal(x19CodeBased$futilityPerStage, x19$futilityPerStage, tolerance = 1e-05) expect_equal(x19CodeBased$earlyStop, x19$earlyStop, tolerance = 1e-05) expect_equal(x19CodeBased$successPerStage, x19$successPerStage, tolerance = 1e-05) expect_equal(x19CodeBased$selectedArms, x19$selectedArms, tolerance = 1e-05) expect_equal(x19CodeBased$numberOfActiveArms, x19$numberOfActiveArms, tolerance = 1e-05) expect_equal(x19CodeBased$expectedNumberOfSubjects, x19$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x19CodeBased$sampleSizes, x19$sampleSizes, tolerance = 1e-05) expect_equal(x19CodeBased$conditionalPowerAchieved, x19$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x19), "character") df <- as.data.frame(x19) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x19) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x20 <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, typeOfSelection = "rBest", rValue = 2, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), intersectionTest = "Hierarchical", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x20' with expected results expect_equal(x20$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x20$iterations[2, ], c(9, 9, 8, 10)) expect_equal(x20$iterations[3, ], c(2, 6, 3, 2)) expect_equal(x20$rejectAtLeastOne, c(0, 0.2, 0, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x20$rejectedArmsPerStage)), c(0, 0, 0, 0.1, 0, 0.1, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), tolerance = 1e-07) expect_equal(x20$futilityStop, c(0.8, 0.4, 0.7, 0.7), tolerance = 1e-07) expect_equal(x20$futilityPerStage[1, ], c(0.1, 0.1, 0.2, 0), tolerance = 1e-07) expect_equal(x20$futilityPerStage[2, ], c(0.7, 0.3, 0.5, 0.7), tolerance = 1e-07) expect_equal(x20$earlyStop[1, ], c(0.1, 0.1, 0.2, 0), tolerance = 1e-07) expect_equal(x20$earlyStop[2, ], c(0.7, 0.3, 0.5, 0.8), tolerance = 1e-07) expect_equal(x20$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x20$successPerStage[2, ], c(0, 0, 0, 0.1), tolerance = 1e-07) expect_equal(x20$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x20$selectedArms)), c(1, 0.2, 0.2, 1, 0.6, 0.6, 1, 0.3, 0.3, 1, 0.3, 0.2, 1, 0.4, 0, 1, 0.1, 0, 1, 0.3, 0, 1, 0.5, 0, 1, 0.3, 0, 1, 0.3, 0.1, 1, 0.3, 0.1, 1, 0.4, 0, 1, 0.8, 0.2, 1, 0.8, 0.5, 1, 0.5, 0.2, 1, 0.8, 0.2, 1, 0.9, 0.2, 1, 0.9, 0.6, 1, 0.8, 0.3, 1, 1, 0.2), tolerance = 1e-07) expect_equal(x20$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x20$numberOfActiveArms[2, ], c(1.8888889, 2, 1.75, 2), tolerance = 1e-07) expect_equal(x20$numberOfActiveArms[3, ], c(2, 2, 2, 2)) expect_equal(x20$expectedNumberOfSubjects, c(307.09166, 377.99189, 286.78887, 300.60787), tolerance = 1e-07) expect_equal(unlist(as.list(x20$sampleSizes)), c(10, 22.222222, 100, 10, 47.097546, 70.646318, 10, 30.537829, 81.43421, 10, 25.370782, 76.853911, 10, 33.228314, 0, 10, 11.111111, 0, 10, 27.257545, 0, 10, 38.448036, 0, 10, 17.763874, 0, 10, 27.283387, 16.666667, 10, 33.529937, 33.333333, 10, 22.273651, 0, 10, 69.075708, 100, 10, 63.269822, 53.979652, 10, 39.758676, 48.100877, 10, 50.237878, 76.853911, 10, 76.700615, 100, 10, 74.380933, 70.646318, 10, 73.288614, 81.43421, 10, 68.165174, 76.853911), tolerance = 1e-07) expect_equal(x20$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x20$conditionalPowerAchieved[2, ], c(0.0535706, 0.15544115, 0.10470149, 0.094637028), tolerance = 1e-07) expect_equal(x20$conditionalPowerAchieved[3, ], c(0.09464551, 0.36740056, 0.23354895, 0.75738479), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x20), NA))) expect_output(print(x20)$show()) invisible(capture.output(expect_error(summary(x20), NA))) expect_output(summary(x20)$show()) x20CodeBased <- eval(parse(text = getObjectRCode(x20, stringWrapParagraphWidth = NULL))) expect_equal(x20CodeBased$iterations, x20$iterations, tolerance = 1e-05) expect_equal(x20CodeBased$rejectAtLeastOne, x20$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x20CodeBased$rejectedArmsPerStage, x20$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x20CodeBased$futilityStop, x20$futilityStop, tolerance = 1e-05) expect_equal(x20CodeBased$futilityPerStage, x20$futilityPerStage, tolerance = 1e-05) expect_equal(x20CodeBased$earlyStop, x20$earlyStop, tolerance = 1e-05) expect_equal(x20CodeBased$successPerStage, x20$successPerStage, tolerance = 1e-05) expect_equal(x20CodeBased$selectedArms, x20$selectedArms, tolerance = 1e-05) expect_equal(x20CodeBased$numberOfActiveArms, x20$numberOfActiveArms, tolerance = 1e-05) expect_equal(x20CodeBased$expectedNumberOfSubjects, x20$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x20CodeBased$sampleSizes, x20$sampleSizes, tolerance = 1e-05) expect_equal(x20CodeBased$conditionalPowerAchieved, x20$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x20), "character") df <- as.data.frame(x20) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x20) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x21 <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, typeOfSelection = "epsilon", epsilonValue = 0.1, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), intersectionTest = "Hierarchical", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x21' with expected results expect_equal(x21$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x21$iterations[2, ], c(9, 9, 10, 10)) expect_equal(x21$iterations[3, ], c(1, 1, 3, 0)) expect_equal(x21$rejectAtLeastOne, c(0, 0.1, 0.1, 0), tolerance = 1e-07) expect_equal(unlist(as.list(x21$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), tolerance = 1e-07) expect_equal(x21$futilityStop, c(0.9, 0.9, 0.6, 1), tolerance = 1e-07) expect_equal(x21$futilityPerStage[1, ], c(0.1, 0.1, 0, 0), tolerance = 1e-07) expect_equal(x21$futilityPerStage[2, ], c(0.8, 0.8, 0.6, 1), tolerance = 1e-07) expect_equal(x21$earlyStop[1, ], c(0.1, 0.1, 0, 0), tolerance = 1e-07) expect_equal(x21$earlyStop[2, ], c(0.8, 0.8, 0.7, 1), tolerance = 1e-07) expect_equal(x21$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x21$successPerStage[2, ], c(0, 0, 0.1, 0), tolerance = 1e-07) expect_equal(x21$successPerStage[3, ], c(0, 0.1, 0, 0), tolerance = 1e-07) expect_equal(unlist(as.list(x21$selectedArms)), c(1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.4, 0.3, 1, 0, 0, 1, 0.3, 0, 1, 0.3, 0, 1, 0, 0, 1, 0.3, 0, 1, 0.3, 0, 1, 0.2, 0, 1, 0.2, 0, 1, 0.1, 0, 1, 0.3, 0, 1, 0.5, 0, 1, 0.5, 0.1, 1, 0.6, 0, 1, 0.9, 0.1, 1, 0.9, 0.1, 1, 1, 0.3, 1, 1, 0), tolerance = 1e-07) expect_equal(x21$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x21$numberOfActiveArms[2, ], c(1.1111111, 1.2222222, 1.1, 1), tolerance = 1e-07) expect_equal(x21$numberOfActiveArms[3, ], c(1, 1, 1.3333333, NaN), tolerance = 1e-07) expect_equal(x21$expectedNumberOfSubjects, c(190.08367, 169.68391, 280.67025, NaN), tolerance = 1e-07) expect_equal(unlist(as.list(x21$sampleSizes)), c(10, 4.4952582, 40.457324, 10, 11.111111, 100, 10, 30.407004, 99.157615, 10, 0, NaN, 10, 19.514172, 0, 10, 21.967417, 0, 10, 0, 0, 10, 21.272121, NaN, 10, 25.406757, 0, 10, 11.52108, 0, 10, 16.622221, 0, 10, 10, NaN, 10, 25.603407, 0, 10, 20.034041, 0, 10, 38.558614, 33.333333, 10, 21.010924, NaN, 10, 71.638409, 40.457324, 10, 46.126253, 100, 10, 75.587839, 99.157615, 10, 52.283045, NaN), tolerance = 1e-07) expect_equal(x21$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x21$conditionalPowerAchieved[2, ], c(0.023159424, 0.14301241, 0.046563399, 0.11230633), tolerance = 1e-07) expect_equal(x21$conditionalPowerAchieved[3, ], c(0.07537462, 0.00060378387, 0.33359002, NaN), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x21), NA))) expect_output(print(x21)$show()) invisible(capture.output(expect_error(summary(x21), NA))) expect_output(summary(x21)$show()) x21CodeBased <- eval(parse(text = getObjectRCode(x21, stringWrapParagraphWidth = NULL))) expect_equal(x21CodeBased$iterations, x21$iterations, tolerance = 1e-05) expect_equal(x21CodeBased$rejectAtLeastOne, x21$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x21CodeBased$rejectedArmsPerStage, x21$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x21CodeBased$futilityStop, x21$futilityStop, tolerance = 1e-05) expect_equal(x21CodeBased$futilityPerStage, x21$futilityPerStage, tolerance = 1e-05) expect_equal(x21CodeBased$earlyStop, x21$earlyStop, tolerance = 1e-05) expect_equal(x21CodeBased$successPerStage, x21$successPerStage, tolerance = 1e-05) expect_equal(x21CodeBased$selectedArms, x21$selectedArms, tolerance = 1e-05) expect_equal(x21CodeBased$numberOfActiveArms, x21$numberOfActiveArms, tolerance = 1e-05) expect_equal(x21CodeBased$expectedNumberOfSubjects, x21$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x21CodeBased$sampleSizes, x21$sampleSizes, tolerance = 1e-05) expect_equal(x21CodeBased$conditionalPowerAchieved, x21$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x21), "character") df <- as.data.frame(x21) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x21) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x22 <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0.1, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.1, 0.3, 0.1), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 1) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x22' with expected results expect_equal(x22$iterations[1, ], c(1, 1, 1)) expect_equal(x22$iterations[2, ], c(1, 1, 1)) expect_equal(x22$iterations[3, ], c(0, 1, 1)) expect_equal(x22$rejectAtLeastOne, c(0, 0, 0)) expect_equal(unlist(as.list(x22$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x22$futilityStop, c(1, 0, 0)) expect_equal(x22$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x22$futilityPerStage[2, ], c(1, 0, 0)) expect_equal(x22$earlyStop[1, ], c(0, 0, 0)) expect_equal(x22$earlyStop[2, ], c(1, 0, 0)) expect_equal(x22$successPerStage[1, ], c(0, 0, 0)) expect_equal(x22$successPerStage[2, ], c(0, 0, 0)) expect_equal(x22$successPerStage[3, ], c(0, 0, 0)) expect_equal(unlist(as.list(x22$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1)) expect_equal(x22$numberOfActiveArms[1, ], c(4, 4, 4)) expect_equal(x22$numberOfActiveArms[2, ], c(1, 1, 1)) expect_equal(x22$numberOfActiveArms[3, ], c(NaN, 1, 1)) expect_equal(x22$expectedNumberOfSubjects, c(NaN, 450, 148.90979), tolerance = 1e-07) expect_equal(unlist(as.list(x22$sampleSizes)), c(10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 32.875253, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 100, 100, 10, 10.358511, 39.096382, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 32.875253, 0, 10, 100, 100, 10, 10.358511, 39.096382), tolerance = 1e-07) expect_equal(x22$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x22$conditionalPowerAchieved[2, ], c(0.011749146, 0.0034013018, 0.045375018), tolerance = 1e-07) expect_equal(x22$conditionalPowerAchieved[3, ], c(NaN, 0.15769372, 0.8), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x22), NA))) expect_output(print(x22)$show()) invisible(capture.output(expect_error(summary(x22), NA))) expect_output(summary(x22)$show()) x22CodeBased <- eval(parse(text = getObjectRCode(x22, stringWrapParagraphWidth = NULL))) expect_equal(x22CodeBased$iterations, x22$iterations, tolerance = 1e-05) expect_equal(x22CodeBased$rejectAtLeastOne, x22$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x22CodeBased$rejectedArmsPerStage, x22$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x22CodeBased$futilityStop, x22$futilityStop, tolerance = 1e-05) expect_equal(x22CodeBased$futilityPerStage, x22$futilityPerStage, tolerance = 1e-05) expect_equal(x22CodeBased$earlyStop, x22$earlyStop, tolerance = 1e-05) expect_equal(x22CodeBased$successPerStage, x22$successPerStage, tolerance = 1e-05) expect_equal(x22CodeBased$selectedArms, x22$selectedArms, tolerance = 1e-05) expect_equal(x22CodeBased$numberOfActiveArms, x22$numberOfActiveArms, tolerance = 1e-05) expect_equal(x22CodeBased$expectedNumberOfSubjects, x22$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x22CodeBased$sampleSizes, x22$sampleSizes, tolerance = 1e-05) expect_equal(x22CodeBased$conditionalPowerAchieved, x22$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x22), "character") df <- as.data.frame(x22) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x22) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationMultiArmMeans': using calcSubjectsFunction", { .skipTestIfDisabled() calcSubjectsFunctionSimulationMultiArmMeans <- function(..., stage, minNumberOfSubjectsPerStage) { return(ifelse(stage == 3, 33, minNumberOfSubjectsPerStage[stage])) } x <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), typeOfShape = "linear", activeArms = 4, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10, calcSubjectsFunction = calcSubjectsFunctionSimulationMultiArmMeans) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x' with expected results expect_equal(x$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x$iterations[3, ], c(9, 9, 8, 8)) expect_equal(x$rejectAtLeastOne, c(0.1, 0.1, 0.3, 0.4), tolerance = 1e-07) expect_equal(unlist(as.list(x$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0.1, 0, 0.1, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0.1, 0, 0.1, 0.1, 0, 0.2), tolerance = 1e-07) expect_equal(x$futilityStop, c(0, 0, 0, 0)) expect_equal(x$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x$earlyStop[2, ], c(0.1, 0.1, 0.2, 0.2), tolerance = 1e-07) expect_equal(x$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x$successPerStage[2, ], c(0.1, 0.1, 0.2, 0.2), tolerance = 1e-07) expect_equal(x$successPerStage[3, ], c(0, 0, 0.1, 0.2), tolerance = 1e-07) expect_equal(unlist(as.list(x$selectedArms)), c(1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.1, 0, 1, 0, 0, 1, 0.3, 0.3, 1, 0.4, 0.4, 1, 0, 0, 1, 0.3, 0.2, 1, 0.1, 0.1, 1, 0.3, 0.2, 1, 0.4, 0.4, 1, 0.1, 0.1, 1, 0.5, 0.4, 1, 0.2, 0.2, 1, 0.5, 0.4, 1, 0.6, 0.5, 1, 1, 0.9, 1, 1, 0.9, 1, 1, 0.8, 1, 1, 0.8), tolerance = 1e-07) expect_equal(x$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x$expectedNumberOfSubjects, c(117.4, 117.4, 110.8, 110.8), tolerance = 1e-07) expect_equal(unlist(as.list(x$sampleSizes)), c(10, 0.4, 3.6666667, 10, 0.4, 3.6666667, 10, 0.4, 0, 10, 0, 0, 10, 1.2, 11, 10, 1.6, 14.666667, 10, 0, 0, 10, 1.2, 8.25, 10, 0.4, 3.6666667, 10, 1.2, 7.3333333, 10, 1.6, 16.5, 10, 0.4, 4.125, 10, 2, 14.666667, 10, 0.8, 7.3333333, 10, 2, 16.5, 10, 2.4, 20.625, 10, 4, 33, 10, 4, 33, 10, 4, 33, 10, 4, 33), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$conditionalPowerAchieved[2, ], c(0.054038913, 0.015750083, 0.11207917, 0.055949011), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[3, ], c(0.44922292, 0.31010643, 0.28872426, 0.56321232), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x), NA))) expect_output(print(x)$show()) invisible(capture.output(expect_error(summary(x), NA))) expect_output(summary(x)$show()) xCodeBased <- eval(parse(text = getObjectRCode(x, stringWrapParagraphWidth = NULL))) expect_equal(xCodeBased$iterations, x$iterations, tolerance = 1e-05) expect_equal(xCodeBased$rejectAtLeastOne, x$rejectAtLeastOne, tolerance = 1e-05) expect_equal(xCodeBased$rejectedArmsPerStage, x$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$futilityStop, x$futilityStop, tolerance = 1e-05) expect_equal(xCodeBased$futilityPerStage, x$futilityPerStage, tolerance = 1e-05) expect_equal(xCodeBased$earlyStop, x$earlyStop, tolerance = 1e-05) expect_equal(xCodeBased$successPerStage, x$successPerStage, tolerance = 1e-05) expect_equal(xCodeBased$selectedArms, x$selectedArms, tolerance = 1e-05) expect_equal(xCodeBased$numberOfActiveArms, x$numberOfActiveArms, tolerance = 1e-05) expect_equal(xCodeBased$expectedNumberOfSubjects, x$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(xCodeBased$sampleSizes, x$sampleSizes, tolerance = 1e-05) expect_equal(xCodeBased$conditionalPowerAchieved, x$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x), "character") df <- as.data.frame(x) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationMultiArmMeans': using selectArmsFunction", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmMeans} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmMeansGenerate} # @refFS[Formula]{fs:SimulationMultiArmMeansTestStatistics} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} .skipTestIfDisabled() selectArmsFunctionSimulationMultiArmMeans <- function(effectSizes) { return(c(TRUE, FALSE, FALSE, FALSE)) } x <- getSimulationMultiArmMeans(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), typeOfShape = "linear", activeArms = 4, plannedSubjects = c(10, 30, 50), stDev = 1.2, muMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), maxNumberOfIterations = 10, selectArmsFunction = selectArmsFunctionSimulationMultiArmMeans, typeOfSelection = "userDefined") ## Comparison of the results of SimulationResultsMultiArmMeans object 'x' with expected results expect_equal(x$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x$iterations[3, ], c(10, 9, 9, 10)) expect_equal(x$rejectAtLeastOne, c(0.1, 0.1, 0.2, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x$rejectedArmsPerStage)), c(0, 0, 0, 0, 0.1, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.1, 0, 0), tolerance = 1e-07) expect_equal(x$futilityStop, c(0, 0, 0, 0)) expect_equal(x$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x$earlyStop[2, ], c(0, 0.1, 0.1, 0), tolerance = 1e-07) expect_equal(x$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x$successPerStage[2, ], c(0, 0.1, 0.1, 0), tolerance = 1e-07) expect_equal(x$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x$selectedArms)), c(1, 1, 1, 1, 1, 0.9, 1, 1, 0.9, 1, 1, 1, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 0.9, 1, 1, 0.9, 1, 1, 1), tolerance = 1e-07) expect_equal(x$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x$expectedNumberOfSubjects, c(130, 126, 126, 130)) expect_equal(unlist(as.list(x$sampleSizes)), c(10, 20, 20, 10, 20, 20, 10, 20, 20, 10, 20, 20, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 20, 20, 10, 20, 20, 10, 20, 20, 10, 20, 20)) expect_equal(x$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$conditionalPowerAchieved[2, ], c(0.091251689, 0.027836233, 0.13855746, 0.12908437), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[3, ], c(0.071420101, 0.027813347, 0.076509581, 0.21688562), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x), NA))) expect_output(print(x)$show()) invisible(capture.output(expect_error(summary(x), NA))) expect_output(summary(x)$show()) xCodeBased <- eval(parse(text = getObjectRCode(x, stringWrapParagraphWidth = NULL))) expect_equal(xCodeBased$iterations, x$iterations, tolerance = 1e-05) expect_equal(xCodeBased$rejectAtLeastOne, x$rejectAtLeastOne, tolerance = 1e-05) expect_equal(xCodeBased$rejectedArmsPerStage, x$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$futilityStop, x$futilityStop, tolerance = 1e-05) expect_equal(xCodeBased$futilityPerStage, x$futilityPerStage, tolerance = 1e-05) expect_equal(xCodeBased$earlyStop, x$earlyStop, tolerance = 1e-05) expect_equal(xCodeBased$successPerStage, x$successPerStage, tolerance = 1e-05) expect_equal(xCodeBased$selectedArms, x$selectedArms, tolerance = 1e-05) expect_equal(xCodeBased$numberOfActiveArms, x$numberOfActiveArms, tolerance = 1e-05) expect_equal(xCodeBased$expectedNumberOfSubjects, x$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(xCodeBased$sampleSizes, x$sampleSizes, tolerance = 1e-05) expect_equal(xCodeBased$conditionalPowerAchieved, x$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x), "character") df <- as.data.frame(x) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationMultiArmMeans': using intersectionTest = 'Sidak' and typeOfSelection = 'rBest'", { .skipTestIfDisabled() designIN <- getDesignInverseNormal(typeOfDesign = "P", kMax = 3, futilityBounds = c(0, 0)) x <- getSimulationMultiArmMeans(designIN, activeArms = 3, typeOfShape = "sigmoidEmax", muMaxVector = seq(0, 1, 0.2), gED50 = 2, plannedSubjects = cumsum(rep(20, 3)), intersectionTest = "Sidak", typeOfSelection = "rBest", rValue = 2, threshold = -Inf, successCriterion = "all", maxNumberOfIterations = 100, seed = 3456) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x' with expected results expect_equal(x$iterations[1, ], c(100, 100, 100, 100, 100, 100)) expect_equal(x$iterations[2, ], c(42, 52, 69, 77, 88, 87)) expect_equal(x$iterations[3, ], c(30, 33, 61, 73, 80, 61)) expect_equal(x$rejectAtLeastOne, c(0.02, 0.03, 0.18, 0.33, 0.49, 0.8), tolerance = 1e-07) expect_equal(unlist(as.list(x$rejectedArmsPerStage)), c(0, 0, 0.01, 0, 0, 0, 0.01, 0.01, 0.02, 0.03, 0.01, 0.02, 0.01, 0.01, 0.06, 0.1, 0.04, 0.04, 0.01, 0, 0, 0.01, 0.02, 0, 0.03, 0, 0.03, 0.04, 0.06, 0.08, 0.08, 0.11, 0.1, 0.14, 0.27, 0.12, 0, 0, 0, 0, 0.01, 0, 0.02, 0.01, 0.08, 0.08, 0.05, 0.11, 0.09, 0.16, 0.13, 0.18, 0.25, 0.24), tolerance = 1e-07) expect_equal(x$futilityStop, c(0.7, 0.66, 0.39, 0.23, 0.11, 0.07), tolerance = 1e-07) expect_equal(x$futilityPerStage[1, ], c(0.58, 0.48, 0.31, 0.22, 0.11, 0.07), tolerance = 1e-07) expect_equal(x$futilityPerStage[2, ], c(0.12, 0.18, 0.08, 0.01, 0, 0), tolerance = 1e-07) expect_equal(x$earlyStop[1, ], c(0.58, 0.48, 0.31, 0.23, 0.12, 0.13), tolerance = 1e-07) expect_equal(x$earlyStop[2, ], c(0.12, 0.19, 0.08, 0.04, 0.08, 0.26), tolerance = 1e-07) expect_equal(x$successPerStage[1, ], c(0, 0, 0, 0.01, 0.01, 0.06), tolerance = 1e-07) expect_equal(x$successPerStage[2, ], c(0, 0.01, 0, 0.03, 0.08, 0.26), tolerance = 1e-07) expect_equal(x$successPerStage[3, ], c(0, 0, 0.03, 0.1, 0.16, 0.2), tolerance = 1e-07) expect_equal(unlist(as.list(x$selectedArms)), c(1, 0.25, 0.17, 1, 0.25, 0.16, 1, 0.31, 0.26, 1, 0.32, 0.3, 1, 0.42, 0.41, 1, 0.32, 0.26, 1, 0.32, 0.22, 1, 0.43, 0.26, 1, 0.48, 0.45, 1, 0.56, 0.54, 1, 0.63, 0.56, 1, 0.7, 0.47, 1, 0.27, 0.21, 1, 0.36, 0.24, 1, 0.59, 0.51, 1, 0.66, 0.62, 1, 0.71, 0.63, 1, 0.72, 0.49, 1, 0.42, 0.3, 1, 0.52, 0.33, 1, 0.69, 0.61, 1, 0.77, 0.73, 1, 0.88, 0.8, 1, 0.87, 0.61), tolerance = 1e-07) expect_equal(x$numberOfActiveArms[1, ], c(3, 3, 3, 3, 3, 3)) expect_equal(x$numberOfActiveArms[2, ], c(2, 2, 2, 2, 2, 2)) expect_equal(x$numberOfActiveArms[3, ], c(2, 2, 2, 2, 2, 2)) expect_equal(x$expectedNumberOfSubjects, c(123.2, 131, 158, 170, 180.8, 168.8), tolerance = 1e-07) expect_equal(unlist(as.list(x$sampleSizes)), c(20, 11.904762, 11.333333, 20, 9.6153846, 9.6969697, 20, 8.9855072, 8.5245902, 20, 8.3116883, 8.2191781, 20, 9.5454545, 10.25, 20, 7.3563218, 8.5245902, 20, 15.238095, 14.666667, 20, 16.538462, 15.757576, 20, 13.913043, 14.754098, 20, 14.545455, 14.794521, 20, 14.318182, 14, 20, 16.091954, 15.409836, 20, 12.857143, 14, 20, 13.846154, 14.545455, 20, 17.101449, 16.721311, 20, 17.142857, 16.986301, 20, 16.136364, 15.75, 20, 16.551724, 16.065574, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$conditionalPowerAchieved[2, ], c(0.058967382, 0.048523877, 0.17154294, 0.22180985, 0.2182802, 0.37414282), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[3, ], c(0.077820194, 0.14430526, 0.21266388, 0.28752608, 0.40185892, 0.5016109), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x), NA))) expect_output(print(x)$show()) invisible(capture.output(expect_error(summary(x), NA))) expect_output(summary(x)$show()) xCodeBased <- eval(parse(text = getObjectRCode(x, stringWrapParagraphWidth = NULL))) expect_equal(xCodeBased$iterations, x$iterations, tolerance = 1e-05) expect_equal(xCodeBased$rejectAtLeastOne, x$rejectAtLeastOne, tolerance = 1e-05) expect_equal(xCodeBased$rejectedArmsPerStage, x$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$futilityStop, x$futilityStop, tolerance = 1e-05) expect_equal(xCodeBased$futilityPerStage, x$futilityPerStage, tolerance = 1e-05) expect_equal(xCodeBased$earlyStop, x$earlyStop, tolerance = 1e-05) expect_equal(xCodeBased$successPerStage, x$successPerStage, tolerance = 1e-05) expect_equal(xCodeBased$selectedArms, x$selectedArms, tolerance = 1e-05) expect_equal(xCodeBased$numberOfActiveArms, x$numberOfActiveArms, tolerance = 1e-05) expect_equal(xCodeBased$expectedNumberOfSubjects, x$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(xCodeBased$sampleSizes, x$sampleSizes, tolerance = 1e-05) expect_equal(xCodeBased$conditionalPowerAchieved, x$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x), "character") df <- as.data.frame(x) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationMultiArmMeans': plot drift - comparison of raw values", { .skipTestIfDisabled() designPureConditionalDunnett <- getDesignInverseNormal(typeOfDesign = "asUser", userAlphaSpending = c(0, 0.025)) designCombinationDunnett <- getDesignConditionalDunnett(informationAtInterim = 0.5, secondStageConditioning = TRUE) resultsPureConditionalDunnett <- getSimulationMultiArmMeans(designPureConditionalDunnett, activeArms = 3, muMaxVector = seq(0, 1, 0.2), typeOfShape = "linear", plannedSubjects = cumsum(rep(20, 2)), intersectionTest = "Dunnett", adaptations = TRUE, typeOfSelection = "best", effectMeasure = "effectEstimate", threshold = -Inf, maxNumberOfIterations = 100, allocationRatioPlanned = 1, seed = 123) resultsCombinationDunnett <- getSimulationMultiArmMeans(designCombinationDunnett, activeArms = 3, muMaxVector = seq(0, 1, 0.2), typeOfShape = "linear", plannedSubjects = cumsum(rep(20, 2)), intersectionTest = "Dunnett", adaptations = TRUE, typeOfSelection = "best", effectMeasure = "effectEstimate", threshold = -Inf, maxNumberOfIterations = 100, allocationRatioPlanned = 1, seed = 123) drift <- resultsPureConditionalDunnett$effectMatrix[nrow(resultsPureConditionalDunnett$effectMatrix), ] ## Comparison of the results of numeric object 'drift' with expected results expect_equal(drift, c(0, 0.2, 0.4, 0.6, 0.8, 1), tolerance = 1e-07) expect_equal(resultsPureConditionalDunnett$rejectAtLeastOne, resultsCombinationDunnett$rejectAtLeastOne, tolerance = 0.06) }) test_that("'getSimulationMultiArmMeans': comparison of base and multi-arm", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmMeans} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmMeansGenerate} # @refFS[Formula]{fs:SimulationMultiArmMeansTestStatistics} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} design <- getDesignInverseNormal(typeOfDesign = "WT", deltaWT = 0.15, futilityBounds = c(-0.5, 0), informationRates = c(0.4, 0.8, 1)) x <- getSimulationMultiArmMeans(design = design, activeArms = 1, plannedSubjects = c(20, 40, 60), stDev = 1.5, muMaxVector = seq(0, 1, 0.2), conditionalPower = 0.80, minNumberOfSubjectsPerStage = c(NA, 20, 20), maxNumberOfSubjectsPerStage = c(NA, 80, 80), #thetaH1 = 0.5, maxNumberOfIterations = 100, allocationRatioPlanned = 2, seed = 1234) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x' with expected results expect_equal(x$iterations[1, ], c(100, 100, 100, 100, 100, 100)) expect_equal(x$iterations[2, ], c(81, 88, 89, 88, 93, 79)) expect_equal(x$iterations[3, ], c(53, 70, 64, 51, 37, 12)) expect_equal(x$rejectAtLeastOne, c(0.01, 0.11, 0.39, 0.73, 0.93, 0.98), tolerance = 1e-07) expect_equal(unlist(as.list(x$rejectedArmsPerStage)), c(0, 0, 0.01, 0, 0.05, 0.06, 0.01, 0.22, 0.16, 0.02, 0.37, 0.34, 0.06, 0.56, 0.31, 0.2, 0.67, 0.11), tolerance = 1e-07) expect_equal(x$futilityStop, c(0.47, 0.25, 0.13, 0.1, 0.01, 0.01), tolerance = 1e-07) expect_equal(x$futilityPerStage[1, ], c(0.19, 0.12, 0.1, 0.1, 0.01, 0.01), tolerance = 1e-07) expect_equal(x$futilityPerStage[2, ], c(0.28, 0.13, 0.03, 0, 0, 0), tolerance = 1e-07) expect_equal(x$earlyStop[1, ], c(0.19, 0.12, 0.11, 0.12, 0.07, 0.21), tolerance = 1e-07) expect_equal(x$earlyStop[2, ], c(0.28, 0.18, 0.25, 0.37, 0.56, 0.67), tolerance = 1e-07) expect_equal(x$successPerStage[1, ], c(0, 0, 0.01, 0.02, 0.06, 0.2), tolerance = 1e-07) expect_equal(x$successPerStage[2, ], c(0, 0.05, 0.22, 0.37, 0.56, 0.67), tolerance = 1e-07) expect_equal(x$successPerStage[3, ], c(0.01, 0.06, 0.16, 0.34, 0.31, 0.11), tolerance = 1e-07) expect_equal(unlist(as.list(x$selectedArms)), c(1, 0.81, 0.53, 1, 0.88, 0.7, 1, 0.89, 0.64, 1, 0.88, 0.51, 1, 0.93, 0.37, 1, 0.79, 0.12, 1, 0.81, 0.53, 1, 0.88, 0.7, 1, 0.89, 0.64, 1, 0.88, 0.51, 1, 0.93, 0.37, 1, 0.79, 0.12), tolerance = 1e-07) expect_equal(x$numberOfActiveArms[1, ], c(1, 1, 1, 1, 1, 1)) expect_equal(x$numberOfActiveArms[2, ], c(1, 1, 1, 1, 1, 1)) expect_equal(x$numberOfActiveArms[3, ], c(1, 1, 1, 1, 1, 1)) expect_equal(x$expectedNumberOfSubjects, c(182.97526, 204.64426, 195.25807, 156.41809, 139.22312, 94.296637), tolerance = 1e-07) expect_equal(unlist(as.list(x$sampleSizes)), c(20, 74.777896, 78.138507, 20, 71.766138, 76.107578, 20, 69.720212, 75.189157, 20, 60.637889, 60.622327, 20, 55.732819, 56.713222, 20, 47.895918, 41.888746, 10, 37.388948, 39.069254, 10, 35.883069, 38.053789, 10, 34.860106, 37.594578, 10, 30.318944, 30.311164, 10, 27.86641, 28.356611, 10, 23.947959, 20.944373), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$conditionalPowerAchieved[2, ], c(0.22017652, 0.27054625, 0.3536952, 0.48224278, 0.56831776, 0.65933958), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[3, ], c(0.12006552, 0.18276066, 0.26908136, 0.50518351, 0.66786884, 0.67359844), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x), NA))) expect_output(print(x)$show()) invisible(capture.output(expect_error(summary(x), NA))) expect_output(summary(x)$show()) xCodeBased <- eval(parse(text = getObjectRCode(x, stringWrapParagraphWidth = NULL))) expect_equal(xCodeBased$iterations, x$iterations, tolerance = 1e-05) expect_equal(xCodeBased$rejectAtLeastOne, x$rejectAtLeastOne, tolerance = 1e-05) expect_equal(xCodeBased$rejectedArmsPerStage, x$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$futilityStop, x$futilityStop, tolerance = 1e-05) expect_equal(xCodeBased$futilityPerStage, x$futilityPerStage, tolerance = 1e-05) expect_equal(xCodeBased$earlyStop, x$earlyStop, tolerance = 1e-05) expect_equal(xCodeBased$successPerStage, x$successPerStage, tolerance = 1e-05) expect_equal(xCodeBased$selectedArms, x$selectedArms, tolerance = 1e-05) expect_equal(xCodeBased$numberOfActiveArms, x$numberOfActiveArms, tolerance = 1e-05) expect_equal(xCodeBased$expectedNumberOfSubjects, x$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(xCodeBased$sampleSizes, x$sampleSizes, tolerance = 1e-05) expect_equal(xCodeBased$conditionalPowerAchieved, x$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x), "character") df <- as.data.frame(x) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } allocationRatioPlanned <- 2 factor <- 1 + 1 / allocationRatioPlanned y <- getSimulationMeans(design, plannedSubjects = round(factor*c(20, 40, 60)), normalApproximation = TRUE, stDev = 1.5, conditionalPower = 0.80, minNumberOfSubjectsPerStage = round(factor*c(NA, 20, 20)), maxNumberOfSubjectsPerStage = round(factor*c(NA, 80, 80)), alternative = seq(0, 1, 0.2), #thetaH1 = 0.5, maxNumberOfIterations = 100, allocationRatioPlanned = allocationRatioPlanned, seed = 5678) comp1 <- y$overallReject - x$rejectAtLeastOne ## Comparison of the results of numeric object 'comp1' with expected results expect_equal(comp1, c(0.03, 0.07, -0.04, 0.01, 0.02, -0.02), tolerance = 1e-07) comp2 <- y$rejectPerStage - x$rejectedArmsPerStage[, , 1] ## Comparison of the results of matrixarray object 'comp2' with expected results expect_equal(comp2[1, ], c(0, 0.02, 0.01, -0.01, 0.04, -0.09), tolerance = 1e-07) expect_equal(comp2[2, ], c(0.03, 0, -0.07, 0.06, 0.02, 0.03), tolerance = 1e-07) expect_equal(comp2[3, ], c(0, 0.05, 0.02, -0.04, -0.04, 0.04), tolerance = 1e-07) comp3 <- y$futilityPerStage - x$futilityPerStage ## Comparison of the results of matrixarray object 'comp3' with expected results expect_equal(comp3[1, ], c(0.17, 0, 0.04, -0.04, 0, 0.02), tolerance = 1e-07) expect_equal(comp3[2, ], c(-0.05, 0.01, 0, 0, 0, 0), tolerance = 1e-07) comp4 <- round(y$sampleSizes - (x$sampleSizes[, , 1] + x$sampleSizes[, , 2]), 1) ## Comparison of the results of matrixarray object 'comp4' with expected results expect_equal(comp4[1, ], c(0, 0, 0, 0, 0, 0)) expect_equal(comp4[2, ], c(-2.8, -1.3, -0.3, -0.1, -1.4, 10.8), tolerance = 1e-07) expect_equal(comp4[3, ], c(1.7, -3.3, -3.4, 13.2, -9.7, -6.7), tolerance = 1e-07) comp5 <- round(y$expectedNumberOfSubjects - x$expectedNumberOfSubjects, 1) ## Comparison of the results of numeric object 'comp5' with expected results expect_equal(comp5, c(-37.8, -8.9, -5.5, 10.1, -12.7, 15.8), tolerance = 1e-07) comp6 <- x$earlyStop - y$earlyStop ## Comparison of the results of matrixarray object 'comp6' with expected results expect_equal(comp6[1, ], c(-0.43, -0.22, -0.58, -0.5, -0.27, -0.48), tolerance = 1e-07) expect_equal(comp6[2, ], c(-0.05, -0.32, -0.59, 0.04, 0.06, -0.17), tolerance = 1e-07) }) test_that("'getSimulationMultiArmMeans': comparison of base and multi-arm, Fisher design", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmMeans} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmMeansGenerate} # @refFS[Formula]{fs:SimulationMultiArmMeansTestStatistics} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} design <- getDesignFisher(alpha0Vec = c(0.3, 0.4), informationRates = c(0.3, 0.6, 1)) x <- getSimulationMultiArmMeans(design = design, activeArms = 1, plannedSubjects = c(20, 40, 60), stDev = 1.5, muMaxVector = seq(0, 1, 0.2), conditionalPower = 0.80, minNumberOfSubjectsPerStage = c(NA, 20, 20), maxNumberOfSubjectsPerStage = c(NA, 80, 80), #thetaH1 = 0.5, maxNumberOfIterations = 100, allocationRatioPlanned = 2, seed = 1234) ## Comparison of the results of SimulationResultsMultiArmMeans object 'x' with expected results expect_equal(x$iterations[1, ], c(100, 100, 100, 100, 100, 100)) expect_equal(x$iterations[2, ], c(28, 41, 50, 54, 56, 51)) expect_equal(x$iterations[3, ], c(7, 24, 27, 21, 24, 7)) expect_equal(x$rejectAtLeastOne, c(0.03, 0.08, 0.28, 0.61, 0.75, 0.89), tolerance = 1e-07) expect_equal(unlist(as.list(x$rejectedArmsPerStage)), c(0.02, 0, 0.01, 0.05, 0.01, 0.02, 0.05, 0.16, 0.07, 0.17, 0.3, 0.14, 0.24, 0.31, 0.2, 0.39, 0.44, 0.06), tolerance = 1e-07) expect_equal(x$futilityStop, c(0.91, 0.7, 0.52, 0.32, 0.21, 0.1), tolerance = 1e-07) expect_equal(x$futilityPerStage[1, ], c(0.7, 0.54, 0.45, 0.29, 0.2, 0.1), tolerance = 1e-07) expect_equal(x$futilityPerStage[2, ], c(0.21, 0.16, 0.07, 0.03, 0.01, 0), tolerance = 1e-07) expect_equal(x$earlyStop[1, ], c(0.72, 0.59, 0.5, 0.46, 0.44, 0.49), tolerance = 1e-07) expect_equal(x$earlyStop[2, ], c(0.21, 0.17, 0.23, 0.33, 0.32, 0.44), tolerance = 1e-07) expect_equal(x$successPerStage[1, ], c(0.02, 0.05, 0.05, 0.17, 0.24, 0.39), tolerance = 1e-07) expect_equal(x$successPerStage[2, ], c(0, 0.01, 0.16, 0.3, 0.31, 0.44), tolerance = 1e-07) expect_equal(x$successPerStage[3, ], c(0.01, 0.02, 0.07, 0.14, 0.2, 0.06), tolerance = 1e-07) expect_equal(unlist(as.list(x$selectedArms)), c(1, 0.28, 0.07, 1, 0.41, 0.24, 1, 0.5, 0.27, 1, 0.54, 0.21, 1, 0.56, 0.24, 1, 0.51, 0.07, 1, 0.28, 0.07, 1, 0.41, 0.24, 1, 0.5, 0.27, 1, 0.54, 0.21, 1, 0.56, 0.24, 1, 0.51, 0.07), tolerance = 1e-07) expect_equal(x$numberOfActiveArms[1, ], c(1, 1, 1, 1, 1, 1)) expect_equal(x$numberOfActiveArms[2, ], c(1, 1, 1, 1, 1, 1)) expect_equal(x$numberOfActiveArms[3, ], c(1, 1, 1, 1, 1, 1)) expect_equal(x$expectedNumberOfSubjects, c(68.211396, 101.92536, 114.30453, 107.14861, 109.24288, 79.622055), tolerance = 1e-07) expect_equal(unlist(as.list(x$sampleSizes)), c(20, 70.979514, 80, 20, 71.410143, 77.800325, 20, 69.572428, 79.321509, 20, 66.884783, 72.926791, 20, 62.423876, 74.4634, 20, 55.785406, 66.154471, 10, 35.489757, 40, 10, 35.705072, 38.900163, 10, 34.786214, 39.660755, 10, 33.442392, 36.463396, 10, 31.211938, 37.2317, 10, 27.892703, 33.077236), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$conditionalPowerAchieved[2, ], c(0.53965216, 0.44870166, 0.54176291, 0.51257459, 0.62161545, 0.65580386), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[3, ], c(0.33271205, 0.28302479, 0.35942136, 0.59988705, 0.63386368, 0.5469144), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x), NA))) expect_output(print(x)$show()) invisible(capture.output(expect_error(summary(x), NA))) expect_output(summary(x)$show()) xCodeBased <- eval(parse(text = getObjectRCode(x, stringWrapParagraphWidth = NULL))) expect_equal(xCodeBased$iterations, x$iterations, tolerance = 1e-05) expect_equal(xCodeBased$rejectAtLeastOne, x$rejectAtLeastOne, tolerance = 1e-05) expect_equal(xCodeBased$rejectedArmsPerStage, x$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$futilityStop, x$futilityStop, tolerance = 1e-05) expect_equal(xCodeBased$futilityPerStage, x$futilityPerStage, tolerance = 1e-05) expect_equal(xCodeBased$earlyStop, x$earlyStop, tolerance = 1e-05) expect_equal(xCodeBased$successPerStage, x$successPerStage, tolerance = 1e-05) expect_equal(xCodeBased$selectedArms, x$selectedArms, tolerance = 1e-05) expect_equal(xCodeBased$numberOfActiveArms, x$numberOfActiveArms, tolerance = 1e-05) expect_equal(xCodeBased$expectedNumberOfSubjects, x$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(xCodeBased$sampleSizes, x$sampleSizes, tolerance = 1e-05) expect_equal(xCodeBased$conditionalPowerAchieved, x$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x), "character") df <- as.data.frame(x) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } allocationRatioPlanned <- 2 factor <- 1 + 1 / allocationRatioPlanned y <- getSimulationMeans(design, plannedSubjects = round(factor*c(20, 40, 60)), normalApproximation = TRUE, stDev = 1.5, conditionalPower = 0.80, minNumberOfSubjectsPerStage = round(factor*c(NA, 20, 20)), maxNumberOfSubjectsPerStage = round(factor*c(NA, 80, 80)), alternative = seq(0, 1, 0.2), #thetaH1 = 0.5, maxNumberOfIterations = 100, allocationRatioPlanned = allocationRatioPlanned, seed = 5678) comp1 <- y$overallReject - x$rejectAtLeastOne ## Comparison of the results of numeric object 'comp1' with expected results expect_equal(comp1, c(-0.01, 0.02, 0.05, -0.03, -0.04, -0.04), tolerance = 1e-07) comp2 <- y$rejectPerStage - x$rejectedArmsPerStage[, , 1] ## Comparison of the results of matrixarray object 'comp2' with expected results expect_equal(comp2[1, ], c(-0.01, -0.02, 0.05, -0.01, -0.05, -0.06), tolerance = 1e-07) expect_equal(comp2[2, ], c(0.01, 0.03, -0.07, -0.08, 0.04, 0.05), tolerance = 1e-07) expect_equal(comp2[3, ], c(-0.01, 0.01, 0.07, 0.06, -0.03, -0.03), tolerance = 1e-07) comp3 <- y$futilityPerStage - x$futilityPerStage ## Comparison of the results of matrixarray object 'comp3' with expected results expect_equal(comp3[1, ], c(0.08, 0.03, 0.01, 0.04, 0.02, 0.04), tolerance = 1e-07) expect_equal(comp3[2, ], c(-0.1, 0.03, 0, 0, 0.03, 0.01), tolerance = 1e-07) comp4 <- round(y$sampleSizes - (x$sampleSizes[, , 1] + x$sampleSizes[, , 2]), 1) ## Comparison of the results of matrixarray object 'comp4' with expected results expect_equal(comp4[1, ], c(0, 0, 0, 0, 0, 0)) expect_equal(comp4[2, ], c(-3.6, -5.8, 8.4, 5.5, -3.5, 4.7), tolerance = 1e-07) expect_equal(comp4[3, ], c(0, -1.8, -3.2, 7.1, -0.8, -19), tolerance = 1e-07) comp5 <- round(y$expectedNumberOfSubjects - x$expectedNumberOfSubjects, 1) ## Comparison of the results of numeric object 'comp5' with expected results expect_equal(comp5, c(-5.8, -11.9, -2.3, 7.1, -3.9, -0.3), tolerance = 1e-07) comp6 <- x$earlyStop - y$earlyStop ## Comparison of the results of matrixarray object 'comp6' with expected results expect_equal(comp6[1, ], c(-0.19, -0.13, -0.3, -0.45, -0.28, -0.31), tolerance = 1e-07) expect_equal(comp6[2, ], c(-0.62, -0.57, -0.74, -0.5, -0.42, -0.53), tolerance = 1e-07) }) rpact/tests/testthat/test-f_simulation_enrichment_survival.R0000644000175000017500000014470714156371331024500 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_simulation_enrichment_survival.R ## | Creation date: 14 December 2021, 13:06:46 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Simulation Enrichment Survival Function") test_that("'getSimulationEnrichmentSurvival': gMax = 2", { options(warn = -1) # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:enrichmentDesigns} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:subsec:adaptiveClosedTestProcedureEnrichment} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:sec:simulationFunctions} # @refFS[Sec.]{fs:sec:simulatingEnrichmentDesigns} # @refFS[Sec.]{fs:sec:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichment} # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentSurvival} # @refFS[Formula]{fs:simulationEnrichmentSurvivalGenerate} # @refFS[Formula]{fs:simulationEnrichmentSurvivalEvents} # @refFS[Formula]{fs:simulationEnrichmentSurvivalLogRanks} # @refFS[Formula]{fs:simulationEnrichmentSurvivalAdjustedPrevalances} # @refFS[Formula]{fs:simulationEnrichmentSelections} # @refFS[Formula]{fs:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:enrichmentRejectionRule} hazardRatios <- matrix(c( 1.000000, 1.207775, 1.432188, 1.676140, 1.943358, 2.238755, 2.568980, 1.432188, 1.432188, 1.432188, 1.432188, 1.432188, 1.432188, 1.432188 ), ncol = 2) effectList <- list(subGroups = c("S", "R"), prevalences = c(0.4, 0.6), hazardRatios = hazardRatios) design <- getDesignInverseNormal(informationRates = c(0.3, 1), typeOfDesign = "asUser", userAlphaSpending = c(0.01, 0.025)) suppressWarnings(simResult1 <- getSimulationEnrichmentSurvival(design, plannedEvents = c(40, 120), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 1, typeOfSelection = "rbest", rValue = 2, intersectionTest = "SpiessensDebois", directionUpper = TRUE, seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentSurvival object 'simResult1' with expected results expect_equal(simResult1$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult1$iterations[2, ], c(100, 100, 100, 100, 96, 92, 89)) expect_equal(simResult1$rejectAtLeastOne, c(0.15, 0.25, 0.57, 0.69, 0.93, 0.97, 1), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$rejectedPopulationsPerStage)), c(0, 0.01, 0.02, 0.06, 0.05, 0.16, 0.03, 0.3, 0.17, 0.52, 0.19, 0.66, 0.35, 0.58, 0.04, 0.1, 0.01, 0.18, 0.12, 0.34, 0.12, 0.47, 0.23, 0.54, 0.18, 0.71, 0.29, 0.6), tolerance = 1e-07) expect_equal(simResult1$futilityPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult1$earlyStop[1, ], c(0, 0, 0, 0, 0.04, 0.08, 0.11), tolerance = 1e-07) expect_equal(simResult1$successPerStage[1, ], c(0, 0, 0, 0, 0.04, 0.08, 0.11), tolerance = 1e-07) expect_equal(simResult1$successPerStage[2, ], c(0, 0.02, 0.1, 0.23, 0.49, 0.69, 0.71), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$selectedPopulations)), c(1, 1, 1, 1, 1, 1, 1, 1, 1, 0.96, 1, 0.92, 1, 0.89, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0.96, 1, 0.92, 1, 0.89), tolerance = 1e-07) expect_equal(simResult1$numberOfPopulations[1, ], c(2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult1$numberOfPopulations[2, ], c(2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult1$expectedNumberOfEvents, c(120, 120, 120, 120, 116.8, 113.6, 111.2), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$singleNumberOfEventsPerStage)), c(14.163599, 28.327198, 15.080284, 30.160567, 16, 32, 16.925752, 33.851505, 17.861157, 35.722315, 18.810731, 37.621462, 19.780244, 39.560487, 25.836401, 51.672802, 24.919716, 49.839433, 24, 48, 23.074248, 46.148495, 22.138843, 44.277685, 21.189269, 42.378538, 20.219756, 40.439513), tolerance = 1e-07) expect_equal(simResult1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult1$conditionalPowerAchieved[2, ], c(0.089064808, 0.19781497, 0.26401795, 0.43542559, 0.54534009, 0.59195655, 0.7433686), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult1), NA))) expect_output(print(simResult1)$show()) invisible(capture.output(expect_error(summary(simResult1), NA))) expect_output(summary(simResult1)$show()) simResult1CodeBased <- eval(parse(text = getObjectRCode(simResult1, stringWrapParagraphWidth = NULL))) expect_equal(simResult1CodeBased$iterations, simResult1$iterations, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectAtLeastOne, simResult1$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectedPopulationsPerStage, simResult1$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$futilityPerStage, simResult1$futilityPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$earlyStop, simResult1$earlyStop, tolerance = 1e-05) expect_equal(simResult1CodeBased$successPerStage, simResult1$successPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$selectedPopulations, simResult1$selectedPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$numberOfPopulations, simResult1$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$expectedNumberOfEvents, simResult1$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simResult1CodeBased$eventsPerStage, simResult1$eventsPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$singleNumberOfEventsPerStage, simResult1$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$conditionalPowerAchieved, simResult1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult1), "character") df <- as.data.frame(simResult1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult2 <- getSimulationEnrichmentSurvival(design, populations = 2, plannedEvents = c(40, 120), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 1, typeOfSelection = "rbest", rValue = 2, intersectionTest = "Simes", directionUpper = TRUE, seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentSurvival object 'simResult2' with expected results expect_equal(simResult2$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult2$iterations[2, ], c(100, 100, 100, 100, 96, 91, 89)) expect_equal(simResult2$rejectAtLeastOne, c(0.13, 0.23, 0.56, 0.66, 0.93, 0.95, 1), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$rejectedPopulationsPerStage)), c(0, 0, 0.02, 0.05, 0.05, 0.14, 0.03, 0.29, 0.16, 0.53, 0.2, 0.64, 0.35, 0.58, 0.04, 0.09, 0.01, 0.17, 0.12, 0.35, 0.12, 0.45, 0.23, 0.54, 0.18, 0.69, 0.28, 0.61), tolerance = 1e-07) expect_equal(simResult2$futilityPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult2$earlyStop[1, ], c(0, 0, 0, 0, 0.04, 0.09, 0.11), tolerance = 1e-07) expect_equal(simResult2$successPerStage[1, ], c(0, 0, 0, 0, 0.04, 0.09, 0.11), tolerance = 1e-07) expect_equal(simResult2$successPerStage[2, ], c(0, 0.02, 0.1, 0.23, 0.49, 0.67, 0.71), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$selectedPopulations)), c(1, 1, 1, 1, 1, 1, 1, 1, 1, 0.96, 1, 0.91, 1, 0.89, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0.96, 1, 0.91, 1, 0.89), tolerance = 1e-07) expect_equal(simResult2$numberOfPopulations[1, ], c(2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult2$numberOfPopulations[2, ], c(2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult2$expectedNumberOfEvents, c(120, 120, 120, 120, 116.8, 112.8, 111.2), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$singleNumberOfEventsPerStage)), c(14.163599, 28.327198, 15.080284, 30.160567, 16, 32, 16.925752, 33.851505, 17.861157, 35.722315, 18.810731, 37.621462, 19.780244, 39.560487, 25.836401, 51.672802, 24.919716, 49.839433, 24, 48, 23.074248, 46.148495, 22.138843, 44.277685, 21.189269, 42.378538, 20.219756, 40.439513), tolerance = 1e-07) expect_equal(simResult2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult2$conditionalPowerAchieved[2, ], c(0.089064808, 0.19781497, 0.26401795, 0.43542559, 0.54534009, 0.58757942, 0.7433686), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult2), NA))) expect_output(print(simResult2)$show()) invisible(capture.output(expect_error(summary(simResult2), NA))) expect_output(summary(simResult2)$show()) simResult2CodeBased <- eval(parse(text = getObjectRCode(simResult2, stringWrapParagraphWidth = NULL))) expect_equal(simResult2CodeBased$iterations, simResult2$iterations, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectAtLeastOne, simResult2$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectedPopulationsPerStage, simResult2$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$futilityPerStage, simResult2$futilityPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$earlyStop, simResult2$earlyStop, tolerance = 1e-05) expect_equal(simResult2CodeBased$successPerStage, simResult2$successPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$selectedPopulations, simResult2$selectedPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$numberOfPopulations, simResult2$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$expectedNumberOfEvents, simResult2$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simResult2CodeBased$eventsPerStage, simResult2$eventsPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$singleNumberOfEventsPerStage, simResult2$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$conditionalPowerAchieved, simResult2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult2), "character") df <- as.data.frame(simResult2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult3 <- getSimulationEnrichmentSurvival(design, populations = 2, plannedEvents = c(40, 120), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 1, typeOfSelection = "best", intersectionTest = "Sidak", directionUpper = TRUE, seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentSurvival object 'simResult3' with expected results expect_equal(simResult3$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult3$iterations[2, ], c(100, 100, 100, 100, 96, 92, 89)) expect_equal(simResult3$rejectAtLeastOne, c(0.14, 0.18, 0.55, 0.72, 0.89, 0.96, 0.99), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$rejectedPopulationsPerStage)), c(0, 0.01, 0.02, 0.04, 0.05, 0.16, 0.03, 0.36, 0.16, 0.45, 0.19, 0.48, 0.35, 0.36, 0.04, 0.09, 0.01, 0.11, 0.12, 0.22, 0.12, 0.24, 0.23, 0.09, 0.17, 0.21, 0.28, 0.13), tolerance = 1e-07) expect_equal(simResult3$futilityPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult3$earlyStop[1, ], c(0, 0, 0, 0, 0.04, 0.08, 0.11), tolerance = 1e-07) expect_equal(simResult3$successPerStage[1, ], c(0, 0, 0, 0, 0.04, 0.08, 0.11), tolerance = 1e-07) expect_equal(simResult3$successPerStage[2, ], c(0.14, 0.18, 0.55, 0.72, 0.85, 0.88, 0.88), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$selectedPopulations)), c(1, 0.36, 1, 0.46, 1, 0.52, 1, 0.51, 1, 0.61, 1, 0.62, 1, 0.6, 1, 0.64, 1, 0.54, 1, 0.48, 1, 0.49, 1, 0.35, 1, 0.3, 1, 0.29), tolerance = 1e-07) expect_equal(simResult3$numberOfPopulations[1, ], c(2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult3$numberOfPopulations[2, ], c(1, 1, 1, 1, 1, 1, 1)) expect_equal(simResult3$expectedNumberOfEvents, c(120, 120, 120, 120, 116.8, 113.6, 111.2), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$singleNumberOfEventsPerStage)), c(14.163599, 46.929406, 15.080284, 53.086706, 16, 56.96, 16.925752, 57.387237, 17.861157, 63.857094, 18.810731, 66.180911, 19.780244, 66.82308, 25.836401, 33.070594, 24.919716, 26.913294, 24, 23.04, 23.074248, 22.612763, 22.138843, 16.142906, 21.189269, 13.819089, 20.219756, 13.17692), tolerance = 1e-07) expect_equal(simResult3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult3$conditionalPowerAchieved[2, ], c(0.089064808, 0.19781497, 0.26401795, 0.43542559, 0.54534009, 0.59195655, 0.7433686), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult3), NA))) expect_output(print(simResult3)$show()) invisible(capture.output(expect_error(summary(simResult3), NA))) expect_output(summary(simResult3)$show()) simResult3CodeBased <- eval(parse(text = getObjectRCode(simResult3, stringWrapParagraphWidth = NULL))) expect_equal(simResult3CodeBased$iterations, simResult3$iterations, tolerance = 1e-05) expect_equal(simResult3CodeBased$rejectAtLeastOne, simResult3$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult3CodeBased$rejectedPopulationsPerStage, simResult3$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$futilityPerStage, simResult3$futilityPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$earlyStop, simResult3$earlyStop, tolerance = 1e-05) expect_equal(simResult3CodeBased$successPerStage, simResult3$successPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$selectedPopulations, simResult3$selectedPopulations, tolerance = 1e-05) expect_equal(simResult3CodeBased$numberOfPopulations, simResult3$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult3CodeBased$expectedNumberOfEvents, simResult3$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simResult3CodeBased$eventsPerStage, simResult3$eventsPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$singleNumberOfEventsPerStage, simResult3$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$conditionalPowerAchieved, simResult3$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult3), "character") df <- as.data.frame(simResult3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult4 <- getSimulationEnrichmentSurvival(design, populations = 2, plannedEvents = c(40, 120), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 1, typeOfSelection = "epsilon", epsilonValue = 0.1, intersectionTest = "Bonferroni", directionUpper = TRUE, seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentSurvival object 'simResult4' with expected results expect_equal(simResult4$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult4$iterations[2, ], c(95, 95, 99, 99, 96, 92, 89)) expect_equal(simResult4$rejectAtLeastOne, c(0.13, 0.17, 0.54, 0.71, 0.87, 0.96, 0.99), tolerance = 1e-07) expect_equal(unlist(as.list(simResult4$rejectedPopulationsPerStage)), c(0, 0.01, 0.02, 0.05, 0.05, 0.15, 0.03, 0.35, 0.16, 0.43, 0.19, 0.5, 0.35, 0.39, 0.04, 0.08, 0.01, 0.1, 0.12, 0.23, 0.12, 0.24, 0.23, 0.11, 0.17, 0.24, 0.28, 0.15), tolerance = 1e-07) expect_equal(simResult4$futilityPerStage[1, ], c(0.05, 0.05, 0.01, 0.01, 0, 0, 0), tolerance = 1e-07) expect_equal(simResult4$earlyStop[1, ], c(0.05, 0.05, 0.01, 0.01, 0.04, 0.08, 0.11), tolerance = 1e-07) expect_equal(simResult4$successPerStage[1, ], c(0, 0, 0, 0, 0.04, 0.08, 0.11), tolerance = 1e-07) expect_equal(simResult4$successPerStage[2, ], c(0.11, 0.17, 0.5, 0.67, 0.82, 0.87, 0.87), tolerance = 1e-07) expect_equal(unlist(as.list(simResult4$selectedPopulations)), c(1, 0.38, 1, 0.51, 1, 0.57, 1, 0.54, 1, 0.62, 1, 0.65, 1, 0.63, 1, 0.63, 1, 0.54, 1, 0.52, 1, 0.5, 1, 0.38, 1, 0.34, 1, 0.32), tolerance = 1e-07) expect_equal(simResult4$numberOfPopulations[1, ], c(2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult4$numberOfPopulations[2, ], c(1.0631579, 1.1052632, 1.1010101, 1.0505051, 1.0416667, 1.076087, 1.0674157), tolerance = 1e-07) expect_equal(simResult4$expectedNumberOfEvents, c(116, 116, 119.2, 119.2, 116.8, 113.6, 111.2), tolerance = 1e-07) expect_equal(unlist(as.list(simResult4$singleNumberOfEventsPerStage)), c(14.163599, 45.732773, 15.080284, 51.670217, 16, 54.787879, 16.925752, 56.692679, 17.861157, 62.473416, 18.810731, 64.338366, 19.780244, 65.45995, 25.836401, 34.267227, 24.919716, 28.329783, 24, 25.212121, 23.074248, 23.307321, 22.138843, 17.526584, 21.189269, 15.661634, 20.219756, 14.54005), tolerance = 1e-07) expect_equal(simResult4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult4$conditionalPowerAchieved[2, ], c(0.093752429, 0.20822629, 0.2666848, 0.43982382, 0.54534009, 0.59195655, 0.7433686), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult4), NA))) expect_output(print(simResult4)$show()) invisible(capture.output(expect_error(summary(simResult4), NA))) expect_output(summary(simResult4)$show()) simResult4CodeBased <- eval(parse(text = getObjectRCode(simResult4, stringWrapParagraphWidth = NULL))) expect_equal(simResult4CodeBased$iterations, simResult4$iterations, tolerance = 1e-05) expect_equal(simResult4CodeBased$rejectAtLeastOne, simResult4$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult4CodeBased$rejectedPopulationsPerStage, simResult4$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$futilityPerStage, simResult4$futilityPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$earlyStop, simResult4$earlyStop, tolerance = 1e-05) expect_equal(simResult4CodeBased$successPerStage, simResult4$successPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$selectedPopulations, simResult4$selectedPopulations, tolerance = 1e-05) expect_equal(simResult4CodeBased$numberOfPopulations, simResult4$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult4CodeBased$expectedNumberOfEvents, simResult4$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simResult4CodeBased$eventsPerStage, simResult4$eventsPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$singleNumberOfEventsPerStage, simResult4$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$conditionalPowerAchieved, simResult4$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult4), "character") df <- as.data.frame(simResult4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationEnrichmentSurvival': gMax = 3", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:enrichmentDesigns} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:subsec:adaptiveClosedTestProcedureEnrichment} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:sec:simulationFunctions} # @refFS[Sec.]{fs:sec:simulatingEnrichmentDesigns} # @refFS[Sec.]{fs:sec:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:simulationEnrichmentSurvivalGenerate} # @refFS[Formula]{fs:simulationEnrichmentSurvivalEvents} # @refFS[Formula]{fs:simulationEnrichmentSurvivalLogRanks} # @refFS[Formula]{fs:simulationEnrichmentSurvivalAdjustedPrevalances} # @refFS[Formula]{fs:simulationEnrichmentSelections} # @refFS[Formula]{fs:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:enrichmentRejectionRule} .skipTestIfDisabled() subGroups <- c("S1", "S12", "S2", "R") prevalences <- c(0.20, 0.30, 0.40, 0.1) hazardRatios <- matrix(c(1.432, 1.432, 1.943, 1.943, 1.432, 1.432, 1.432, 1.432, 1.943, 1.943, 1.943, 1.943, 1.943, 2.569, 1.943, 2.569), ncol = 4) effectList <- list(subGroups = subGroups, prevalences = prevalences, hazardRatios = hazardRatios) design <- getDesignInverseNormal(informationRates = c(0.4, 0.8, 1), typeOfDesign = "noEarlyEfficacy") suppressWarnings(simResult1 <- getSimulationEnrichmentSurvival(design, plannedEvents = c(20, 40, 50), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 1, typeOfSelection = "best", intersectionTest = "Sidak", directionUpper = TRUE, seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentSurvival object 'simResult1' with expected results expect_equal(simResult1$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simResult1$iterations[2, ], c(100, 100, 100, 100)) expect_equal(simResult1$iterations[3, ], c(100, 100, 100, 100)) expect_equal(simResult1$rejectAtLeastOne, c(0.54, 0.47, 0.52, 0.5), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$rejectedPopulationsPerStage)), c(0, 0, 0.06, 0, 0, 0.09, 0, 0, 0.1, 0, 0, 0.14, 0, 0, 0.23, 0, 0, 0.23, 0, 0, 0.22, 0, 0, 0.16, 0, 0, 0.25, 0, 0, 0.15, 0, 0, 0.2, 0, 0, 0.2), tolerance = 1e-07) expect_equal(simResult1$futilityStop, c(0, 0, 0, 0)) expect_equal(simResult1$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(simResult1$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(simResult1$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(simResult1$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(simResult1$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(simResult1$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(simResult1$successPerStage[3, ], c(0.54, 0.47, 0.52, 0.5), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$selectedPopulations)), c(1, 0.2, 0.2, 1, 0.31, 0.31, 1, 0.22, 0.22, 1, 0.32, 0.32, 1, 0.39, 0.39, 1, 0.38, 0.38, 1, 0.44, 0.44, 1, 0.36, 0.36, 1, 0.41, 0.41, 1, 0.31, 0.31, 1, 0.34, 0.34, 1, 0.32, 0.32), tolerance = 1e-07) expect_equal(simResult1$numberOfPopulations[1, ], c(3, 3, 3, 3)) expect_equal(simResult1$numberOfPopulations[2, ], c(1, 1, 1, 1)) expect_equal(simResult1$numberOfPopulations[3, ], c(1, 1, 1, 1)) expect_equal(simResult1$expectedNumberOfEvents, c(50, 50, 50, 50)) expect_equal(unlist(as.list(simResult1$singleNumberOfEventsPerStage)), c(3.6197209, 3.0840856, 1.5420428, 3.5373259, 3.576571, 1.7882855, 4.2198086, 3.399414, 1.699707, 4.1271956, 4.1784177, 2.0892088, 8.7605581, 8.4073103, 4.2036551, 8.5611432, 7.345962, 3.672981, 8.4396172, 8.3023207, 4.1511603, 8.2543912, 7.086465, 3.5432325, 5.4295814, 7.6106469, 3.8053235, 5.3059889, 8.272849, 4.1364245, 5.23067, 7.5808978, 3.7904489, 5.1158714, 7.934304, 3.967152, 2.1901395, 0.89795721, 0.4489786, 2.595542, 0.80461801, 0.40230901, 2.1099043, 0.71736746, 0.35868373, 2.5025418, 0.80081338, 0.40040669), tolerance = 1e-07) expect_equal(simResult1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult1$conditionalPowerAchieved[2, ], c(0, 0, 0, 0)) expect_equal(simResult1$conditionalPowerAchieved[3, ], c(0.55391468, 0.55749541, 0.54642151, 0.56972631), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult1), NA))) expect_output(print(simResult1)$show()) invisible(capture.output(expect_error(summary(simResult1), NA))) expect_output(summary(simResult1)$show()) simResult1CodeBased <- eval(parse(text = getObjectRCode(simResult1, stringWrapParagraphWidth = NULL))) expect_equal(simResult1CodeBased$iterations, simResult1$iterations, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectAtLeastOne, simResult1$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectedPopulationsPerStage, simResult1$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$futilityStop, simResult1$futilityStop, tolerance = 1e-05) expect_equal(simResult1CodeBased$futilityPerStage, simResult1$futilityPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$earlyStop, simResult1$earlyStop, tolerance = 1e-05) expect_equal(simResult1CodeBased$successPerStage, simResult1$successPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$selectedPopulations, simResult1$selectedPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$numberOfPopulations, simResult1$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$expectedNumberOfEvents, simResult1$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simResult1CodeBased$eventsPerStage, simResult1$eventsPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$singleNumberOfEventsPerStage, simResult1$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$conditionalPowerAchieved, simResult1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult1), "character") df <- as.data.frame(simResult1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult2 <- getSimulationEnrichmentSurvival(design, plannedEvents = c(20, 40, 50), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 1, typeOfSelection = "rbest", rValue = 2, intersectionTest = "Bonferroni", directionUpper = TRUE, seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentSurvival object 'simResult2' with expected results expect_equal(simResult2$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simResult2$iterations[2, ], c(96, 98, 99, 99)) expect_equal(simResult2$iterations[3, ], c(95, 95, 94, 97)) expect_equal(simResult2$rejectAtLeastOne, c(0.41, 0.43, 0.42, 0.44), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$rejectedPopulationsPerStage)), c(0, 0, 0.03, 0, 0, 0.06, 0, 0, 0.09, 0, 0, 0.11, 0, 0, 0.19, 0, 0, 0.22, 0, 0, 0.18, 0, 0, 0.18, 0, 0, 0.29, 0, 0, 0.21, 0, 0, 0.27, 0, 0, 0.28), tolerance = 1e-07) expect_equal(simResult2$futilityStop, c(0.05, 0.05, 0.06, 0.03), tolerance = 1e-07) expect_equal(simResult2$futilityPerStage[1, ], c(0.04, 0.02, 0.01, 0.01), tolerance = 1e-07) expect_equal(simResult2$futilityPerStage[2, ], c(0.01, 0.03, 0.05, 0.02), tolerance = 1e-07) expect_equal(simResult2$earlyStop[1, ], c(0.04, 0.02, 0.01, 0.01), tolerance = 1e-07) expect_equal(simResult2$earlyStop[2, ], c(0.01, 0.03, 0.05, 0.02), tolerance = 1e-07) expect_equal(simResult2$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(simResult2$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(simResult2$successPerStage[3, ], c(0.1, 0.06, 0.12, 0.13), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$selectedPopulations)), c(1, 0.46, 0.46, 1, 0.56, 0.53, 1, 0.53, 0.49, 1, 0.61, 0.59, 1, 0.73, 0.72, 1, 0.71, 0.7, 1, 0.73, 0.69, 1, 0.64, 0.63, 1, 0.73, 0.72, 1, 0.69, 0.67, 1, 0.72, 0.7, 1, 0.73, 0.72), tolerance = 1e-07) expect_equal(simResult2$numberOfPopulations[1, ], c(3, 3, 3, 3)) expect_equal(simResult2$numberOfPopulations[2, ], c(2, 2, 2, 2)) expect_equal(simResult2$numberOfPopulations[3, ], c(2, 2, 2, 2)) expect_equal(simResult2$expectedNumberOfEvents, c(48.7, 49.1, 49.2, 49.5), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$singleNumberOfEventsPerStage)), c(3.6197209, 3.7263665, 1.8637446, 3.5373259, 3.6934301, 1.8464034, 4.2198086, 4.3555372, 2.1734368, 4.1271956, 4.2822198, 2.1396654, 8.7605581, 9.0186651, 4.510691, 8.5611432, 8.9389513, 4.4687214, 8.4396172, 8.7110744, 4.3468737, 8.2543912, 8.5644397, 4.2793308, 5.4295814, 5.5895498, 2.7956168, 5.3059889, 5.5401452, 2.7696051, 5.23067, 5.3989126, 2.6940868, 5.1158714, 5.3080319, 2.6522254, 2.1901395, 1.6654186, 0.82994761, 2.595542, 1.8274734, 0.91527007, 2.1099043, 1.5344758, 0.78560266, 2.5025418, 1.8453086, 0.9287784), tolerance = 1e-07) expect_equal(simResult2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult2$conditionalPowerAchieved[2, ], c(0, 0, 0, 0)) expect_equal(simResult2$conditionalPowerAchieved[3, ], c(0.50063383, 0.54643545, 0.52718133, 0.50178726), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult2), NA))) expect_output(print(simResult2)$show()) invisible(capture.output(expect_error(summary(simResult2), NA))) expect_output(summary(simResult2)$show()) simResult2CodeBased <- eval(parse(text = getObjectRCode(simResult2, stringWrapParagraphWidth = NULL))) expect_equal(simResult2CodeBased$iterations, simResult2$iterations, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectAtLeastOne, simResult2$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectedPopulationsPerStage, simResult2$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$futilityStop, simResult2$futilityStop, tolerance = 1e-05) expect_equal(simResult2CodeBased$futilityPerStage, simResult2$futilityPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$earlyStop, simResult2$earlyStop, tolerance = 1e-05) expect_equal(simResult2CodeBased$successPerStage, simResult2$successPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$selectedPopulations, simResult2$selectedPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$numberOfPopulations, simResult2$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$expectedNumberOfEvents, simResult2$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simResult2CodeBased$eventsPerStage, simResult2$eventsPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$singleNumberOfEventsPerStage, simResult2$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$conditionalPowerAchieved, simResult2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult2), "character") df <- as.data.frame(simResult2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult3 <- getSimulationEnrichmentSurvival(design, plannedEvents = c(20, 40, 50), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 1, typeOfSelection = "epsilon", epsilonValue = 0.2, intersectionTest = "Simes", directionUpper = TRUE, seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentSurvival object 'simResult3' with expected results expect_equal(simResult3$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simResult3$iterations[2, ], c(100, 100, 100, 100)) expect_equal(simResult3$iterations[3, ], c(100, 100, 100, 100)) expect_equal(simResult3$rejectAtLeastOne, c(0.58, 0.5, 0.54, 0.59), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$rejectedPopulationsPerStage)), c(0, 0, 0.08, 0, 0, 0.1, 0, 0, 0.12, 0, 0, 0.17, 0, 0, 0.25, 0, 0, 0.24, 0, 0, 0.22, 0, 0, 0.19, 0, 0, 0.26, 0, 0, 0.16, 0, 0, 0.2, 0, 0, 0.23), tolerance = 1e-07) expect_equal(simResult3$futilityStop, c(0, 0, 0, 0)) expect_equal(simResult3$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(simResult3$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(simResult3$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(simResult3$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(simResult3$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(simResult3$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(simResult3$successPerStage[3, ], c(0.58, 0.49, 0.54, 0.59), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$selectedPopulations)), c(1, 0.23, 0.19, 1, 0.34, 0.29, 1, 0.29, 0.25, 1, 0.36, 0.3, 1, 0.43, 0.4, 1, 0.44, 0.38, 1, 0.46, 0.44, 1, 0.39, 0.37, 1, 0.49, 0.45, 1, 0.42, 0.34, 1, 0.38, 0.34, 1, 0.39, 0.35), tolerance = 1e-07) expect_equal(simResult3$numberOfPopulations[1, ], c(3, 3, 3, 3)) expect_equal(simResult3$numberOfPopulations[2, ], c(1.15, 1.2, 1.13, 1.14), tolerance = 1e-07) expect_equal(simResult3$numberOfPopulations[3, ], c(1.04, 1.01, 1.03, 1.02), tolerance = 1e-07) expect_equal(simResult3$expectedNumberOfEvents, c(50, 50, 50, 50)) expect_equal(unlist(as.list(simResult3$singleNumberOfEventsPerStage)), c(3.6197209, 3.2949603, 1.5344372, 3.5373259, 3.5669739, 1.7213454, 4.2198086, 3.446866, 1.7468818, 4.1271956, 4.1623278, 2.0171614, 8.7605581, 8.3171213, 4.2553924, 8.5611432, 7.620128, 3.8013981, 8.4396172, 8.494284, 4.1220361, 8.2543912, 7.3299517, 3.6670484, 5.4295814, 7.31475, 3.717389, 5.3059889, 7.7227705, 4.0360143, 5.23067, 7.2570864, 3.7723984, 5.1158714, 7.5317292, 3.8778455, 2.1901395, 1.0731684, 0.4927814, 2.595542, 1.0901276, 0.44124214, 2.1099043, 0.80176363, 0.35868373, 2.5025418, 0.97599131, 0.43794482), tolerance = 1e-07) expect_equal(simResult3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult3$conditionalPowerAchieved[2, ], c(0, 0, 0, 0)) expect_equal(simResult3$conditionalPowerAchieved[3, ], c(0.55208818, 0.54329749, 0.5548491, 0.59570521), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult3), NA))) expect_output(print(simResult3)$show()) invisible(capture.output(expect_error(summary(simResult3), NA))) expect_output(summary(simResult3)$show()) simResult3CodeBased <- eval(parse(text = getObjectRCode(simResult3, stringWrapParagraphWidth = NULL))) expect_equal(simResult3CodeBased$iterations, simResult3$iterations, tolerance = 1e-05) expect_equal(simResult3CodeBased$rejectAtLeastOne, simResult3$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult3CodeBased$rejectedPopulationsPerStage, simResult3$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$futilityStop, simResult3$futilityStop, tolerance = 1e-05) expect_equal(simResult3CodeBased$futilityPerStage, simResult3$futilityPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$earlyStop, simResult3$earlyStop, tolerance = 1e-05) expect_equal(simResult3CodeBased$successPerStage, simResult3$successPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$selectedPopulations, simResult3$selectedPopulations, tolerance = 1e-05) expect_equal(simResult3CodeBased$numberOfPopulations, simResult3$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult3CodeBased$expectedNumberOfEvents, simResult3$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simResult3CodeBased$eventsPerStage, simResult3$eventsPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$singleNumberOfEventsPerStage, simResult3$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$conditionalPowerAchieved, simResult3$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult3), "character") df <- as.data.frame(simResult3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationEnrichmentSurvival': gMax = 4", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:enrichmentDesigns} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:subsec:adaptiveClosedTestProcedureEnrichment} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:sec:simulationFunctions} # @refFS[Sec.]{fs:sec:simulatingEnrichmentDesigns} # @refFS[Sec.]{fs:sec:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:simulationEnrichmentSurvivalGenerate} # @refFS[Formula]{fs:simulationEnrichmentSurvivalEvents} # @refFS[Formula]{fs:simulationEnrichmentSurvivalLogRanks} # @refFS[Formula]{fs:simulationEnrichmentSurvivalAdjustedPrevalances} # @refFS[Formula]{fs:simulationEnrichmentSelections} # @refFS[Formula]{fs:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:enrichmentRejectionRule} .skipTestIfDisabled() subGroups <- c("S1", "S2", "S3", "S12", "S13", "S23", "S123", "R") prevalences <- c(0.1, 0.05, 0.1, 0.15, 0.1, 0.15, 0.3, 0.05) hazardRatios <- matrix(c(seq(1, 1.75, 0.25), seq(1, 1.75, 0.25)), ncol = 8) effectList <- list(subGroups = subGroups, prevalences = prevalences, hazardRatios = hazardRatios) design <- getDesignInverseNormal(informationRates = c(0.4, 1), typeOfDesign = "noEarlyEfficacy") suppressWarnings(simResult1 <- getSimulationEnrichmentSurvival(design, plannedEvents = c(100, 200), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 2, typeOfSelection = "epsilon", epsilonValue = 0.15, adaptations = c(T), intersectionTest = "Sidak", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentSurvival object 'simResult1' with expected results expect_equal(simResult1$iterations[1, ], 100) expect_equal(simResult1$iterations[2, ], 100) expect_equal(simResult1$rejectAtLeastOne, 0.78, tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$rejectedPopulationsPerStage)), c(0, 0.25, 0, 0.27, 0, 0.2, 0, 0.2), tolerance = 1e-07) expect_equal(simResult1$futilityPerStage[1, ], 0) expect_equal(simResult1$earlyStop[1, ], 0) expect_equal(simResult1$successPerStage[1, ], 0) expect_equal(simResult1$successPerStage[2, ], 0.62, tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$selectedPopulations)), c(1, 0.4, 1, 0.42, 1, 0.38, 1, 0.26), tolerance = 1e-07) expect_equal(simResult1$numberOfPopulations[1, ], 4) expect_equal(simResult1$numberOfPopulations[2, ], 1.46, tolerance = 1e-07) expect_equal(simResult1$expectedNumberOfEvents, 200) expect_equal(unlist(as.list(simResult1$singleNumberOfEventsPerStage)), c(7.8947368, 5.6875992, 4.6052632, 3.0762436, 10.526316, 7.5333457, 17.763158, 17.965778, 7.8947368, 8.587733, 13.815789, 14.268603, 31.578947, 41.341223, 5.9210526, 1.5394737), tolerance = 1e-07) expect_equal(simResult1$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simResult1$conditionalPowerAchieved[2, ], 0.30293141, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult1), NA))) expect_output(print(simResult1)$show()) invisible(capture.output(expect_error(summary(simResult1), NA))) expect_output(summary(simResult1)$show()) simResult1CodeBased <- eval(parse(text = getObjectRCode(simResult1, stringWrapParagraphWidth = NULL))) expect_equal(simResult1CodeBased$iterations, simResult1$iterations, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectAtLeastOne, simResult1$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectedPopulationsPerStage, simResult1$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$futilityPerStage, simResult1$futilityPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$earlyStop, simResult1$earlyStop, tolerance = 1e-05) expect_equal(simResult1CodeBased$successPerStage, simResult1$successPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$selectedPopulations, simResult1$selectedPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$numberOfPopulations, simResult1$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$expectedNumberOfEvents, simResult1$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simResult1CodeBased$eventsPerStage, simResult1$eventsPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$singleNumberOfEventsPerStage, simResult1$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$conditionalPowerAchieved, simResult1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult1), "character") df <- as.data.frame(simResult1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult2 <- getSimulationEnrichmentSurvival(design, plannedEvents = c(100, 200), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 2, typeOfSelection = "rBest", rValue = 2, adaptations = c(T), intersectionTest = "Bonferroni", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentSurvival object 'simResult2' with expected results expect_equal(simResult2$iterations[1, ], 100) expect_equal(simResult2$iterations[2, ], 100) expect_equal(simResult2$rejectAtLeastOne, 0.72, tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$rejectedPopulationsPerStage)), c(0, 0.24, 0, 0.35, 0, 0.19, 0, 0.26), tolerance = 1e-07) expect_equal(simResult2$futilityPerStage[1, ], 0) expect_equal(simResult2$earlyStop[1, ], 0) expect_equal(simResult2$successPerStage[1, ], 0) expect_equal(simResult2$successPerStage[2, ], 0.32, tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$selectedPopulations)), c(1, 0.52, 1, 0.6, 1, 0.5, 1, 0.38), tolerance = 1e-07) expect_equal(simResult2$numberOfPopulations[1, ], 4) expect_equal(simResult2$numberOfPopulations[2, ], 2) expect_equal(simResult2$expectedNumberOfEvents, 200) expect_equal(unlist(as.list(simResult2$singleNumberOfEventsPerStage)), c(7.8947368, 6.6732283, 4.6052632, 4.1932891, 10.526316, 8.6870229, 17.763158, 19.549115, 7.8947368, 8.6884955, 13.815789, 15.204867, 31.578947, 34.753982, 5.9210526, 2.25), tolerance = 1e-07) expect_equal(simResult2$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simResult2$conditionalPowerAchieved[2, ], 0.30293141, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult2), NA))) expect_output(print(simResult2)$show()) invisible(capture.output(expect_error(summary(simResult2), NA))) expect_output(summary(simResult2)$show()) simResult2CodeBased <- eval(parse(text = getObjectRCode(simResult2, stringWrapParagraphWidth = NULL))) expect_equal(simResult2CodeBased$iterations, simResult2$iterations, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectAtLeastOne, simResult2$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectedPopulationsPerStage, simResult2$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$futilityPerStage, simResult2$futilityPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$earlyStop, simResult2$earlyStop, tolerance = 1e-05) expect_equal(simResult2CodeBased$successPerStage, simResult2$successPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$selectedPopulations, simResult2$selectedPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$numberOfPopulations, simResult2$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$expectedNumberOfEvents, simResult2$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simResult2CodeBased$eventsPerStage, simResult2$eventsPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$singleNumberOfEventsPerStage, simResult2$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$conditionalPowerAchieved, simResult2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult2), "character") df <- as.data.frame(simResult2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationEnrichmentSurvival': comparison of base and enrichment for inverse normal and Fisher combination", { options(warn = 0) # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:enrichmentDesigns} # @refFS[Sec.]{fs:sec:simulationFunctions} # @refFS[Sec.]{fs:sec:simulatingEnrichmentDesigns} # @refFS[Sec.]{fs:sec:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:simulationEnrichmentSurvivalGenerate} # @refFS[Formula]{fs:simulationEnrichmentSurvivalEvents} # @refFS[Formula]{fs:simulationEnrichmentSurvivalLogRanks} # @refFS[Formula]{fs:simulationEnrichmentSelections} # @refFS[Formula]{fs:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:enrichmentRejectionRule} .skipTestIfDisabled() options(warn = -1) effectList <- list(subGroups = "F", prevalences = 1, stDevs = 1.3, hazardRatios = matrix(seq(0.6, 1, 0.05), ncol = 1)) design <- getDesignInverseNormal(informationRates = c(0.3, 0.7, 1), typeOfDesign = "asKD", gammaA = 2.4) x1 <- getSimulationEnrichmentSurvival(design, populations = 1, plannedEvents = c(50, 100, 180), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 1, directionUpper = FALSE, conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA, 10, 10), maxNumberOfEventsPerStage = c(NA, 100, 100), seed = 123 ) x2 <- getSimulationSurvival(design, plannedEvents = c(50, 100, 180), hazardRatio = seq(0.6, 1, 0.05), directionUpper = FALSE, maxNumberOfSubjects = 1500, maxNumberOfIterations = 100, allocation1 = 1, allocation2 = 1, longTimeSimulationAllowed = TRUE, conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA, 10, 10), maxNumberOfEventsPerStage = c(NA, 100, 100), seed = 123 ) comp1 <- x2$overallReject - x1$rejectAtLeastOne ## Comparison of the results of numeric object 'comp1' with expected results expect_equal(comp1, c(-0.05, 0.03, 0.03, 0.01, 0.07, 0.08, 0.05, -0.05, -0.02), tolerance = 1e-07) comp2 <- x2$conditionalPowerAchieved - x1$conditionalPowerAchieved ## Comparison of the results of matrixarray object 'comp2' with expected results expect_equal(comp2[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(comp2[2, ], c(-0.022566214, -0.0056751238, 0.047207777, 0.035251356, 0.033740719, -0.051453144, 0.039406427, 0.0072692293, -0.022722897), tolerance = 1e-07) expect_equal(comp2[3, ], c(0.025359012, -0.021253383, 0.092581664, -0.080566447, 0.087298305, -0.050787115, 0.070673698, 0.019777739, -0.019114098), tolerance = 1e-07) comp3 <- x2$expectedNumberOfEvents - x1$expectedNumberOfEvents ## Comparison of the results of numeric object 'comp3' with expected results expect_equal(comp3, c(5.6713988, 8.8976118, -9.7670182, -2.0326561, -2.7081522, -0.88153524, -5.5780096, 3.3199537, 1.2334371), tolerance = 1e-07) design <- getDesignFisher(informationRates = c(0.3, 0.6, 1)) x1 <- getSimulationEnrichmentSurvival(design, populations = 1, plannedEvents = c(50, 100, 180), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 1, directionUpper = FALSE, conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA, 10, 10), maxNumberOfEventsPerStage = c(NA, 100, 100), seed = 123 ) x2 <- getSimulationSurvival(design, plannedEvents = c(50, 100, 180), hazardRatio = seq(0.6, 1, 0.05), directionUpper = FALSE, maxNumberOfSubjects = 1500, maxNumberOfIterations = 100, allocation1 = 1, allocation2 = 1, conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA, 10, 10), maxNumberOfEventsPerStage = c(NA, 100, 100), seed = 123 ) comp4 <- x2$overallReject - x1$rejectAtLeastOne ## Comparison of the results of numeric object 'comp4' with expected results expect_equal(comp4, c(-0.08, 0.02, 0.12, 0.02, 0.04, 0.04, 0.04, -0.03, 0), tolerance = 1e-07) comp5 <- x2$conditionalPowerAchieved - x1$conditionalPowerAchieved ## Comparison of the results of matrixarray object 'comp5' with expected results expect_equal(comp5[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(comp5[2, ], c(-0.067329229, 0.0040653837, 0.025600632, 0.024680224, 0.025189093, -0.043591198, 0.033525993, -0.0055417344, -0.031790612), tolerance = 1e-07) expect_equal(comp5[3, ], c(0.012384997, 0.030980232, 0.047012202, -0.035304718, 0.068468504, 0.00374058, 0.042913189, -0.015210788, -0.017776302), tolerance = 1e-07) comp6 <- x2$expectedNumberOfEvents - x1$expectedNumberOfEvents ## Comparison of the results of numeric object 'comp6' with expected results expect_equal(comp6, c(5.1347448, 9.1286427, -16.823834, -1.3136156, 0.71128925, 1.9694657, -7.1208497, -0.94699441, -0.085337992), tolerance = 1e-07) options(warn = 0) }) rpact/tests/testthat/test-class_summary.R0000644000175000017500000006016614154142422020511 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-class_summary.R ## | Creation date: 08 December 2021, 08:59:13 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Class 'SummaryFactory'") test_that("Testing 'summary.ParameterSet': no errors occur", { .skipTestIfDisabled() # @refFS[Function]{fs:outputOfGenericFunctions} invisible(capture.output(expect_error(summary(getDesignGroupSequential(beta = 0.05, typeOfDesign = "asKD", gammaA = 1, typeBetaSpending = "bsOF")), NA))) invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 1)), NA))) invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 4, sided = 2)), NA))) invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 4, sided = 2), digits = 0), NA))) invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 1, sided = 2)), NA))) invisible(capture.output(expect_error(summary(getDesignGroupSequential(futilityBounds = c(-6, 0))), NA))) invisible(capture.output(expect_error(summary(getDesignGroupSequential(futilityBounds = c(-6, 0)), digits = 5), NA))) invisible(capture.output(expect_error(summary(getDataset( n = c(13, 25), means = c(242, 222), stDevs = c(244, 221))), NA))) invisible(capture.output(expect_error(summary(getDataset( n = c(13), means = c(242), stDevs = c(244))), NA))) invisible(capture.output(expect_error(summary(getDataset( n1 = c(13, 25), n2 = c(15, NA), n3 = c(14, 27), n4 = c(12, 29), means1 = c(242, 222), means2 = c(188, NA), means3 = c(267, 277), means4 = c(92, 122), stDevs1 = c(244, 221), stDevs2 = c(212, NA), stDevs3 = c(256, 232), stDevs4 = c(215, 227))), NA))) invisible(capture.output(expect_error(summary(getDataset( n1 = c(11, 13, 12, 13), n2 = c(8, 10, 9, 11), n3 = c(7, 10, 8, 9), events1 = c(10, 10, 12, 12), events2 = c(3, 5, 5, 6), events3 = c(2, 4, 3, 5))), NA))) invisible(capture.output(expect_error(summary(getDataset( events1 = c(25, 32), events2 = c(18, NA), events3 = c(22, 36), logRanks1 = c(2.2,1.8), logRanks2 = c(1.99, NA), logRanks3 = c(2.32, 2.11))), NA))) invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 1)), NA))) invisible(capture.output(expect_error(summary(getDesignInverseNormal(futilityBounds = c(0, 1))), NA))) invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 1)), NA))) invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 4, sided = 2)), NA))) invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 4, sided = 2), digits = 0), NA))) invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 1, sided = 2)), NA))) invisible(capture.output(expect_error(summary(getDesignFisher()), NA))) invisible(capture.output(expect_error(summary(getDesignFisher(alpha0Vec = c(0.1, 0.2))), NA))) invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 1)), NA))) invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 4), digits = 5), NA))) invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 4), digits = 0), NA))) invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 1)), NA))) ## test design plans - means invisible(capture.output(expect_error(summary(getSampleSizeMeans(sided = 2, alternative = -0.5)), NA))) invisible(capture.output(expect_warning(summary(getSampleSizeMeans(sided = 2), alternative = -0.5)))) # warning expected invisible(capture.output(expect_error(summary(getPowerMeans(sided = 1, alternative = c(-0.5,-0.3), maxNumberOfSubjects = 100, directionUpper = FALSE)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 0.5, sided = 1, stDev = 2.5)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 0.5, sided = 1, stDev = 1, groups = 1)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeMeans(thetaH0 = 0, sided = 2, stDev = 1, groups = 1)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5, allocationRatioPlanned = 0)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5, groups = 1)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2)))), NA))) invisible(capture.output(expect_error(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 0), NA))) invisible(capture.output(expect_error(summary(getPowerMeans(getDesignGroupSequential(futilityBounds = c(1, 2)), maxNumberOfSubjects = 100, alternative = 1)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeMeans(getDesignGroupSequential(kMax = 4, sided = 2))), NA))) invisible(capture.output(expect_error(summary(getPowerMeans(getDesignGroupSequential(kMax = 4, sided = 2), maxNumberOfSubjects = 100)), NA))) invisible(capture.output(expect_error(summary(getPowerMeans(getDesignGroupSequential(kMax = 1, sided = 2), maxNumberOfSubjects = 100)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2)))), NA))) invisible(capture.output(expect_error(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 4), NA))) invisible(capture.output(expect_error(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 3), NA))) invisible(capture.output(expect_error(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 2), NA))) invisible(capture.output(expect_error(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = -1), NA))) ## test design plans - rates invisible(capture.output(expect_error(summary(getSampleSizeRates(pi2 = 0.3)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.3)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.45)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeRates(groups = 2, thetaH0 = 0.45, allocationRatioPlanned = 0)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeRates(getDesignGroupSequential(futilityBounds = c(1, 2)))), NA))) invisible(capture.output(expect_error(summary(getPowerRates(getDesignGroupSequential(futilityBounds = c(1, 2)), maxNumberOfSubjects = 100)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 4, sided = 2))), NA))) invisible(capture.output(expect_error(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 4, sided = 2), groups = 1, thetaH0 = 0.3)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 1, sided = 2), groups = 1, thetaH0 = 0.2, pi1 = c(0.4,0.5))), NA))) invisible(capture.output(expect_error(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 1, sided = 2), groups = 1, thetaH0 = 0.2, pi1 = 0.4)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 1, sided = 2), groups = 2, thetaH0 = 0, pi1 = 0.25)), NA))) invisible(capture.output(expect_error(summary(getPowerRates(getDesignGroupSequential(kMax = 4, sided = 2), maxNumberOfSubjects = 100)), NA))) ## test design plans - survival invisible(capture.output(expect_error(summary(getSampleSizeSurvival()), NA))) invisible(capture.output(expect_error(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = 1.2)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = c(1.2, 2))), NA))) invisible(capture.output(expect_error(summary(getSampleSizeSurvival(pi2 = 0.3, hazardRatio = 1.2)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeSurvival(pi1 = 0.1, pi2 = 0.3)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeSurvival(lambda2 = 0.03, lambda1 = c(0.040))), NA))) invisible(capture.output(expect_error(summary(getSampleSizeSurvival(piecewiseSurvivalTime = list( "0 - <6" = 0.025, "6 - <9" = 0.04, "9 - <15" = 0.015, "15 - <21" = 0.01, ">=21" = 0.007), hazardRatio = 1.2)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeSurvival(getDesignGroupSequential(futilityBounds = c(1, 2)))), NA))) invisible(capture.output(expect_error(summary(getPowerSurvival(getDesignGroupSequential(futilityBounds = c(1, 2)), maxNumberOfSubjects = 100, maxNumberOfEvents = 60)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeSurvival(getDesignGroupSequential(kMax = 4, sided = 2))), NA))) invisible(capture.output(expect_error(summary(getPowerSurvival(getDesignGroupSequential(kMax = 4, sided = 2), maxNumberOfSubjects = 100, maxNumberOfEvents = 60)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeSurvival(sided = 2, lambda2 = log(2)/6, lambda1 = log(2)/8)), NA))) invisible(capture.output(expect_error(summary(getPowerSurvival(sided = 2, maxNumberOfSubjects = 200, maxNumberOfEvents = 40, lambda2 = log(2)/6, lambda1 = log(2)/8)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeSurvival(getDesignGroupSequential(sided = 2), lambda2 = log(2)/6, hazardRatio = c(0.55), accrualTime = c(0,10), accrualIntensity = 20)), NA))) invisible(capture.output(expect_error(summary(getPowerSurvival(getDesignGroupSequential(kMax = 2), maxNumberOfEvents = 200, maxNumberOfSubjects = 400, lambda2 = log(2) / 60, lambda1 = log(2) / 50, dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, accrualTime = 0, accrualIntensity = 30)), NA))) invisible(capture.output(expect_error(summary(getPowerSurvival(getDesignGroupSequential(kMax = 3), maxNumberOfEvents = 200, maxNumberOfSubjects = 400, lambda2 = log(2) / 60, lambda1 = c(log(2) / 50, log(2) / 60), dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, accrualTime = 0, accrualIntensity = 30)), NA))) invisible(capture.output(expect_error(summary(getPowerSurvival(getDesignGroupSequential(kMax = 3), maxNumberOfEvents = 200, maxNumberOfSubjects = 400, lambda2 = log(2) / 60, hazardRatio = c(0.7, 0.8),directionUpper = FALSE, dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, accrualTime = 0, accrualIntensity = 30)), NA))) design1 <- getDesignGroupSequential( sided = 2, alpha = 0.05, beta = 0.2, informationRates = c(0.6, 1), typeOfDesign = "asOF", twoSidedPower = FALSE) invisible(capture.output(expect_error(summary(getSampleSizeSurvival( design1, lambda2 = log(2) / 60, hazardRatio = 0.74, dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, accrualTime = 0, accrualIntensity = 30, followUpTime = 12)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeSurvival( design1, lambda2 = log(2) / 60, lambda1 = log(2) / 50, dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, accrualTime = 0, accrualIntensity = 30, followUpTime = 12)), NA))) invisible(capture.output(expect_error(summary(getSampleSizeSurvival(getDesignGroupSequential(kMax = 4, sided = 2))), NA))) ## simulations design2 <- getDesignInverseNormal(alpha = 0.05, kMax = 4, futilityBounds = c(0,0,0), sided = 1, typeOfDesign = "WT", deltaWT = 0.1) invisible(capture.output(expect_error(summary(getSimulationSurvival(design2,lambda2 = log(2) / 60, lambda1 = c(log(2) / 80), maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345, directionUpper = FALSE)), NA))) invisible(capture.output(expect_error(summary(getSimulationSurvival(design2,lambda2 = log(2) / 60, hazardRatio = c(1.2, 1.4), maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345)), NA))) design3 <- getDesignGroupSequential(typeOfDesign = "P", futilityBounds = c(1,1)) invisible(capture.output(expect_error(summary(getSampleSizeMeans(design3)), NA))) invisible(capture.output(expect_error(summary(getSimulationMeans(design3, stDev = 4, plannedSubjects = (1:3)*200, alternative = c(1,2))), NA))) invisible(capture.output(expect_error(summary(getSimulationRates(design3, plannedSubjects = (1:3)*200, pi1 = c(0.3,0.4), maxNumberOfIterations = 1000, minNumberOfSubjectsPerStage = c(NA, 40, 40), maxNumberOfSubjectsPerStage = c(NA, 40, 400), conditionalPower = 0.8)), NA))) invisible(capture.output(expect_error(summary(getSimulationMeans(getDesignGroupSequential(kMax = 1), stDev = 4, plannedSubjects = 200, alternative = c(1))), NA))) }) test_that("Testing 'summary.ParameterSet': output will be produced", { .skipTestIfDisabled() # @refFS[Function]{fs:outputOfGenericFunctions} expect_output(summary(getDesignGroupSequential(beta = 0.05, typeOfDesign = "asKD", gammaA = 1, typeBetaSpending = "bsOF"))$show()) expect_output(summary(getDesignGroupSequential(kMax = 1))$show()) expect_output(summary(getDesignGroupSequential(kMax = 4, sided = 2))$show()) expect_output(summary(getDesignGroupSequential(kMax = 4, sided = 2), digits = 0)$show()) expect_output(summary(getDesignGroupSequential(kMax = 1, sided = 2))$show()) expect_output(summary(getDesignGroupSequential(futilityBounds = c(-6, 0)))$show()) expect_output(summary(getDesignGroupSequential(futilityBounds = c(-6, 0)), digits = 5)$show()) expect_output(summary(getDataset( n = c(13, 25), means = c(242, 222), stDevs = c(244, 221)))$show()) expect_output(summary(getDataset( n = c(13), means = c(242), stDevs = c(244)))$show()) expect_output(summary(getDataset( n1 = c(13, 25), n2 = c(15, NA), n3 = c(14, 27), n4 = c(12, 29), means1 = c(242, 222), means2 = c(188, NA), means3 = c(267, 277), means4 = c(92, 122), stDevs1 = c(244, 221), stDevs2 = c(212, NA), stDevs3 = c(256, 232), stDevs4 = c(215, 227)))$show()) expect_output(summary(getDataset( n1 = c(11, 13, 12, 13), n2 = c(8, 10, 9, 11), n3 = c(7, 10, 8, 9), events1 = c(10, 10, 12, 12), events2 = c(3, 5, 5, 6), events3 = c(2, 4, 3, 5)))$show()) expect_output(summary(getDataset( events1 = c(25, 32), events2 = c(18, NA), events3 = c(22, 36), logRanks1 = c(2.2,1.8), logRanks2 = c(1.99, NA), logRanks3 = c(2.32, 2.11)))$show()) expect_output(summary(getDesignInverseNormal(kMax = 1))$show()) expect_output(summary(getDesignInverseNormal(futilityBounds = c(0, 1)))$show()) expect_output(summary(getDesignInverseNormal(kMax = 1))$show()) expect_output(summary(getDesignInverseNormal(kMax = 4, sided = 2))$show()) expect_output(summary(getDesignInverseNormal(kMax = 4, sided = 2), digits = 0)$show()) expect_output(summary(getDesignInverseNormal(kMax = 1, sided = 2))$show()) expect_output(summary(getDesignFisher())$show()) expect_output(summary(getDesignFisher(alpha0Vec = c(0.1, 0.2)))$show()) expect_output(summary(getDesignFisher(kMax = 1))$show()) expect_output(summary(getDesignFisher(kMax = 4), digits = 5)$show()) expect_output(summary(getDesignFisher(kMax = 4), digits = 0)$show()) expect_output(summary(getDesignFisher(kMax = 1))$show()) ## test design plans - means expect_output(summary(getSampleSizeMeans(sided = 2, alternative = -0.5))$show()) expect_output(summary(getPowerMeans(sided = 1, alternative = c(-0.5,-0.3), maxNumberOfSubjects = 100, directionUpper = FALSE))$show()) expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 0.5, sided = 1, stDev = 2.5))$show()) expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 0.5, sided = 1, stDev = 1, groups = 1))$show()) expect_output(summary(getSampleSizeMeans(thetaH0 = 0, sided = 2, stDev = 1, groups = 1))$show()) expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5))$show()) expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5, allocationRatioPlanned = 0))$show()) expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5, groups = 1))$show()) expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 0)$show()) expect_output(summary(getPowerMeans(getDesignGroupSequential(futilityBounds = c(1, 2)), maxNumberOfSubjects = 100, alternative = 1))$show()) expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) expect_output(summary(getPowerMeans(getDesignGroupSequential(kMax = 4, sided = 2), maxNumberOfSubjects = 100))$show()) expect_output(summary(getPowerMeans(getDesignGroupSequential(kMax = 1, sided = 2), maxNumberOfSubjects = 100))$show()) expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 4)$show()) expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 3)$show()) expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 2)$show()) expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = -1)$show()) ## test design plans - rates expect_output(summary(getSampleSizeRates(pi2 = 0.3))$show()) expect_output(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.3))$show()) expect_output(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.45))$show()) expect_output(summary(getSampleSizeRates(groups = 2, thetaH0 = 0.45, allocationRatioPlanned = 0))$show()) expect_output(summary(getSampleSizeRates(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) expect_output(summary(getPowerRates(getDesignGroupSequential(futilityBounds = c(1, 2)), maxNumberOfSubjects = 100))$show()) expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 4, sided = 2), groups = 1, thetaH0 = 0.3))$show()) expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 1, sided = 2), groups = 1, thetaH0 = 0.2, pi1 = c(0.4,0.5)))$show()) expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 1, sided = 2), groups = 1, thetaH0 = 0.2, pi1 = 0.4))$show()) expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 1, sided = 2), groups = 2, thetaH0 = 0, pi1 = 0.25))$show()) expect_output(summary(getPowerRates(getDesignGroupSequential(kMax = 4, sided = 2), maxNumberOfSubjects = 100))$show()) ## test design plans - survival expect_output(summary(getSampleSizeSurvival())$show()) expect_output(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = 1.2))$show()) expect_output(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = c(1.2, 2)))$show()) expect_output(summary(getSampleSizeSurvival(pi2 = 0.3, hazardRatio = 1.2))$show()) expect_output(summary(getSampleSizeSurvival(pi1 = 0.1, pi2 = 0.3))$show()) expect_output(summary(getSampleSizeSurvival(lambda2 = 0.03, lambda1 = c(0.040)))$show()) expect_output(summary(getSampleSizeSurvival(piecewiseSurvivalTime = list( "0 - <6" = 0.025, "6 - <9" = 0.04, "9 - <15" = 0.015, "15 - <21" = 0.01, ">=21" = 0.007), hazardRatio = 1.2))$show()) expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) expect_output(summary(getPowerSurvival(getDesignGroupSequential(futilityBounds = c(1, 2)), maxNumberOfSubjects = 100, maxNumberOfEvents = 60))$show()) expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 4, sided = 2), maxNumberOfSubjects = 100, maxNumberOfEvents = 60))$show()) expect_output(summary(getSampleSizeSurvival(sided = 2, lambda2 = log(2)/6, lambda1 = log(2)/8))$show()) expect_output(summary(getPowerSurvival(sided = 2, maxNumberOfSubjects = 200, maxNumberOfEvents = 40, lambda2 = log(2)/6, lambda1 = log(2)/8))$show()) expect_warning(expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(sided = 2), lambda2 = log(2)/6, hazardRatio = c(0.55), accrualTime = c(0,10), accrualIntensity = 60))$show()), "Accrual duration longer than maximal study duration (time to maximal number of events); followUpTime = -2.959", fixed = TRUE) expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 2), maxNumberOfEvents = 150, maxNumberOfSubjects = 400, lambda2 = log(2) / 60, lambda1 = log(2) / 50, dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, accrualTime = 0, accrualIntensity = 30))$show()) expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 3), maxNumberOfEvents = 200, maxNumberOfSubjects = 400, lambda2 = log(2) / 60, lambda1 = c(log(2) / 50, log(2) / 60), dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, accrualTime = 0, accrualIntensity = 30))$show()) expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 3), maxNumberOfEvents = 200, maxNumberOfSubjects = 400, lambda2 = log(2) / 60, hazardRatio = c(0.7, 0.8),directionUpper = FALSE, dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, accrualTime = 0, accrualIntensity = 30))$show()) design1 <- getDesignGroupSequential( sided = 2, alpha = 0.05, beta = 0.2, informationRates = c(0.6, 1), typeOfDesign = "asOF", twoSidedPower = FALSE) expect_output(summary(getSampleSizeSurvival( design1, lambda2 = log(2) / 60, hazardRatio = 0.74, dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, accrualTime = 0, accrualIntensity = 30, followUpTime = 12))$show()) expect_output(summary(getSampleSizeSurvival( design1, lambda2 = log(2) / 60, lambda1 = log(2) / 50, dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, accrualTime = 0, accrualIntensity = 30, followUpTime = 12))$show()) expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) ## simulations design2 <- getDesignInverseNormal(alpha = 0.05, kMax = 4, futilityBounds = c(0,0,0), sided = 1, typeOfDesign = "WT", deltaWT = 0.1) expect_output(summary(getSimulationSurvival(design2 ,lambda2 = log(2) / 60, lambda1 = c(log(2) / 80), maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345, directionUpper = FALSE))$show()) expect_output(summary(getSimulationSurvival(design2,lambda2 = log(2) / 60, hazardRatio = c(1.2, 1.4), maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345))$show()) design3 <- getDesignGroupSequential(typeOfDesign = "P", futilityBounds = c(1,1)) expect_output(summary(getSampleSizeMeans(design3))$show()) expect_output(summary(getSimulationMeans(design3, stDev = 4, plannedSubjects = (1:3)*200, alternative = c(1,2)))$show()) expect_output(summary(getSimulationRates(design3, plannedSubjects = (1:3)*200, pi1 = c(0.3,0.4), maxNumberOfIterations = 1000, minNumberOfSubjectsPerStage = c(NA, 40, 40), maxNumberOfSubjectsPerStage = c(NA, 40, 400), conditionalPower = 0.8))$show()) expect_output(summary(getSimulationMeans(getDesignGroupSequential(kMax = 1), stDev = 4, plannedSubjects = 200, alternative = 1))$show()) }) rpact/tests/testthat/test-f_analysis_multiarm_survival.R0000644000175000017500000021734214154142422023624 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_analysis_multiarm_survival.R ## | Creation date: 08 December 2021, 09:07:40 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing the Analysis Survival Functionality for Three or More Treatments") test_that("'getAnalysisResultsMultiArm' with survival data and different options", { design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.025, futilityBounds = c(-0.5,0), bindingFutility = FALSE, typeOfDesign = "asKD", gammaA = 1.2, informationRates = c(0.4,0.7,1)) design2 <- getDesignFisher(kMax = 3, alpha = 0.025, alpha0Vec = c(0.7,0.5), method = "equalAlpha", bindingFutility = TRUE, informationRates = c(0.4,0.7,1)) design3 <- getDesignConditionalDunnett(alpha = 0.025, informationAtInterim = 0.4, secondStageConditioning = TRUE) # directionUpper = TRUE dataExample1 <- getDataset( events1 = c(25, 32), events2 = c(18, NA), logRanks1 = c(2.2,1.8), logRanks2 = c(1.99, NA) ) # directionUpper = FALSE dataExample2 <- getDataset( events1 = c(25, 32), events2 = c(18, NA), logRanks1 = -c(2.2,1.8), logRanks2 = -c(1.99, NA) ) # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results1 <- getAnalysisResults(design = design1, dataInput = dataExample1, intersectionTest = "Dunnett", nPlanned = c(20), directionUpper = TRUE) ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results1' with expected results expect_equal(results1$thetaH1[1, ], 2.1027372, tolerance = 1e-05) expect_equal(results1$thetaH1[2, ], NA_real_) expect_equal(results1$conditionalRejectionProbabilities[1, ], c(0.16551988, 0.53357188, NA_real_), tolerance = 1e-05) expect_equal(results1$conditionalRejectionProbabilities[2, ], c(0.16551988, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.95961075), tolerance = 1e-05) expect_equal(results1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results1$repeatedConfidenceIntervalLowerBounds[1, ], c(0.84462483, 1.0978923, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedConfidenceIntervalLowerBounds[2, ], c(0.74230032, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedConfidenceIntervalUpperBounds[1, ], c(6.8816796, 4.1951386, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedConfidenceIntervalUpperBounds[2, ], c(8.7950723, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedPValues[1, ], c(0.077362906, 0.0096216473, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedPValues[2, ], c(0.077362906, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results1), NA))) expect_output(print(results1)$show()) invisible(capture.output(expect_error(summary(results1), NA))) expect_output(summary(results1)$show()) results1CodeBased <- eval(parse(text = getObjectRCode(results1, stringWrapParagraphWidth = NULL))) expect_equal(results1CodeBased$thetaH1, results1$thetaH1, tolerance = 1e-05) expect_equal(results1CodeBased$conditionalRejectionProbabilities, results1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results1CodeBased$conditionalPower, results1$conditionalPower, tolerance = 1e-05) expect_equal(results1CodeBased$repeatedConfidenceIntervalLowerBounds, results1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results1CodeBased$repeatedConfidenceIntervalUpperBounds, results1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results1CodeBased$repeatedPValues, results1$repeatedPValues, tolerance = 1e-05) expect_type(names(results1), "character") df <- as.data.frame(results1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results2 <- getAnalysisResults(design = design1, dataInput = dataExample1, intersectionTest = "Simes", nPlanned = c(20), directionUpper = TRUE) ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results2' with expected results expect_equal(results2$thetaH1[1, ], 2.1027372, tolerance = 1e-05) expect_equal(results2$thetaH1[2, ], NA_real_) expect_equal(results2$conditionalRejectionProbabilities[1, ], c(0.17669226, 0.55323068, NA_real_), tolerance = 1e-05) expect_equal(results2$conditionalRejectionProbabilities[2, ], c(0.17669226, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$conditionalPower[1, ], c(NA_real_, NA_real_, 0.96373388), tolerance = 1e-05) expect_equal(results2$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results2$repeatedConfidenceIntervalLowerBounds[1, ], c(0.83909611, 1.088337, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedConfidenceIntervalLowerBounds[2, ], c(0.73657731, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedConfidenceIntervalUpperBounds[1, ], c(6.9270216, 4.2761955, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedConfidenceIntervalUpperBounds[2, ], c(8.8634059, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedPValues[1, ], c(0.069951918, 0.0087766935, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedPValues[2, ], c(0.069951918, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results2), NA))) expect_output(print(results2)$show()) invisible(capture.output(expect_error(summary(results2), NA))) expect_output(summary(results2)$show()) results2CodeBased <- eval(parse(text = getObjectRCode(results2, stringWrapParagraphWidth = NULL))) expect_equal(results2CodeBased$thetaH1, results2$thetaH1, tolerance = 1e-05) expect_equal(results2CodeBased$conditionalRejectionProbabilities, results2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results2CodeBased$conditionalPower, results2$conditionalPower, tolerance = 1e-05) expect_equal(results2CodeBased$repeatedConfidenceIntervalLowerBounds, results2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results2CodeBased$repeatedConfidenceIntervalUpperBounds, results2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results2CodeBased$repeatedPValues, results2$repeatedPValues, tolerance = 1e-05) expect_type(names(results2), "character") df <- as.data.frame(results2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results3 <- getAnalysisResults(design = design1, dataInput = dataExample1, intersectionTest = "Sidak", nPlanned = c(20), directionUpper = TRUE) ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results3' with expected results expect_equal(results3$thetaH1[1, ], 2.1027372, tolerance = 1e-05) expect_equal(results3$thetaH1[2, ], NA_real_) expect_equal(results3$conditionalRejectionProbabilities[1, ], c(0.15801679, 0.51979239, NA_real_), tolerance = 1e-05) expect_equal(results3$conditionalRejectionProbabilities[2, ], c(0.15801679, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results3$conditionalPower[1, ], c(NA_real_, NA_real_, 0.9565118), tolerance = 1e-05) expect_equal(results3$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results3$repeatedConfidenceIntervalLowerBounds[1, ], c(0.83933393, 1.0895056, NA_real_), tolerance = 1e-05) expect_equal(results3$repeatedConfidenceIntervalLowerBounds[2, ], c(0.73682329, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results3$repeatedConfidenceIntervalUpperBounds[1, ], c(6.9250602, 4.2563039, NA_real_), tolerance = 1e-05) expect_equal(results3$repeatedConfidenceIntervalUpperBounds[2, ], c(8.8604482, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results3$repeatedPValues[1, ], c(0.082919001, 0.010252978, NA_real_), tolerance = 1e-05) expect_equal(results3$repeatedPValues[2, ], c(0.082919001, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results3), NA))) expect_output(print(results3)$show()) invisible(capture.output(expect_error(summary(results3), NA))) expect_output(summary(results3)$show()) results3CodeBased <- eval(parse(text = getObjectRCode(results3, stringWrapParagraphWidth = NULL))) expect_equal(results3CodeBased$thetaH1, results3$thetaH1, tolerance = 1e-05) expect_equal(results3CodeBased$conditionalRejectionProbabilities, results3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results3CodeBased$conditionalPower, results3$conditionalPower, tolerance = 1e-05) expect_equal(results3CodeBased$repeatedConfidenceIntervalLowerBounds, results3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results3CodeBased$repeatedConfidenceIntervalUpperBounds, results3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results3CodeBased$repeatedPValues, results3$repeatedPValues, tolerance = 1e-05) expect_type(names(results3), "character") df <- as.data.frame(results3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results4 <- getAnalysisResults(design = design1, dataInput = dataExample1, intersectionTest = "Bonferroni", nPlanned = c(20), directionUpper = TRUE) ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results4' with expected results expect_equal(results4$thetaH1[1, ], 2.1027372, tolerance = 1e-05) expect_equal(results4$thetaH1[2, ], NA_real_) expect_equal(results4$conditionalRejectionProbabilities[1, ], c(0.15727093, 0.51839597, NA_real_), tolerance = 1e-05) expect_equal(results4$conditionalRejectionProbabilities[2, ], c(0.15727093, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$conditionalPower[1, ], c(NA_real_, NA_real_, 0.95618769), tolerance = 1e-05) expect_equal(results4$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results4$repeatedConfidenceIntervalLowerBounds[1, ], c(0.83909611, 1.088337, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedConfidenceIntervalLowerBounds[2, ], c(0.73657731, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedConfidenceIntervalUpperBounds[1, ], c(6.9270216, 4.2761955, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedConfidenceIntervalUpperBounds[2, ], c(8.8634059, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedPValues[1, ], c(0.083499788, 0.010318782, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedPValues[2, ], c(0.083499788, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results4), NA))) expect_output(print(results4)$show()) invisible(capture.output(expect_error(summary(results4), NA))) expect_output(summary(results4)$show()) results4CodeBased <- eval(parse(text = getObjectRCode(results4, stringWrapParagraphWidth = NULL))) expect_equal(results4CodeBased$thetaH1, results4$thetaH1, tolerance = 1e-05) expect_equal(results4CodeBased$conditionalRejectionProbabilities, results4$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results4CodeBased$conditionalPower, results4$conditionalPower, tolerance = 1e-05) expect_equal(results4CodeBased$repeatedConfidenceIntervalLowerBounds, results4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results4CodeBased$repeatedConfidenceIntervalUpperBounds, results4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results4CodeBased$repeatedPValues, results4$repeatedPValues, tolerance = 1e-05) expect_type(names(results4), "character") df <- as.data.frame(results4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results5 <- getAnalysisResults(design = design2, dataInput = dataExample1, intersectionTest = "Dunnett", nPlanned = c(20), seed = 1234, iterations = 1000, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results5' with expected results expect_equal(results5$thetaH1[1, ], 2.1027372, tolerance = 1e-05) expect_equal(results5$thetaH1[2, ], NA_real_) expect_equal(results5$conditionalRejectionProbabilities[1, ], c(0.10966368, 1, NA_real_), tolerance = 1e-05) expect_equal(results5$conditionalRejectionProbabilities[2, ], c(0.10966368, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results5$conditionalPower[1, ], c(NA_real_, NA_real_, 0.93227664), tolerance = 1e-05) expect_equal(results5$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results5$repeatedConfidenceIntervalLowerBounds[1, ], c(0.91202463, 1.0654055, NA_real_), tolerance = 1e-05) expect_equal(results5$repeatedConfidenceIntervalLowerBounds[2, ], c(0.81259534, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results5$repeatedConfidenceIntervalUpperBounds[1, ], c(6.3731146, 4.2132456, NA_real_), tolerance = 1e-05) expect_equal(results5$repeatedConfidenceIntervalUpperBounds[2, ], c(8.0342369, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results5$repeatedPValues[1, ], c(0.04389568, 0.013378163, NA_real_), tolerance = 1e-05) expect_equal(results5$repeatedPValues[2, ], c(0.04389568, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results5), NA))) expect_output(print(results5)$show()) invisible(capture.output(expect_error(summary(results5), NA))) expect_output(summary(results5)$show()) results5CodeBased <- eval(parse(text = getObjectRCode(results5, stringWrapParagraphWidth = NULL))) expect_equal(results5CodeBased$thetaH1, results5$thetaH1, tolerance = 1e-05) expect_equal(results5CodeBased$conditionalRejectionProbabilities, results5$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results5CodeBased$conditionalPower, results5$conditionalPower, tolerance = 1e-05) expect_equal(results5CodeBased$repeatedConfidenceIntervalLowerBounds, results5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results5CodeBased$repeatedConfidenceIntervalUpperBounds, results5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results5CodeBased$repeatedPValues, results5$repeatedPValues, tolerance = 1e-05) expect_type(names(results5), "character") df <- as.data.frame(results5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results6 <- getAnalysisResults(design = design2, dataInput = dataExample1, intersectionTest = "Simes", nPlanned = c(20), seed = 1234, iterations = 1000, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results6' with expected results expect_equal(results6$thetaH1[1, ], 2.1027372, tolerance = 1e-05) expect_equal(results6$thetaH1[2, ], NA_real_) expect_equal(results6$conditionalRejectionProbabilities[1, ], c(0.1211541, 1, NA_real_), tolerance = 1e-05) expect_equal(results6$conditionalRejectionProbabilities[2, ], c(0.1211541, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results6$conditionalPower[1, ], c(NA_real_, NA_real_, 0.94819096), tolerance = 1e-05) expect_equal(results6$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results6$repeatedConfidenceIntervalLowerBounds[1, ], c(0.90417824, 1.0568242, NA_real_), tolerance = 1e-05) expect_equal(results6$repeatedConfidenceIntervalLowerBounds[2, ], c(0.80436275, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results6$repeatedConfidenceIntervalUpperBounds[1, ], c(6.4284199, 4.2747728, NA_real_), tolerance = 1e-05) expect_equal(results6$repeatedConfidenceIntervalUpperBounds[2, ], c(8.1164667, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results6$repeatedPValues[1, ], c(0.039924588, 0.01222708, NA_real_), tolerance = 1e-05) expect_equal(results6$repeatedPValues[2, ], c(0.039924588, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results6), NA))) expect_output(print(results6)$show()) invisible(capture.output(expect_error(summary(results6), NA))) expect_output(summary(results6)$show()) results6CodeBased <- eval(parse(text = getObjectRCode(results6, stringWrapParagraphWidth = NULL))) expect_equal(results6CodeBased$thetaH1, results6$thetaH1, tolerance = 1e-05) expect_equal(results6CodeBased$conditionalRejectionProbabilities, results6$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results6CodeBased$conditionalPower, results6$conditionalPower, tolerance = 1e-05) expect_equal(results6CodeBased$repeatedConfidenceIntervalLowerBounds, results6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results6CodeBased$repeatedConfidenceIntervalUpperBounds, results6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results6CodeBased$repeatedPValues, results6$repeatedPValues, tolerance = 1e-05) expect_type(names(results6), "character") df <- as.data.frame(results6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results7 <- getAnalysisResults(design = design2, dataInput = dataExample1, intersectionTest = "Sidak", nPlanned = c(20), seed = 1234, iterations = 1000, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results7' with expected results expect_equal(results7$thetaH1[1, ], 2.1027372, tolerance = 1e-05) expect_equal(results7$thetaH1[2, ], NA_real_) expect_equal(results7$conditionalRejectionProbabilities[1, ], c(0.1023739, 1, NA_real_), tolerance = 1e-05) expect_equal(results7$conditionalRejectionProbabilities[2, ], c(0.1023739, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results7$conditionalPower[1, ], c(NA_real_, NA_real_, 0.92036569), tolerance = 1e-05) expect_equal(results7$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results7$repeatedConfidenceIntervalLowerBounds[1, ], c(0.90464342, 1.0577667, NA_real_), tolerance = 1e-05) expect_equal(results7$repeatedConfidenceIntervalLowerBounds[2, ], c(0.80485046, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results7$repeatedConfidenceIntervalUpperBounds[1, ], c(6.4251144, 4.2597035, NA_real_), tolerance = 1e-05) expect_equal(results7$repeatedConfidenceIntervalUpperBounds[2, ], c(8.1115484, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results7$repeatedPValues[1, ], c(0.046853018, 0.014230746, NA_real_), tolerance = 1e-05) expect_equal(results7$repeatedPValues[2, ], c(0.046853018, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results7), NA))) expect_output(print(results7)$show()) invisible(capture.output(expect_error(summary(results7), NA))) expect_output(summary(results7)$show()) results7CodeBased <- eval(parse(text = getObjectRCode(results7, stringWrapParagraphWidth = NULL))) expect_equal(results7CodeBased$thetaH1, results7$thetaH1, tolerance = 1e-05) expect_equal(results7CodeBased$conditionalRejectionProbabilities, results7$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results7CodeBased$conditionalPower, results7$conditionalPower, tolerance = 1e-05) expect_equal(results7CodeBased$repeatedConfidenceIntervalLowerBounds, results7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results7CodeBased$repeatedConfidenceIntervalUpperBounds, results7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results7CodeBased$repeatedPValues, results7$repeatedPValues, tolerance = 1e-05) expect_type(names(results7), "character") df <- as.data.frame(results7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results8 <- getAnalysisResults(design = design2, dataInput = dataExample1, intersectionTest = "Bonferroni", nPlanned = c(20), seed = 1234, iterations = 1000, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results8' with expected results expect_equal(results8$thetaH1[1, ], 2.1027372, tolerance = 1e-05) expect_equal(results8$thetaH1[2, ], NA_real_) expect_equal(results8$conditionalRejectionProbabilities[1, ], c(0.10166729, 1, NA_real_), tolerance = 1e-05) expect_equal(results8$conditionalRejectionProbabilities[2, ], c(0.10166729, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results8$conditionalPower[1, ], c(NA_real_, NA_real_, 0.91912747), tolerance = 1e-05) expect_equal(results8$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results8$repeatedConfidenceIntervalLowerBounds[1, ], c(0.90417824, 1.0568242, NA_real_), tolerance = 1e-05) expect_equal(results8$repeatedConfidenceIntervalLowerBounds[2, ], c(0.80436275, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results8$repeatedConfidenceIntervalUpperBounds[1, ], c(6.4284199, 4.2747728, NA_real_), tolerance = 1e-05) expect_equal(results8$repeatedConfidenceIntervalUpperBounds[2, ], c(8.1164667, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results8$repeatedPValues[1, ], c(0.047161054, 0.014319438, NA_real_), tolerance = 1e-05) expect_equal(results8$repeatedPValues[2, ], c(0.047161054, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results8), NA))) expect_output(print(results8)$show()) invisible(capture.output(expect_error(summary(results8), NA))) expect_output(summary(results8)$show()) results8CodeBased <- eval(parse(text = getObjectRCode(results8, stringWrapParagraphWidth = NULL))) expect_equal(results8CodeBased$thetaH1, results8$thetaH1, tolerance = 1e-05) expect_equal(results8CodeBased$conditionalRejectionProbabilities, results8$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results8CodeBased$conditionalPower, results8$conditionalPower, tolerance = 1e-05) expect_equal(results8CodeBased$repeatedConfidenceIntervalLowerBounds, results8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results8CodeBased$repeatedConfidenceIntervalUpperBounds, results8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results8CodeBased$repeatedPValues, results8$repeatedPValues, tolerance = 1e-05) expect_type(names(results8), "character") df <- as.data.frame(results8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results9 <- getAnalysisResults(design = design3, dataInput = dataExample1, intersectionTest = "Dunnett", directionUpper = TRUE) ## Comparison of the results of AnalysisResultsConditionalDunnett object 'results9' with expected results expect_equal(results9$thetaH1[1, ], 2.1027372, tolerance = 1e-05) expect_equal(results9$thetaH1[2, ], NA_real_) expect_equal(results9$conditionalRejectionProbabilities[1, ], c(NA_real_, 0.20921255), tolerance = 1e-05) expect_equal(results9$conditionalRejectionProbabilities[2, ], c(NA_real_, 0.18260705), tolerance = 1e-05) expect_equal(results9$conditionalPower[1, ], c(NA_real_, NA_real_)) expect_equal(results9$conditionalPower[2, ], c(NA_real_, NA_real_)) expect_equal(results9$repeatedConfidenceIntervalLowerBounds[1, ], c(NA_real_, 1.2250509), tolerance = 1e-05) expect_equal(results9$repeatedConfidenceIntervalLowerBounds[2, ], c(NA_real_, NA_real_)) expect_equal(results9$repeatedConfidenceIntervalUpperBounds[1, ], c(NA_real_, 3.6401262), tolerance = 1e-05) expect_equal(results9$repeatedConfidenceIntervalUpperBounds[2, ], c(NA_real_, NA_real_)) expect_equal(results9$repeatedPValues[1, ], c(NA_real_, 0.0032883088), tolerance = 1e-05) expect_equal(results9$repeatedPValues[2, ], c(NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results9), NA))) expect_output(print(results9)$show()) invisible(capture.output(expect_error(summary(results9), NA))) expect_output(summary(results9)$show()) results9CodeBased <- eval(parse(text = getObjectRCode(results9, stringWrapParagraphWidth = NULL))) expect_equal(results9CodeBased$thetaH1, results9$thetaH1, tolerance = 1e-05) expect_equal(results9CodeBased$conditionalRejectionProbabilities, results9$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results9CodeBased$conditionalPower, results9$conditionalPower, tolerance = 1e-05) expect_equal(results9CodeBased$repeatedConfidenceIntervalLowerBounds, results9$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results9CodeBased$repeatedConfidenceIntervalUpperBounds, results9$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results9CodeBased$repeatedPValues, results9$repeatedPValues, tolerance = 1e-05) expect_type(names(results9), "character") df <- as.data.frame(results9) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results9) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results10 <- getAnalysisResults(design = design1, dataInput = dataExample2, intersectionTest = "Dunnett", nPlanned = c(20), directionUpper = FALSE) ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results10' with expected results expect_equal(results10$thetaH1[1, ], 0.47557061, tolerance = 1e-05) expect_equal(results10$thetaH1[2, ], NA_real_) expect_equal(results10$conditionalRejectionProbabilities[1, ], c(0.16551988, 0.53357188, NA_real_), tolerance = 1e-05) expect_equal(results10$conditionalRejectionProbabilities[2, ], c(0.16551988, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results10$conditionalPower[1, ], c(NA_real_, NA_real_, 0.95961075), tolerance = 1e-05) expect_equal(results10$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results10$repeatedConfidenceIntervalLowerBounds[1, ], c(0.14531336, 0.23837116, NA_real_), tolerance = 1e-05) expect_equal(results10$repeatedConfidenceIntervalLowerBounds[2, ], c(0.11370003, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results10$repeatedConfidenceIntervalUpperBounds[1, ], c(1.1839576, 0.91083607, NA_real_), tolerance = 1e-05) expect_equal(results10$repeatedConfidenceIntervalUpperBounds[2, ], c(1.3471639, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results10$repeatedPValues[1, ], c(0.077362906, 0.0096216473, NA_real_), tolerance = 1e-05) expect_equal(results10$repeatedPValues[2, ], c(0.077362906, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results10), NA))) expect_output(print(results10)$show()) invisible(capture.output(expect_error(summary(results10), NA))) expect_output(summary(results10)$show()) results10CodeBased <- eval(parse(text = getObjectRCode(results10, stringWrapParagraphWidth = NULL))) expect_equal(results10CodeBased$thetaH1, results10$thetaH1, tolerance = 1e-05) expect_equal(results10CodeBased$conditionalRejectionProbabilities, results10$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results10CodeBased$conditionalPower, results10$conditionalPower, tolerance = 1e-05) expect_equal(results10CodeBased$repeatedConfidenceIntervalLowerBounds, results10$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results10CodeBased$repeatedConfidenceIntervalUpperBounds, results10$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results10CodeBased$repeatedPValues, results10$repeatedPValues, tolerance = 1e-05) expect_type(names(results10), "character") df <- as.data.frame(results10) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results10) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results11 <- getAnalysisResults(design = design1, dataInput = dataExample2, intersectionTest = "Simes", nPlanned = c(20), directionUpper = FALSE) ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results11' with expected results expect_equal(results11$thetaH1[1, ], 0.47557061, tolerance = 1e-05) expect_equal(results11$thetaH1[2, ], NA_real_) expect_equal(results11$conditionalRejectionProbabilities[1, ], c(0.17669226, 0.55323068, NA_real_), tolerance = 1e-05) expect_equal(results11$conditionalRejectionProbabilities[2, ], c(0.17669226, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results11$conditionalPower[1, ], c(NA_real_, NA_real_, 0.96373388), tolerance = 1e-05) expect_equal(results11$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results11$repeatedConfidenceIntervalLowerBounds[1, ], c(0.14436219, 0.23385276, NA_real_), tolerance = 1e-05) expect_equal(results11$repeatedConfidenceIntervalLowerBounds[2, ], c(0.11282335, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results11$repeatedConfidenceIntervalUpperBounds[1, ], c(1.1917585, 0.91883311, NA_real_), tolerance = 1e-05) expect_equal(results11$repeatedConfidenceIntervalUpperBounds[2, ], c(1.3576308, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results11$repeatedPValues[1, ], c(0.069951918, 0.0087766935, NA_real_), tolerance = 1e-05) expect_equal(results11$repeatedPValues[2, ], c(0.069951918, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results11), NA))) expect_output(print(results11)$show()) invisible(capture.output(expect_error(summary(results11), NA))) expect_output(summary(results11)$show()) results11CodeBased <- eval(parse(text = getObjectRCode(results11, stringWrapParagraphWidth = NULL))) expect_equal(results11CodeBased$thetaH1, results11$thetaH1, tolerance = 1e-05) expect_equal(results11CodeBased$conditionalRejectionProbabilities, results11$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results11CodeBased$conditionalPower, results11$conditionalPower, tolerance = 1e-05) expect_equal(results11CodeBased$repeatedConfidenceIntervalLowerBounds, results11$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results11CodeBased$repeatedConfidenceIntervalUpperBounds, results11$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results11CodeBased$repeatedPValues, results11$repeatedPValues, tolerance = 1e-05) expect_type(names(results11), "character") df <- as.data.frame(results11) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results11) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results12 <- getAnalysisResults(design = design1, dataInput = dataExample2, intersectionTest = "Sidak", nPlanned = c(20), directionUpper = FALSE) ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results12' with expected results expect_equal(results12$thetaH1[1, ], 0.47557061, tolerance = 1e-05) expect_equal(results12$thetaH1[2, ], NA_real_) expect_equal(results12$conditionalRejectionProbabilities[1, ], c(0.15801679, 0.51979239, NA_real_), tolerance = 1e-05) expect_equal(results12$conditionalRejectionProbabilities[2, ], c(0.15801679, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results12$conditionalPower[1, ], c(NA_real_, NA_real_, 0.9565118), tolerance = 1e-05) expect_equal(results12$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results12$repeatedConfidenceIntervalLowerBounds[1, ], c(0.14440308, 0.23494562, NA_real_), tolerance = 1e-05) expect_equal(results12$repeatedConfidenceIntervalLowerBounds[2, ], c(0.11286087, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results12$repeatedConfidenceIntervalUpperBounds[1, ], c(1.1914212, 0.91784736, NA_real_), tolerance = 1e-05) expect_equal(results12$repeatedConfidenceIntervalUpperBounds[2, ], c(1.3571777, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results12$repeatedPValues[1, ], c(0.082919001, 0.010252978, NA_real_), tolerance = 1e-05) expect_equal(results12$repeatedPValues[2, ], c(0.082919001, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results12), NA))) expect_output(print(results12)$show()) invisible(capture.output(expect_error(summary(results12), NA))) expect_output(summary(results12)$show()) results12CodeBased <- eval(parse(text = getObjectRCode(results12, stringWrapParagraphWidth = NULL))) expect_equal(results12CodeBased$thetaH1, results12$thetaH1, tolerance = 1e-05) expect_equal(results12CodeBased$conditionalRejectionProbabilities, results12$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results12CodeBased$conditionalPower, results12$conditionalPower, tolerance = 1e-05) expect_equal(results12CodeBased$repeatedConfidenceIntervalLowerBounds, results12$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results12CodeBased$repeatedConfidenceIntervalUpperBounds, results12$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results12CodeBased$repeatedPValues, results12$repeatedPValues, tolerance = 1e-05) expect_type(names(results12), "character") df <- as.data.frame(results12) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results12) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results13 <- getAnalysisResults(design = design1, dataInput = dataExample2, intersectionTest = "Bonferroni", nPlanned = c(20), directionUpper = FALSE) ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results13' with expected results expect_equal(results13$thetaH1[1, ], 0.47557061, tolerance = 1e-05) expect_equal(results13$thetaH1[2, ], NA_real_) expect_equal(results13$conditionalRejectionProbabilities[1, ], c(0.15727093, 0.51839597, NA_real_), tolerance = 1e-05) expect_equal(results13$conditionalRejectionProbabilities[2, ], c(0.15727093, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results13$conditionalPower[1, ], c(NA_real_, NA_real_, 0.95618769), tolerance = 1e-05) expect_equal(results13$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results13$repeatedConfidenceIntervalLowerBounds[1, ], c(0.14436219, 0.23385276, NA_real_), tolerance = 1e-05) expect_equal(results13$repeatedConfidenceIntervalLowerBounds[2, ], c(0.11282335, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results13$repeatedConfidenceIntervalUpperBounds[1, ], c(1.1917585, 0.91883311, NA_real_), tolerance = 1e-05) expect_equal(results13$repeatedConfidenceIntervalUpperBounds[2, ], c(1.3576308, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results13$repeatedPValues[1, ], c(0.083499788, 0.010318782, NA_real_), tolerance = 1e-05) expect_equal(results13$repeatedPValues[2, ], c(0.083499788, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results13), NA))) expect_output(print(results13)$show()) invisible(capture.output(expect_error(summary(results13), NA))) expect_output(summary(results13)$show()) results13CodeBased <- eval(parse(text = getObjectRCode(results13, stringWrapParagraphWidth = NULL))) expect_equal(results13CodeBased$thetaH1, results13$thetaH1, tolerance = 1e-05) expect_equal(results13CodeBased$conditionalRejectionProbabilities, results13$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results13CodeBased$conditionalPower, results13$conditionalPower, tolerance = 1e-05) expect_equal(results13CodeBased$repeatedConfidenceIntervalLowerBounds, results13$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results13CodeBased$repeatedConfidenceIntervalUpperBounds, results13$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results13CodeBased$repeatedPValues, results13$repeatedPValues, tolerance = 1e-05) expect_type(names(results13), "character") df <- as.data.frame(results13) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results13) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results14 <- getAnalysisResults(design = design2, dataInput = dataExample2, intersectionTest = "Dunnett", nPlanned = c(20), seed = 1234, iterations = 1000, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results14' with expected results expect_equal(results14$thetaH1[1, ], 0.47557061, tolerance = 1e-05) expect_equal(results14$thetaH1[2, ], NA_real_) expect_equal(results14$conditionalRejectionProbabilities[1, ], c(0.10966368, 1, NA_real_), tolerance = 1e-05) expect_equal(results14$conditionalRejectionProbabilities[2, ], c(0.10966368, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results14$conditionalPower[1, ], c(NA_real_, NA_real_, 0.93227664), tolerance = 1e-05) expect_equal(results14$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results14$repeatedConfidenceIntervalLowerBounds[1, ], c(0.15690919, 0.23734662, NA_real_), tolerance = 1e-05) expect_equal(results14$repeatedConfidenceIntervalLowerBounds[2, ], c(0.12446713, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results14$repeatedConfidenceIntervalUpperBounds[1, ], c(1.0964616, 0.93860979, NA_real_), tolerance = 1e-05) expect_equal(results14$repeatedConfidenceIntervalUpperBounds[2, ], c(1.2306248, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results14$repeatedPValues[1, ], c(0.04389568, 0.013378163, NA_real_), tolerance = 1e-05) expect_equal(results14$repeatedPValues[2, ], c(0.04389568, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results14), NA))) expect_output(print(results14)$show()) invisible(capture.output(expect_error(summary(results14), NA))) expect_output(summary(results14)$show()) results14CodeBased <- eval(parse(text = getObjectRCode(results14, stringWrapParagraphWidth = NULL))) expect_equal(results14CodeBased$thetaH1, results14$thetaH1, tolerance = 1e-05) expect_equal(results14CodeBased$conditionalRejectionProbabilities, results14$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results14CodeBased$conditionalPower, results14$conditionalPower, tolerance = 1e-05) expect_equal(results14CodeBased$repeatedConfidenceIntervalLowerBounds, results14$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results14CodeBased$repeatedConfidenceIntervalUpperBounds, results14$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results14CodeBased$repeatedPValues, results14$repeatedPValues, tolerance = 1e-05) expect_type(names(results14), "character") df <- as.data.frame(results14) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results14) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results15 <- getAnalysisResults(design = design2, dataInput = dataExample2, intersectionTest = "Simes", nPlanned = c(20), seed = 1234, iterations = 1000, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results15' with expected results expect_equal(results15$thetaH1[1, ], 0.47557061, tolerance = 1e-05) expect_equal(results15$thetaH1[2, ], NA_real_) expect_equal(results15$conditionalRejectionProbabilities[1, ], c(0.1211541, 1, NA_real_), tolerance = 1e-05) expect_equal(results15$conditionalRejectionProbabilities[2, ], c(0.1211541, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results15$conditionalPower[1, ], c(NA_real_, NA_real_, 0.94819096), tolerance = 1e-05) expect_equal(results15$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results15$repeatedConfidenceIntervalLowerBounds[1, ], c(0.15555937, 0.23393056, NA_real_), tolerance = 1e-05) expect_equal(results15$repeatedConfidenceIntervalLowerBounds[2, ], c(0.12320632, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results15$repeatedConfidenceIntervalUpperBounds[1, ], c(1.1059766, 0.94623115, NA_real_), tolerance = 1e-05) expect_equal(results15$repeatedConfidenceIntervalUpperBounds[2, ], c(1.2432202, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results15$repeatedPValues[1, ], c(0.039924588, 0.01222708, NA_real_), tolerance = 1e-05) expect_equal(results15$repeatedPValues[2, ], c(0.039924588, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results15), NA))) expect_output(print(results15)$show()) invisible(capture.output(expect_error(summary(results15), NA))) expect_output(summary(results15)$show()) results15CodeBased <- eval(parse(text = getObjectRCode(results15, stringWrapParagraphWidth = NULL))) expect_equal(results15CodeBased$thetaH1, results15$thetaH1, tolerance = 1e-05) expect_equal(results15CodeBased$conditionalRejectionProbabilities, results15$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results15CodeBased$conditionalPower, results15$conditionalPower, tolerance = 1e-05) expect_equal(results15CodeBased$repeatedConfidenceIntervalLowerBounds, results15$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results15CodeBased$repeatedConfidenceIntervalUpperBounds, results15$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results15CodeBased$repeatedPValues, results15$repeatedPValues, tolerance = 1e-05) expect_type(names(results15), "character") df <- as.data.frame(results15) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results15) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results16 <- getAnalysisResults(design = design2, dataInput = dataExample2, intersectionTest = "Sidak", nPlanned = c(20), seed = 1234, iterations = 1000, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results16' with expected results expect_equal(results16$thetaH1[1, ], 0.47557061, tolerance = 1e-05) expect_equal(results16$thetaH1[2, ], NA_real_) expect_equal(results16$conditionalRejectionProbabilities[1, ], c(0.1023739, 1, NA_real_), tolerance = 1e-05) expect_equal(results16$conditionalRejectionProbabilities[2, ], c(0.1023739, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results16$conditionalPower[1, ], c(NA_real_, NA_real_, 0.92036569), tolerance = 1e-05) expect_equal(results16$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results16$repeatedConfidenceIntervalLowerBounds[1, ], c(0.15563938, 0.23475813, NA_real_), tolerance = 1e-05) expect_equal(results16$repeatedConfidenceIntervalLowerBounds[2, ], c(0.1232811, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results16$repeatedConfidenceIntervalUpperBounds[1, ], c(1.1054079, 0.94538806, NA_real_), tolerance = 1e-05) expect_equal(results16$repeatedConfidenceIntervalUpperBounds[2, ], c(1.2424668, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results16$repeatedPValues[1, ], c(0.046853018, 0.014230746, NA_real_), tolerance = 1e-05) expect_equal(results16$repeatedPValues[2, ], c(0.046853018, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results16), NA))) expect_output(print(results16)$show()) invisible(capture.output(expect_error(summary(results16), NA))) expect_output(summary(results16)$show()) results16CodeBased <- eval(parse(text = getObjectRCode(results16, stringWrapParagraphWidth = NULL))) expect_equal(results16CodeBased$thetaH1, results16$thetaH1, tolerance = 1e-05) expect_equal(results16CodeBased$conditionalRejectionProbabilities, results16$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results16CodeBased$conditionalPower, results16$conditionalPower, tolerance = 1e-05) expect_equal(results16CodeBased$repeatedConfidenceIntervalLowerBounds, results16$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results16CodeBased$repeatedConfidenceIntervalUpperBounds, results16$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results16CodeBased$repeatedPValues, results16$repeatedPValues, tolerance = 1e-05) expect_type(names(results16), "character") df <- as.data.frame(results16) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results16) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results17 <- getAnalysisResults(design = design2, dataInput = dataExample2, intersectionTest = "Bonferroni", nPlanned = c(20), seed = 1234, iterations = 1000, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results17' with expected results expect_equal(results17$thetaH1[1, ], 0.47557061, tolerance = 1e-05) expect_equal(results17$thetaH1[2, ], NA_real_) expect_equal(results17$conditionalRejectionProbabilities[1, ], c(0.10166729, 1, NA_real_), tolerance = 1e-05) expect_equal(results17$conditionalRejectionProbabilities[2, ], c(0.10166729, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results17$conditionalPower[1, ], c(NA_real_, NA_real_, 0.91912747), tolerance = 1e-05) expect_equal(results17$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(results17$repeatedConfidenceIntervalLowerBounds[1, ], c(0.15555937, 0.23393056, NA_real_), tolerance = 1e-05) expect_equal(results17$repeatedConfidenceIntervalLowerBounds[2, ], c(0.12320632, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results17$repeatedConfidenceIntervalUpperBounds[1, ], c(1.1059766, 0.94623115, NA_real_), tolerance = 1e-05) expect_equal(results17$repeatedConfidenceIntervalUpperBounds[2, ], c(1.2432202, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results17$repeatedPValues[1, ], c(0.047161054, 0.014319438, NA_real_), tolerance = 1e-05) expect_equal(results17$repeatedPValues[2, ], c(0.047161054, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results17), NA))) expect_output(print(results17)$show()) invisible(capture.output(expect_error(summary(results17), NA))) expect_output(summary(results17)$show()) results17CodeBased <- eval(parse(text = getObjectRCode(results17, stringWrapParagraphWidth = NULL))) expect_equal(results17CodeBased$thetaH1, results17$thetaH1, tolerance = 1e-05) expect_equal(results17CodeBased$conditionalRejectionProbabilities, results17$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results17CodeBased$conditionalPower, results17$conditionalPower, tolerance = 1e-05) expect_equal(results17CodeBased$repeatedConfidenceIntervalLowerBounds, results17$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results17CodeBased$repeatedConfidenceIntervalUpperBounds, results17$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results17CodeBased$repeatedPValues, results17$repeatedPValues, tolerance = 1e-05) expect_type(names(results17), "character") df <- as.data.frame(results17) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results17) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmSurvival} results18 <- getAnalysisResults(design = design3, dataInput = dataExample2, intersectionTest = "Dunnett", directionUpper = FALSE) ## Comparison of the results of AnalysisResultsConditionalDunnett object 'results18' with expected results expect_equal(results18$thetaH1[1, ], 0.47557061, tolerance = 1e-05) expect_equal(results18$thetaH1[2, ], NA_real_) expect_equal(results18$conditionalRejectionProbabilities[1, ], c(NA_real_, 0.20921255), tolerance = 1e-05) expect_equal(results18$conditionalRejectionProbabilities[2, ], c(NA_real_, 0.18260705), tolerance = 1e-05) expect_equal(results18$conditionalPower[1, ], c(NA_real_, NA_real_)) expect_equal(results18$conditionalPower[2, ], c(NA_real_, NA_real_)) expect_equal(results18$repeatedConfidenceIntervalLowerBounds[1, ], c(NA_real_, 0.27471638), tolerance = 1e-05) expect_equal(results18$repeatedConfidenceIntervalLowerBounds[2, ], c(NA_real_, NA_real_)) expect_equal(results18$repeatedConfidenceIntervalUpperBounds[1, ], c(NA_real_, 0.81629276), tolerance = 1e-05) expect_equal(results18$repeatedConfidenceIntervalUpperBounds[2, ], c(NA_real_, NA_real_)) expect_equal(results18$repeatedPValues[1, ], c(NA_real_, 0.0032883088), tolerance = 1e-05) expect_equal(results18$repeatedPValues[2, ], c(NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results18), NA))) expect_output(print(results18)$show()) invisible(capture.output(expect_error(summary(results18), NA))) expect_output(summary(results18)$show()) results18CodeBased <- eval(parse(text = getObjectRCode(results18, stringWrapParagraphWidth = NULL))) expect_equal(results18CodeBased$thetaH1, results18$thetaH1, tolerance = 1e-05) expect_equal(results18CodeBased$conditionalRejectionProbabilities, results18$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results18CodeBased$conditionalPower, results18$conditionalPower, tolerance = 1e-05) expect_equal(results18CodeBased$repeatedConfidenceIntervalLowerBounds, results18$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results18CodeBased$repeatedConfidenceIntervalUpperBounds, results18$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results18CodeBased$repeatedPValues, results18$repeatedPValues, tolerance = 1e-05) expect_type(names(results18), "character") df <- as.data.frame(results18) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results18) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) rpact/tests/testthat/test-f_simulation_enrichment_rates.R0000644000175000017500000021063414165526557023750 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_simulation_enrichment_rates.R ## | Creation date: 14 December 2021, 13:06:29 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Simulation Enrichment Rates Function") test_that("'getSimulationEnrichmentRates': gMax = 2", { options(warn = -1) # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:enrichmentDesigns} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:subsec:adaptiveClosedTestProcedureEnrichment} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:sec:simulationFunctions} # @refFS[Sec.]{fs:sec:simulatingEnrichmentDesigns} # @refFS[Sec.]{fs:sec:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:testStatisticEnrichmentRates} # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichment} # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} # @refFS[Formula]{fs:simulationEnrichmentRatesGenerate} # @refFS[Formula]{fs:simulationEnrichmentSelections} # @refFS[Formula]{fs:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:enrichmentRejectionRule} piInput <- c(0.3, 0.5, 0.3, 0.6, 0.3, 0.7, 0.3, 0.8, 0.4, 0.5, 0.4, 0.6, 0.4, 0.7, 0.4, 0.8, 0.5, 0.5, 0.5, 0.6, 0.5, 0.7, 0.5, 0.8) effectList <- list( subGroups = c("S", "R"), prevalences = c(0.74, 0.26), piControl = c(0.3, 0.5), piTreatments = matrix(piInput, byrow = TRUE, ncol = 2) ) design <- getDesignInverseNormal(informationRates = c(0.4, 1), typeOfDesign = "WT", deltaWT = 0.1) suppressWarnings(simResult1 <- getSimulationEnrichmentRates(design, plannedSubjects = c(150, 300), effectList = effectList, maxNumberOfIterations = 100, effectMeasure = "effectEstimate", stratifiedAnalysis = TRUE, allocationRatioPlanned = 2, directionUpper = TRUE, successCriterion = "atLeastOne", typeOfSelection = "rbest", rValue = 2, intersectionTest = "SpiessensDebois", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentRates object 'simResult1' with expected results expect_equal(simResult1$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult1$iterations[2, ], c(100, 100, 99, 96, 98, 97, 93, 89, 86, 88, 65, 59)) expect_equal(simResult1$rejectAtLeastOne, c(0.03, 0.03, 0.17, 0.17, 0.26, 0.41, 0.47, 0.63, 0.8, 0.84, 0.86, 0.99), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$rejectedPopulationsPerStage)), c(0, 0.02, 0, 0.02, 0, 0.05, 0, 0.02, 0.01, 0.23, 0.03, 0.28, 0.01, 0.27, 0.02, 0.19, 0.11, 0.65, 0.09, 0.68, 0.22, 0.44, 0.18, 0.41, 0, 0.02, 0, 0.03, 0.01, 0.16, 0.04, 0.13, 0.02, 0.2, 0.03, 0.35, 0.07, 0.4, 0.11, 0.52, 0.1, 0.57, 0.1, 0.7, 0.32, 0.49, 0.39, 0.58), tolerance = 1e-07) expect_equal(simResult1$futilityPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult1$earlyStop[1, ], c(0, 0, 0.01, 0.04, 0.02, 0.03, 0.07, 0.11, 0.14, 0.12, 0.35, 0.41), tolerance = 1e-07) expect_equal(simResult1$successPerStage[1, ], c(0, 0, 0.01, 0.04, 0.02, 0.03, 0.07, 0.11, 0.14, 0.12, 0.35, 0.41), tolerance = 1e-07) expect_equal(simResult1$successPerStage[2, ], c(0.03, 0.03, 0.16, 0.13, 0.24, 0.38, 0.4, 0.52, 0.66, 0.72, 0.51, 0.58), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$selectedPopulations)), c(1, 1, 1, 1, 1, 0.99, 1, 0.96, 1, 0.98, 1, 0.97, 1, 0.93, 1, 0.89, 1, 0.86, 1, 0.88, 1, 0.65, 1, 0.59, 1, 1, 1, 1, 1, 0.99, 1, 0.96, 1, 0.98, 1, 0.97, 1, 0.93, 1, 0.89, 1, 0.86, 1, 0.88, 1, 0.65, 1, 0.59), tolerance = 1e-07) expect_equal(simResult1$numberOfPopulations[1, ], c(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult1$numberOfPopulations[2, ], c(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult1$expectedNumberOfSubjects, c(300, 300, 298.5, 294, 297, 295.5, 289.5, 283.5, 279, 282, 247.5, 238.5), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$sampleSizes)), c(111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39)) expect_equal(simResult1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult1$conditionalPowerAchieved[2, ], c(0.057886457, 0.11722504, 0.17374263, 0.14254287, 0.24091794, 0.35196657, 0.39807899, 0.36830797, 0.54596748, 0.63396607, 0.61766608, 0.68903084), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult1), NA))) expect_output(print(simResult1)$show()) invisible(capture.output(expect_error(summary(simResult1), NA))) expect_output(summary(simResult1)$show()) simResult1CodeBased <- eval(parse(text = getObjectRCode(simResult1, stringWrapParagraphWidth = NULL))) expect_equal(simResult1CodeBased$iterations, simResult1$iterations, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectAtLeastOne, simResult1$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectedPopulationsPerStage, simResult1$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$futilityPerStage, simResult1$futilityPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$earlyStop, simResult1$earlyStop, tolerance = 1e-05) expect_equal(simResult1CodeBased$successPerStage, simResult1$successPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$selectedPopulations, simResult1$selectedPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$numberOfPopulations, simResult1$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$expectedNumberOfSubjects, simResult1$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult1CodeBased$sampleSizes, simResult1$sampleSizes, tolerance = 1e-05) expect_equal(simResult1CodeBased$conditionalPowerAchieved, simResult1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult1), "character") df <- as.data.frame(simResult1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfNotX64() suppressWarnings(simResult2 <- getSimulationEnrichmentRates(design, plannedSubjects = c(150, 300), effectList = effectList, maxNumberOfIterations = 100, effectMeasure = "effectEstimate", stratifiedAnalysis = TRUE, piTreatmentH1 = 0.6, piControlH1 = 0.45, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA, 150), maxNumberOfSubjectsPerStage = c(NA, 600), allocationRatioPlanned = 2, directionUpper = TRUE, successCriterion = "atLeastOne", typeOfSelection = "epsilon", epsilonValue = 0.025, intersectionTest = "Simes", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentRates object 'simResult2' with expected results expect_equal(simResult2$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult2$iterations[2, ], c(99, 100, 99, 96, 100, 95, 91, 91, 83, 79, 79, 63)) expect_equal(simResult2$rejectAtLeastOne, c(0.04, 0.04, 0.15, 0.36, 0.41, 0.54, 0.7, 0.92, 0.94, 0.93, 0.97, 0.98), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$rejectedPopulationsPerStage)), c(0.01, 0.03, 0, 0.01, 0.01, 0.01, 0, 0, 0, 0.36, 0.03, 0.31, 0.03, 0.22, 0.02, 0.12, 0.16, 0.73, 0.18, 0.55, 0.16, 0.45, 0.23, 0.29, 0, 0.01, 0, 0.03, 0.01, 0.14, 0.04, 0.32, 0, 0.14, 0.04, 0.38, 0.09, 0.52, 0.09, 0.8, 0.11, 0.23, 0.2, 0.44, 0.21, 0.57, 0.37, 0.51), tolerance = 1e-07) expect_equal(simResult2$futilityPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult2$earlyStop[1, ], c(0.01, 0, 0.01, 0.04, 0, 0.05, 0.09, 0.09, 0.17, 0.21, 0.21, 0.37), tolerance = 1e-07) expect_equal(simResult2$successPerStage[1, ], c(0.01, 0, 0.01, 0.04, 0, 0.05, 0.09, 0.09, 0.17, 0.21, 0.21, 0.37), tolerance = 1e-07) expect_equal(simResult2$successPerStage[2, ], c(0.03, 0.04, 0.14, 0.32, 0.41, 0.49, 0.61, 0.83, 0.77, 0.72, 0.76, 0.61), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$selectedPopulations)), c(1, 0.64, 1, 0.55, 1, 0.3, 1, 0.13, 1, 0.87, 1, 0.63, 1, 0.44, 1, 0.28, 1, 0.77, 1, 0.62, 1, 0.49, 1, 0.32, 1, 0.71, 1, 0.78, 1, 0.93, 1, 0.95, 1, 0.44, 1, 0.74, 1, 0.79, 1, 0.87, 1, 0.31, 1, 0.49, 1, 0.59, 1, 0.51), tolerance = 1e-07) expect_equal(simResult2$numberOfPopulations[1, ], c(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult2$numberOfPopulations[2, ], c(1.3636364, 1.33, 1.2424242, 1.125, 1.31, 1.4421053, 1.3516484, 1.2637363, 1.3012048, 1.4050633, 1.3670886, 1.3174603), tolerance = 1e-07) expect_equal(simResult2$expectedNumberOfSubjects, c(669.59264, 671.53258, 620.0907, 573.83864, 556.82907, 514.33552, 439.19492, 418.05629, 385.4022, 357.09909, 335.03201, 280.36711), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$sampleSizes)), c(111, 424.65084, 111, 412.59405, 111, 358.73817, 111, 327.31465, 111, 356.03736, 111, 302.73985, 111, 244.22837, 111, 220.27012, 111, 253.59117, 111, 214.59387, 111, 187.06662, 111, 161.81648, 39, 100.19021, 39, 108.93853, 39, 116.10091, 39, 114.18394, 39, 50.79171, 39, 80.771228, 39, 73.56825, 39, 74.297232, 39, 30.025946, 39, 47.556877, 39, 47.151107, 39, 45.115446), tolerance = 1e-07) expect_equal(simResult2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult2$conditionalPowerAchieved[2, ], c(0.47580257, 0.49594366, 0.54143038, 0.56498304, 0.65590031, 0.69185697, 0.74958231, 0.78227803, 0.78802696, 0.82212774, 0.82750537, 0.8268688), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult2), NA))) expect_output(print(simResult2)$show()) invisible(capture.output(expect_error(summary(simResult2), NA))) expect_output(summary(simResult2)$show()) simResult2CodeBased <- eval(parse(text = getObjectRCode(simResult2, stringWrapParagraphWidth = NULL))) expect_equal(simResult2CodeBased$iterations, simResult2$iterations, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectAtLeastOne, simResult2$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectedPopulationsPerStage, simResult2$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$futilityPerStage, simResult2$futilityPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$earlyStop, simResult2$earlyStop, tolerance = 1e-05) expect_equal(simResult2CodeBased$successPerStage, simResult2$successPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$selectedPopulations, simResult2$selectedPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$numberOfPopulations, simResult2$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$expectedNumberOfSubjects, simResult2$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult2CodeBased$sampleSizes, simResult2$sampleSizes, tolerance = 1e-05) expect_equal(simResult2CodeBased$conditionalPowerAchieved, simResult2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult2), "character") df <- as.data.frame(simResult2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult3 <- getSimulationEnrichmentRates(design, plannedSubjects = c(150, 300), effectList = effectList, maxNumberOfIterations = 100, effectMeasure = "effectEstimate", stratifiedAnalysis = TRUE, allocationRatioPlanned = 2, directionUpper = TRUE, successCriterion = "atLeastOne", typeOfSelection = "best", intersectionTest = "Sidak", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentRates object 'simResult3' with expected results expect_equal(simResult3$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult3$iterations[2, ], c(100, 100, 98, 98, 100, 97, 94, 87, 84, 89, 77, 61)) expect_equal(simResult3$rejectAtLeastOne, c(0.01, 0.03, 0.15, 0.21, 0.19, 0.31, 0.51, 0.62, 0.85, 0.78, 0.91, 0.96), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$rejectedPopulationsPerStage)), c(0, 0.01, 0, 0.01, 0, 0, 0, 0, 0, 0.17, 0.03, 0.16, 0.03, 0.1, 0.02, 0.03, 0.12, 0.58, 0.1, 0.49, 0.19, 0.44, 0.19, 0.11, 0, 0, 0, 0.02, 0.02, 0.13, 0.02, 0.19, 0, 0.02, 0.03, 0.12, 0.06, 0.35, 0.13, 0.46, 0.13, 0.11, 0.1, 0.18, 0.21, 0.24, 0.36, 0.46), tolerance = 1e-07) expect_equal(simResult3$futilityPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult3$earlyStop[1, ], c(0, 0, 0.02, 0.02, 0, 0.03, 0.06, 0.13, 0.16, 0.11, 0.23, 0.39), tolerance = 1e-07) expect_equal(simResult3$successPerStage[1, ], c(0, 0, 0.02, 0.02, 0, 0.03, 0.06, 0.13, 0.16, 0.11, 0.23, 0.39), tolerance = 1e-07) expect_equal(simResult3$successPerStage[2, ], c(0.01, 0.03, 0.13, 0.19, 0.19, 0.28, 0.45, 0.49, 0.69, 0.67, 0.68, 0.57), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$selectedPopulations)), c(1, 0.44, 1, 0.31, 1, 0.13, 1, 0.09, 1, 0.71, 1, 0.45, 1, 0.24, 1, 0.14, 1, 0.68, 1, 0.59, 1, 0.48, 1, 0.12, 1, 0.56, 1, 0.69, 1, 0.85, 1, 0.89, 1, 0.29, 1, 0.52, 1, 0.7, 1, 0.73, 1, 0.16, 1, 0.3, 1, 0.29, 1, 0.49), tolerance = 1e-07) expect_equal(simResult3$numberOfPopulations[1, ], c(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult3$numberOfPopulations[2, ], c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)) expect_equal(simResult3$expectedNumberOfSubjects, c(300, 300, 297, 297, 300, 295.5, 291, 280.5, 276, 283.5, 265.5, 241.5), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$sampleSizes)), c(111, 128.16, 111, 123.09, 111, 116.17347, 111, 114.58163, 111, 138.69, 111, 129.09278, 111, 120.95745, 111, 117.27586, 111, 142.57143, 111, 136.85393, 111, 135.31169, 111, 118.67213, 39, 21.84, 39, 26.91, 39, 33.826531, 39, 35.418367, 39, 11.31, 39, 20.907216, 39, 29.042553, 39, 32.724138, 39, 7.4285714, 39, 13.146067, 39, 14.688312, 39, 31.327869), tolerance = 1e-07) expect_equal(simResult3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult3$conditionalPowerAchieved[2, ], c(0.083063533, 0.12244222, 0.16903461, 0.19341855, 0.20869939, 0.28782427, 0.42698224, 0.4072498, 0.57493889, 0.6368279, 0.70412178, 0.6855194), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult3), NA))) expect_output(print(simResult3)$show()) invisible(capture.output(expect_error(summary(simResult3), NA))) expect_output(summary(simResult3)$show()) simResult3CodeBased <- eval(parse(text = getObjectRCode(simResult3, stringWrapParagraphWidth = NULL))) expect_equal(simResult3CodeBased$iterations, simResult3$iterations, tolerance = 1e-05) expect_equal(simResult3CodeBased$rejectAtLeastOne, simResult3$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult3CodeBased$rejectedPopulationsPerStage, simResult3$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$futilityPerStage, simResult3$futilityPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$earlyStop, simResult3$earlyStop, tolerance = 1e-05) expect_equal(simResult3CodeBased$successPerStage, simResult3$successPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$selectedPopulations, simResult3$selectedPopulations, tolerance = 1e-05) expect_equal(simResult3CodeBased$numberOfPopulations, simResult3$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult3CodeBased$expectedNumberOfSubjects, simResult3$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult3CodeBased$sampleSizes, simResult3$sampleSizes, tolerance = 1e-05) expect_equal(simResult3CodeBased$conditionalPowerAchieved, simResult3$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult3), "character") df <- as.data.frame(simResult3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult4 <- getSimulationEnrichmentRates(design, plannedSubjects = c(150, 300), effectList = effectList, maxNumberOfIterations = 100, effectMeasure = "effectEstimate", stratifiedAnalysis = TRUE, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA, 150), maxNumberOfSubjectsPerStage = c(NA, 600), allocationRatioPlanned = 2, directionUpper = TRUE, successCriterion = "atLeastOne", typeOfSelection = "epsilon", epsilonValue = 0.025, intersectionTest = "Bonferroni", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentRates object 'simResult4' with expected results expect_equal(simResult4$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult4$iterations[2, ], c(57, 60, 73, 78, 91, 90, 86, 84, 80, 79, 75, 63)) expect_equal(simResult4$rejectAtLeastOne, c(0.02, 0.02, 0.13, 0.38, 0.43, 0.49, 0.63, 0.82, 0.84, 0.87, 0.95, 0.97), tolerance = 1e-07) expect_equal(unlist(as.list(simResult4$rejectedPopulationsPerStage)), c(0, 0.01, 0, 0, 0, 0, 0, 0.02, 0, 0.38, 0.02, 0.31, 0.03, 0.16, 0.01, 0.11, 0.16, 0.63, 0.17, 0.53, 0.18, 0.49, 0.18, 0.33, 0, 0.01, 0, 0.02, 0.01, 0.12, 0.04, 0.34, 0, 0.15, 0.02, 0.31, 0.09, 0.5, 0.12, 0.66, 0.09, 0.23, 0.16, 0.37, 0.24, 0.49, 0.37, 0.48), tolerance = 1e-07) expect_equal(simResult4$futilityPerStage[1, ], c(0.43, 0.4, 0.26, 0.18, 0.09, 0.08, 0.05, 0.04, 0.03, 0.01, 0.01, 0), tolerance = 1e-07) expect_equal(simResult4$earlyStop[1, ], c(0.43, 0.4, 0.27, 0.22, 0.09, 0.1, 0.14, 0.16, 0.2, 0.21, 0.25, 0.37), tolerance = 1e-07) expect_equal(simResult4$successPerStage[1, ], c(0, 0, 0.01, 0.04, 0, 0.02, 0.09, 0.12, 0.17, 0.2, 0.24, 0.37), tolerance = 1e-07) expect_equal(simResult4$successPerStage[2, ], c(0.02, 0.02, 0.12, 0.34, 0.43, 0.47, 0.54, 0.7, 0.67, 0.67, 0.71, 0.6), tolerance = 1e-07) expect_equal(unlist(as.list(simResult4$selectedPopulations)), c(1, 0.47, 1, 0.28, 1, 0.21, 1, 0.15, 1, 0.79, 1, 0.64, 1, 0.43, 1, 0.23, 1, 0.73, 1, 0.61, 1, 0.53, 1, 0.36, 1, 0.3, 1, 0.46, 1, 0.67, 1, 0.76, 1, 0.43, 1, 0.62, 1, 0.77, 1, 0.8, 1, 0.31, 1, 0.47, 1, 0.52, 1, 0.5), tolerance = 1e-07) expect_equal(simResult4$numberOfPopulations[1, ], c(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult4$numberOfPopulations[2, ], c(1.3508772, 1.2333333, 1.2054795, 1.1666667, 1.3406593, 1.4, 1.3953488, 1.2261905, 1.3, 1.3670886, 1.4, 1.3650794), tolerance = 1e-07) expect_equal(simResult4$expectedNumberOfSubjects, c(453.37572, 447.96694, 541.237, 483.73584, 535.2315, 511.41354, 448.69764, 410.71972, 362.5422, 354.38041, 338.45385, 285.45619), tolerance = 1e-07) expect_equal(unlist(as.list(simResult4$sampleSizes)), c(111, 459.21285, 111, 397.21147, 111, 406.83057, 111, 317.9318, 111, 364.75188, 111, 324.0256, 111, 263.10197, 111, 232.55273, 111, 230.38271, 111, 215.59706, 111, 201.103, 111, 168.7985, 39, 73.025259, 39, 99.400093, 39, 129.11053, 39, 109.93466, 39, 58.579437, 39, 77.545002, 39, 84.220859, 39, 77.827889, 39, 35.295041, 39, 43.112321, 39, 50.1688, 39, 46.211325), tolerance = 1e-07) expect_equal(simResult4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult4$conditionalPowerAchieved[2, ], c(0.17722261, 0.20630429, 0.22165392, 0.29435606, 0.38613941, 0.45798394, 0.53716481, 0.50557573, 0.59360581, 0.71535155, 0.72089862, 0.74669086), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult4), NA))) expect_output(print(simResult4)$show()) invisible(capture.output(expect_error(summary(simResult4), NA))) expect_output(summary(simResult4)$show()) simResult4CodeBased <- eval(parse(text = getObjectRCode(simResult4, stringWrapParagraphWidth = NULL))) expect_equal(simResult4CodeBased$iterations, simResult4$iterations, tolerance = 1e-05) expect_equal(simResult4CodeBased$rejectAtLeastOne, simResult4$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult4CodeBased$rejectedPopulationsPerStage, simResult4$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$futilityPerStage, simResult4$futilityPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$earlyStop, simResult4$earlyStop, tolerance = 1e-05) expect_equal(simResult4CodeBased$successPerStage, simResult4$successPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$selectedPopulations, simResult4$selectedPopulations, tolerance = 1e-05) expect_equal(simResult4CodeBased$numberOfPopulations, simResult4$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult4CodeBased$expectedNumberOfSubjects, simResult4$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult4CodeBased$sampleSizes, simResult4$sampleSizes, tolerance = 1e-05) expect_equal(simResult4CodeBased$conditionalPowerAchieved, simResult4$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult4), "character") df <- as.data.frame(simResult4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationEnrichmentRates': gMax = 3", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:enrichmentDesigns} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:subsec:adaptiveClosedTestProcedureEnrichment} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:sec:simulationFunctions} # @refFS[Sec.]{fs:sec:simulatingEnrichmentDesigns} # @refFS[Sec.]{fs:sec:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:testStatisticEnrichmentRates} # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:simulationEnrichmentRatesGenerate} # @refFS[Formula]{fs:simulationEnrichmentSelections} # @refFS[Formula]{fs:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:enrichmentRejectionRule} .skipTestIfDisabled() .skipTestIfNotX64() piTreatments <- c( 0.30, 0.40, 0.30, 0.55, 0.30, 0.40, 0.30, 0.75, 0.30, 0.40, 0.50, 0.55, 0.30, 0.40, 0.50, 0.75, 0.30, 0.60, 0.30, 0.55, 0.30, 0.60, 0.30, 0.75, 0.30, 0.60, 0.50, 0.55, 0.30, 0.60, 0.50, 0.75, 0.50, 0.40, 0.30, 0.55, 0.50, 0.40, 0.30, 0.75, 0.50, 0.40, 0.50, 0.55, 0.50, 0.40, 0.50, 0.75, 0.50, 0.60, 0.30, 0.55, 0.50, 0.60, 0.30, 0.75, 0.50, 0.60, 0.50, 0.55, 0.50, 0.60, 0.50, 0.75 ) effectList <- list( subGroups = c("S1", "S2", "S12", "R"), prevalences = c(0.1, 0.4, 0.2, 0.3), piControls = c(0.3, 0.4, 0.3, 0.55), piTreatments = matrix(piTreatments, byrow = TRUE, ncol = 4) ) design <- getDesignInverseNormal(informationRates = c(0.5, 1), typeOfDesign = "noEarlyEfficacy") suppressWarnings(simResult1 <- getSimulationEnrichmentRates(design, plannedSubjects = c(150, 300), effectList = effectList, maxNumberOfIterations = 100, effectMeasure = "effectEstimate", stratifiedAnalysis = TRUE, allocationRatioPlanned = 1.5, directionUpper = TRUE, successCriterion = "atLeastOne", typeOfSelection = "epsilon", epsilonValue = 0.025, intersectionTest = "Sidak", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentRates object 'simResult1' with expected results expect_equal(simResult1$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult1$iterations[2, ], c(100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult1$rejectAtLeastOne, c(0.01, 0.11, 0.34, 0.41, 0.43, 0.52, 0.64, 0.76, 0.1, 0.13, 0.58, 0.58, 0.37, 0.63, 0.8, 0.88), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$rejectedPopulationsPerStage)), c(0, 0.01, 0, 0.01, 0, 0.29, 0, 0.31, 0, 0, 0, 0.02, 0, 0.16, 0, 0.1, 0, 0.08, 0, 0.08, 0, 0.51, 0, 0.42, 0, 0.08, 0, 0.06, 0, 0.43, 0, 0.4, 0, 0, 0, 0.01, 0, 0.06, 0, 0.03, 0, 0.4, 0, 0.26, 0, 0.48, 0, 0.51, 0, 0.01, 0, 0, 0, 0.05, 0, 0.03, 0, 0.26, 0, 0.19, 0, 0.42, 0, 0.37, 0, 0, 0, 0.1, 0, 0.02, 0, 0.09, 0, 0.03, 0, 0.35, 0, 0.02, 0, 0.31, 0, 0.01, 0, 0.05, 0, 0.03, 0, 0.16, 0, 0.09, 0, 0.5, 0, 0.1, 0, 0.35), tolerance = 1e-07) expect_equal(simResult1$futilityPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult1$earlyStop[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult1$successPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult1$successPerStage[2, ], c(0.01, 0.11, 0.34, 0.41, 0.43, 0.52, 0.64, 0.76, 0.1, 0.13, 0.58, 0.58, 0.37, 0.63, 0.8, 0.88), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$selectedPopulations)), c(1, 0.45, 1, 0.41, 1, 0.76, 1, 0.65, 1, 0.14, 1, 0.09, 1, 0.39, 1, 0.24, 1, 0.6, 1, 0.56, 1, 0.81, 1, 0.74, 1, 0.31, 1, 0.17, 1, 0.59, 1, 0.55, 1, 0.38, 1, 0.15, 1, 0.3, 1, 0.18, 1, 0.81, 1, 0.62, 1, 0.66, 1, 0.63, 1, 0.28, 1, 0.17, 1, 0.22, 1, 0.14, 1, 0.73, 1, 0.35, 1, 0.54, 1, 0.42, 1, 0.41, 1, 0.64, 1, 0.19, 1, 0.35, 1, 0.23, 1, 0.67, 1, 0.16, 1, 0.46, 1, 0.32, 1, 0.59, 1, 0.14, 1, 0.38, 1, 0.32, 1, 0.78, 1, 0.14, 1, 0.4), tolerance = 1e-07) expect_equal(simResult1$numberOfPopulations[1, ], c(3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3)) expect_equal(simResult1$numberOfPopulations[2, ], c(1.24, 1.2, 1.25, 1.18, 1.18, 1.38, 1.21, 1.33, 1.2, 1.32, 1.17, 1.26, 1.36, 1.3, 1.27, 1.37), tolerance = 1e-07) expect_equal(simResult1$expectedNumberOfSubjects, c(300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$sampleSizes)), c(15, 23.007143, 15, 24.6, 15, 35.778571, 15, 33.607143, 15, 8.0928571, 15, 12.764286, 15, 17.042857, 15, 13.757143, 15, 29.442857, 15, 27.278571, 15, 37.6, 15, 34.414286, 15, 15.3, 15, 16.7, 15, 25.742857, 15, 25.071429, 60, 51.028571, 60, 44.4, 60, 29.114286, 60, 30.428571, 60, 82.371429, 60, 68.057143, 60, 67.171429, 60, 69.028571, 60, 38.771429, 60, 40.114286, 60, 25.4, 60, 27.657143, 60, 68.2, 60, 58.8, 60, 51.971429, 60, 47.285714, 30, 57.514286, 30, 52.2, 30, 76.557143, 30, 70.214286, 30, 49.185714, 30, 39.028571, 30, 58.585714, 30, 46.514286, 30, 67.385714, 30, 56.057143, 30, 80.7, 30, 70.828571, 30, 52.1, 30, 39.4, 30, 65.985714, 30, 59.642857, 45, 18.45, 45, 28.8, 45, 8.55, 45, 15.75, 45, 10.35, 45, 30.15, 45, 7.2, 45, 20.7, 45, 14.4, 45, 26.55, 45, 6.3, 45, 17.1, 45, 14.4, 45, 35.1, 45, 6.3, 45, 18), tolerance = 1e-07) expect_equal(simResult1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult1$conditionalPowerAchieved[2, ], c(0.052366399, 0.10235816, 0.23768651, 0.28614763, 0.25721791, 0.27114584, 0.42018555, 0.53367483, 0.094822283, 0.17558915, 0.27651135, 0.31521608, 0.31906941, 0.3984128, 0.57056973, 0.70557871), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult1), NA))) expect_output(print(simResult1)$show()) invisible(capture.output(expect_error(summary(simResult1), NA))) expect_output(summary(simResult1)$show()) simResult1CodeBased <- eval(parse(text = getObjectRCode(simResult1, stringWrapParagraphWidth = NULL))) expect_equal(simResult1CodeBased$iterations, simResult1$iterations, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectAtLeastOne, simResult1$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectedPopulationsPerStage, simResult1$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$futilityPerStage, simResult1$futilityPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$earlyStop, simResult1$earlyStop, tolerance = 1e-05) expect_equal(simResult1CodeBased$successPerStage, simResult1$successPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$selectedPopulations, simResult1$selectedPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$numberOfPopulations, simResult1$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$expectedNumberOfSubjects, simResult1$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult1CodeBased$sampleSizes, simResult1$sampleSizes, tolerance = 1e-05) expect_equal(simResult1CodeBased$conditionalPowerAchieved, simResult1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult1), "character") df <- as.data.frame(simResult1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult2 <- getSimulationEnrichmentRates(design, plannedSubjects = c(150, 300), effectList = effectList, maxNumberOfIterations = 100, effectMeasure = "effectEstimate", stratifiedAnalysis = TRUE, allocationRatioPlanned = 1.5, directionUpper = TRUE, successCriterion = "atLeastOne", typeOfSelection = "rbest", rValue = 2, intersectionTest = "Bonferroni", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentRates object 'simResult2' with expected results expect_equal(simResult2$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult2$iterations[2, ], c(63, 72, 78, 88, 91, 93, 97, 97, 67, 72, 91, 96, 91, 97, 99, 99)) expect_equal(simResult2$rejectAtLeastOne, c(0.03, 0.1, 0.11, 0.34, 0.28, 0.42, 0.7, 0.76, 0.04, 0.18, 0.38, 0.29, 0.27, 0.62, 0.79, 0.82), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$rejectedPopulationsPerStage)), c(0, 0.01, 0, 0.01, 0, 0.09, 0, 0.21, 0, 0.03, 0, 0.01, 0, 0.18, 0, 0.16, 0, 0.02, 0, 0.07, 0, 0.36, 0, 0.19, 0, 0.06, 0, 0.09, 0, 0.53, 0, 0.45, 0, 0.03, 0, 0.01, 0, 0.04, 0, 0.05, 0, 0.25, 0, 0.29, 0, 0.64, 0, 0.57, 0, 0, 0, 0.01, 0, 0.12, 0, 0.06, 0, 0.24, 0, 0.31, 0, 0.7, 0, 0.5, 0, 0.02, 0, 0.09, 0, 0.03, 0, 0.28, 0, 0.09, 0, 0.37, 0, 0.22, 0, 0.6, 0, 0.02, 0, 0.15, 0, 0.06, 0, 0.17, 0, 0.16, 0, 0.54, 0, 0.18, 0, 0.52), tolerance = 1e-07) expect_equal(simResult2$futilityPerStage[1, ], c(0.37, 0.28, 0.22, 0.12, 0.09, 0.07, 0.03, 0.03, 0.33, 0.28, 0.09, 0.04, 0.09, 0.03, 0.01, 0.01), tolerance = 1e-07) expect_equal(simResult2$earlyStop[1, ], c(0.37, 0.28, 0.22, 0.12, 0.09, 0.07, 0.03, 0.03, 0.33, 0.28, 0.09, 0.04, 0.09, 0.03, 0.01, 0.01), tolerance = 1e-07) expect_equal(simResult2$successPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult2$successPerStage[2, ], c(0.03, 0.1, 0.11, 0.34, 0.28, 0.42, 0.7, 0.76, 0.04, 0.18, 0.38, 0.29, 0.27, 0.62, 0.79, 0.82), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$selectedPopulations)), c(1, 0.37, 1, 0.43, 1, 0.66, 1, 0.66, 1, 0.23, 1, 0.14, 1, 0.55, 1, 0.37, 1, 0.54, 1, 0.54, 1, 0.87, 1, 0.87, 1, 0.42, 1, 0.35, 1, 0.82, 1, 0.66, 1, 0.46, 1, 0.33, 1, 0.59, 1, 0.38, 1, 0.88, 1, 0.86, 1, 0.9, 1, 0.8, 1, 0.25, 1, 0.24, 1, 0.52, 1, 0.26, 1, 0.79, 1, 0.73, 1, 0.85, 1, 0.68, 1, 0.43, 1, 0.68, 1, 0.31, 1, 0.72, 1, 0.71, 1, 0.86, 1, 0.49, 1, 0.77, 1, 0.55, 1, 0.66, 1, 0.43, 1, 0.79, 1, 0.61, 1, 0.86, 1, 0.31, 1, 0.64), tolerance = 1e-07) expect_equal(simResult2$numberOfPopulations[1, ], c(3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3)) expect_equal(simResult2$numberOfPopulations[2, ], c(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult2$expectedNumberOfSubjects, c(244.5, 258, 267, 282, 286.5, 289.5, 295.5, 295.5, 250.5, 258, 286.5, 294, 286.5, 295.5, 298.5, 298.5), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$sampleSizes)), c(15, 17.040816, 15, 15.357143, 15, 18.873626, 15, 16.168831, 15, 16.412873, 15, 15.483871, 15, 18.181149, 15, 16.325479, 15, 16.151386, 15, 15.535714, 15, 18.390895, 15, 16.138393, 15, 17.119309, 15, 15.729013, 15, 19.415584, 15, 17.272727, 60, 68.163265, 60, 61.428571, 60, 75.494505, 60, 64.675325, 60, 65.651491, 60, 61.935484, 60, 72.724595, 60, 65.301915, 60, 64.605544, 60, 62.142857, 60, 73.563579, 60, 64.553571, 60, 68.477237, 60, 62.916053, 60, 77.662338, 60, 69.090909, 30, 34.081633, 30, 30.714286, 30, 37.747253, 30, 32.337662, 30, 32.825746, 30, 30.967742, 30, 36.362297, 30, 32.650957, 30, 32.302772, 30, 31.071429, 30, 36.78179, 30, 32.276786, 30, 34.238619, 30, 31.458027, 30, 38.831169, 30, 34.545455, 45, 30.714286, 45, 42.5, 45, 17.884615, 45, 36.818182, 45, 35.10989, 45, 41.612903, 45, 22.731959, 45, 35.721649, 45, 36.940299, 45, 41.25, 45, 21.263736, 45, 37.03125, 45, 30.164835, 45, 39.896907, 45, 14.090909, 45, 29.090909), tolerance = 1e-07) expect_equal(simResult2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult2$conditionalPowerAchieved[2, ], c(0.098541448, 0.1603324, 0.18848192, 0.33019209, 0.1726177, 0.23217693, 0.48938782, 0.5528132, 0.15183095, 0.21072686, 0.29316228, 0.34756908, 0.32894824, 0.41694547, 0.62874091, 0.68601647), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult2), NA))) expect_output(print(simResult2)$show()) invisible(capture.output(expect_error(summary(simResult2), NA))) expect_output(summary(simResult2)$show()) simResult2CodeBased <- eval(parse(text = getObjectRCode(simResult2, stringWrapParagraphWidth = NULL))) expect_equal(simResult2CodeBased$iterations, simResult2$iterations, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectAtLeastOne, simResult2$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectedPopulationsPerStage, simResult2$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$futilityPerStage, simResult2$futilityPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$earlyStop, simResult2$earlyStop, tolerance = 1e-05) expect_equal(simResult2CodeBased$successPerStage, simResult2$successPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$selectedPopulations, simResult2$selectedPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$numberOfPopulations, simResult2$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$expectedNumberOfSubjects, simResult2$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult2CodeBased$sampleSizes, simResult2$sampleSizes, tolerance = 1e-05) expect_equal(simResult2CodeBased$conditionalPowerAchieved, simResult2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult2), "character") df <- as.data.frame(simResult2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult3 <- getSimulationEnrichmentRates(design, plannedSubjects = c(150, 300), effectList = effectList, maxNumberOfIterations = 100, effectMeasure = "effectEstimate", stratifiedAnalysis = FALSE, allocationRatioPlanned = 1.5, directionUpper = TRUE, successCriterion = "atLeastOne", typeOfSelection = "epsilon", epsilonValue = 0.025, intersectionTest = "Simes", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentRates object 'simResult3' with expected results expect_equal(simResult3$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult3$iterations[2, ], c(100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult3$rejectAtLeastOne, c(0.01, 0.09, 0.33, 0.41, 0.43, 0.49, 0.64, 0.74, 0.09, 0.13, 0.6, 0.55, 0.37, 0.59, 0.82, 0.87), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$rejectedPopulationsPerStage)), c(0, 0.01, 0, 0.01, 0, 0.28, 0, 0.32, 0, 0, 0, 0.02, 0, 0.15, 0, 0.11, 0, 0.07, 0, 0.08, 0, 0.53, 0, 0.42, 0, 0.08, 0, 0.05, 0, 0.45, 0, 0.42, 0, 0, 0, 0.01, 0, 0.05, 0, 0.03, 0, 0.4, 0, 0.25, 0, 0.5, 0, 0.5, 0, 0.01, 0, 0.01, 0, 0.05, 0, 0.03, 0, 0.25, 0, 0.17, 0, 0.44, 0, 0.37, 0, 0, 0, 0.08, 0, 0.02, 0, 0.08, 0, 0.03, 0, 0.31, 0, 0.01, 0, 0.28, 0, 0.01, 0, 0.04, 0, 0.03, 0, 0.14, 0, 0.11, 0, 0.46, 0, 0.1, 0, 0.34), tolerance = 1e-07) expect_equal(simResult3$futilityPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult3$earlyStop[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult3$successPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult3$successPerStage[2, ], c(0.01, 0.09, 0.33, 0.41, 0.43, 0.49, 0.64, 0.74, 0.09, 0.13, 0.6, 0.55, 0.37, 0.59, 0.82, 0.87), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$selectedPopulations)), c(1, 0.45, 1, 0.41, 1, 0.76, 1, 0.65, 1, 0.14, 1, 0.09, 1, 0.39, 1, 0.24, 1, 0.6, 1, 0.56, 1, 0.81, 1, 0.74, 1, 0.31, 1, 0.17, 1, 0.59, 1, 0.55, 1, 0.38, 1, 0.15, 1, 0.3, 1, 0.18, 1, 0.81, 1, 0.62, 1, 0.66, 1, 0.63, 1, 0.28, 1, 0.17, 1, 0.22, 1, 0.14, 1, 0.73, 1, 0.35, 1, 0.54, 1, 0.42, 1, 0.41, 1, 0.64, 1, 0.19, 1, 0.35, 1, 0.23, 1, 0.67, 1, 0.16, 1, 0.46, 1, 0.32, 1, 0.59, 1, 0.14, 1, 0.38, 1, 0.32, 1, 0.78, 1, 0.14, 1, 0.4), tolerance = 1e-07) expect_equal(simResult3$numberOfPopulations[1, ], c(3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3)) expect_equal(simResult3$numberOfPopulations[2, ], c(1.24, 1.2, 1.25, 1.18, 1.18, 1.38, 1.21, 1.33, 1.2, 1.32, 1.17, 1.26, 1.36, 1.3, 1.27, 1.37), tolerance = 1e-07) expect_equal(simResult3$expectedNumberOfSubjects, c(300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$sampleSizes)), c(15, 23.007143, 15, 24.6, 15, 35.778571, 15, 33.607143, 15, 8.0928571, 15, 12.764286, 15, 17.042857, 15, 13.757143, 15, 29.442857, 15, 27.278571, 15, 37.6, 15, 34.414286, 15, 15.3, 15, 16.7, 15, 25.742857, 15, 25.071429, 60, 51.028571, 60, 44.4, 60, 29.114286, 60, 30.428571, 60, 82.371429, 60, 68.057143, 60, 67.171429, 60, 69.028571, 60, 38.771429, 60, 40.114286, 60, 25.4, 60, 27.657143, 60, 68.2, 60, 58.8, 60, 51.971429, 60, 47.285714, 30, 57.514286, 30, 52.2, 30, 76.557143, 30, 70.214286, 30, 49.185714, 30, 39.028571, 30, 58.585714, 30, 46.514286, 30, 67.385714, 30, 56.057143, 30, 80.7, 30, 70.828571, 30, 52.1, 30, 39.4, 30, 65.985714, 30, 59.642857, 45, 18.45, 45, 28.8, 45, 8.55, 45, 15.75, 45, 10.35, 45, 30.15, 45, 7.2, 45, 20.7, 45, 14.4, 45, 26.55, 45, 6.3, 45, 17.1, 45, 14.4, 45, 35.1, 45, 6.3, 45, 18), tolerance = 1e-07) expect_equal(simResult3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult3$conditionalPowerAchieved[2, ], c(0.049725877, 0.09761839, 0.23332728, 0.27699949, 0.24938469, 0.25259324, 0.41341769, 0.52195003, 0.091306519, 0.16413348, 0.27352495, 0.30455767, 0.309829, 0.37988667, 0.56618897, 0.69760011), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult3), NA))) expect_output(print(simResult3)$show()) invisible(capture.output(expect_error(summary(simResult3), NA))) expect_output(summary(simResult3)$show()) simResult3CodeBased <- eval(parse(text = getObjectRCode(simResult3, stringWrapParagraphWidth = NULL))) expect_equal(simResult3CodeBased$iterations, simResult3$iterations, tolerance = 1e-05) expect_equal(simResult3CodeBased$rejectAtLeastOne, simResult3$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult3CodeBased$rejectedPopulationsPerStage, simResult3$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$futilityPerStage, simResult3$futilityPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$earlyStop, simResult3$earlyStop, tolerance = 1e-05) expect_equal(simResult3CodeBased$successPerStage, simResult3$successPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$selectedPopulations, simResult3$selectedPopulations, tolerance = 1e-05) expect_equal(simResult3CodeBased$numberOfPopulations, simResult3$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult3CodeBased$expectedNumberOfSubjects, simResult3$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult3CodeBased$sampleSizes, simResult3$sampleSizes, tolerance = 1e-05) expect_equal(simResult3CodeBased$conditionalPowerAchieved, simResult3$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult3), "character") df <- as.data.frame(simResult3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult4 <- getSimulationEnrichmentRates(design, plannedSubjects = c(150, 300), effectList = effectList, maxNumberOfIterations = 100, effectMeasure = "effectEstimate", stratifiedAnalysis = FALSE, allocationRatioPlanned = 1.5, directionUpper = TRUE, successCriterion = "atLeastOne", typeOfSelection = "best", intersectionTest = "Sidak", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentRates object 'simResult4' with expected results expect_equal(simResult4$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult4$iterations[2, ], c(100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult4$rejectAtLeastOne, c(0.01, 0.05, 0.27, 0.38, 0.42, 0.54, 0.58, 0.77, 0.07, 0.18, 0.52, 0.64, 0.39, 0.53, 0.83, 0.94), tolerance = 1e-07) expect_equal(unlist(as.list(simResult4$rejectedPopulationsPerStage)), c(0, 0, 0, 0.01, 0, 0.25, 0, 0.26, 0, 0, 0, 0, 0, 0.15, 0, 0.15, 0, 0.05, 0, 0.1, 0, 0.49, 0, 0.58, 0, 0.06, 0, 0.1, 0, 0.37, 0, 0.3, 0, 0.01, 0, 0, 0, 0.02, 0, 0.02, 0, 0.39, 0, 0.25, 0, 0.42, 0, 0.45, 0, 0.01, 0, 0.01, 0, 0.02, 0, 0, 0, 0.26, 0, 0.21, 0, 0.43, 0, 0.35, 0, 0, 0, 0.04, 0, 0, 0, 0.1, 0, 0.03, 0, 0.29, 0, 0.01, 0, 0.17, 0, 0.01, 0, 0.07, 0, 0.01, 0, 0.06, 0, 0.07, 0, 0.22, 0, 0.03, 0, 0.29), tolerance = 1e-07) expect_equal(simResult4$futilityPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult4$earlyStop[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult4$successPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult4$successPerStage[2, ], c(0.01, 0.05, 0.27, 0.38, 0.42, 0.54, 0.58, 0.77, 0.07, 0.18, 0.52, 0.64, 0.39, 0.53, 0.83, 0.94), tolerance = 1e-07) expect_equal(unlist(as.list(simResult4$selectedPopulations)), c(1, 0.36, 1, 0.29, 1, 0.72, 1, 0.61, 1, 0.12, 1, 0.07, 1, 0.3, 1, 0.28, 1, 0.6, 1, 0.42, 1, 0.77, 1, 0.75, 1, 0.19, 1, 0.27, 1, 0.42, 1, 0.34, 1, 0.4, 1, 0.21, 1, 0.21, 1, 0.11, 1, 0.72, 1, 0.43, 1, 0.61, 1, 0.5, 1, 0.22, 1, 0.1, 1, 0.12, 1, 0.03, 1, 0.6, 1, 0.33, 1, 0.49, 1, 0.36, 1, 0.24, 1, 0.5, 1, 0.07, 1, 0.28, 1, 0.16, 1, 0.5, 1, 0.09, 1, 0.22, 1, 0.18, 1, 0.48, 1, 0.11, 1, 0.22, 1, 0.21, 1, 0.4, 1, 0.09, 1, 0.3), tolerance = 1e-07) expect_equal(simResult4$numberOfPopulations[1, ], c(3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3)) expect_equal(simResult4$numberOfPopulations[2, ], c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)) expect_equal(simResult4$expectedNumberOfSubjects, c(300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300, 300)) expect_equal(unlist(as.list(simResult4$sampleSizes)), c(15, 21.6, 15, 22, 15, 37.05, 15, 34.7, 15, 8.4, 15, 11, 15, 16.35, 15, 17.3, 15, 32.7, 15, 28.2, 15, 40.15, 15, 40.8, 15, 12.65, 15, 19.5, 15, 22.35, 15, 21.5, 60, 54.4, 60, 51, 60, 25.2, 60, 27.8, 60, 81.6, 60, 73, 60, 66.4, 60, 63.2, 60, 32.8, 60, 38.8, 60, 18.6, 60, 16.2, 60, 72.6, 60, 57, 60, 54.4, 60, 54, 30, 63.2, 30, 54.5, 30, 84.6, 30, 74.9, 30, 52.8, 30, 43.5, 30, 63.2, 30, 59.6, 30, 76.4, 30, 61.4, 30, 86.3, 30, 83.1, 30, 55.3, 30, 55.5, 30, 69.2, 30, 61, 45, 10.8, 45, 22.5, 45, 3.15, 45, 12.6, 45, 7.2, 45, 22.5, 45, 4.05, 45, 9.9, 45, 8.1, 45, 21.6, 45, 4.95, 45, 9.9, 45, 9.45, 45, 18, 45, 4.05, 45, 13.5), tolerance = 1e-07) expect_equal(simResult4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult4$conditionalPowerAchieved[2, ], c(0.049846768, 0.13642815, 0.19933025, 0.24691696, 0.23422702, 0.31462001, 0.42177681, 0.55370896, 0.056314814, 0.13292646, 0.2493284, 0.31063163, 0.27530592, 0.41566754, 0.59151016, 0.69993156), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult4), NA))) expect_output(print(simResult4)$show()) invisible(capture.output(expect_error(summary(simResult4), NA))) expect_output(summary(simResult4)$show()) simResult4CodeBased <- eval(parse(text = getObjectRCode(simResult4, stringWrapParagraphWidth = NULL))) expect_equal(simResult4CodeBased$iterations, simResult4$iterations, tolerance = 1e-05) expect_equal(simResult4CodeBased$rejectAtLeastOne, simResult4$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult4CodeBased$rejectedPopulationsPerStage, simResult4$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$futilityPerStage, simResult4$futilityPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$earlyStop, simResult4$earlyStop, tolerance = 1e-05) expect_equal(simResult4CodeBased$successPerStage, simResult4$successPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$selectedPopulations, simResult4$selectedPopulations, tolerance = 1e-05) expect_equal(simResult4CodeBased$numberOfPopulations, simResult4$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult4CodeBased$expectedNumberOfSubjects, simResult4$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult4CodeBased$sampleSizes, simResult4$sampleSizes, tolerance = 1e-05) expect_equal(simResult4CodeBased$conditionalPowerAchieved, simResult4$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult4), "character") df <- as.data.frame(simResult4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationEnrichmentRates': gMax = 4", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:enrichmentDesigns} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:subsec:adaptiveClosedTestProcedureEnrichment} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:sec:simulationFunctions} # @refFS[Sec.]{fs:sec:simulatingEnrichmentDesigns} # @refFS[Sec.]{fs:sec:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:testStatisticEnrichmentRates} # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:simulationEnrichmentRatesGenerate} # @refFS[Formula]{fs:simulationEnrichmentSelections} # @refFS[Formula]{fs:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:enrichmentRejectionRule} .skipTestIfDisabled() .skipTestIfNotX64() effectList <- list( subGroups = c("S1", "S2", "S3", "S12", "S13", "S23", "S123", "R"), prevalences = c(0.1, 0.15, 0.2, 0.1, 0, 0.18, 0.1, 0.17), piControl = rep(0.2, 8), piTreatments = matrix(rep(0.2, 8) + c(0.1, 0.025, 0.15, 0.075, 0.03, 0.125, 0.15, 0.025), byrow = TRUE, ncol = 8) ) design <- getDesignInverseNormal( informationRates = c(0.4, 1), typeOfDesign = "noEarlyEfficacy" ) suppressWarnings(simResult1 <- getSimulationEnrichmentRates(design, plannedSubjects = c(320, 640), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 1, directionUpper = TRUE, typeOfSelection = "best", adaptations = c(T), intersectionTest = "Sidak", stratifiedAnalysis = TRUE, seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentRates object 'simResult1' with expected results expect_equal(simResult1$iterations[1, ], 100) expect_equal(simResult1$iterations[2, ], 100) expect_equal(simResult1$rejectAtLeastOne, 0.89, tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$rejectedPopulationsPerStage)), c(0, 0.33, 0, 0.08, 0, 0.46, 0, 0.02), tolerance = 1e-07) expect_equal(simResult1$futilityPerStage[1, ], 0) expect_equal(simResult1$earlyStop[1, ], 0) expect_equal(simResult1$successPerStage[1, ], 0) expect_equal(simResult1$successPerStage[2, ], 0.89, tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$selectedPopulations)), c(1, 0.36, 1, 0.11, 1, 0.5, 1, 0.03), tolerance = 1e-07) expect_equal(simResult1$numberOfPopulations[1, ], 4) expect_equal(simResult1$numberOfPopulations[2, ], 1) expect_equal(simResult1$expectedNumberOfSubjects, 640, tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$sampleSizes)), c(32, 39.36, 48, 11.402264, 64, 68.586667, 32, 46.001509, 0, 0, 57.6, 73.682717, 32, 79.334843, 54.4, 1.632), tolerance = 1e-07) expect_equal(simResult1$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simResult1$conditionalPowerAchieved[2, ], 0.52101524, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult1), NA))) expect_output(print(simResult1)$show()) invisible(capture.output(expect_error(summary(simResult1), NA))) expect_output(summary(simResult1)$show()) simResult1CodeBased <- eval(parse(text = getObjectRCode(simResult1, stringWrapParagraphWidth = NULL))) expect_equal(simResult1CodeBased$iterations, simResult1$iterations, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectAtLeastOne, simResult1$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectedPopulationsPerStage, simResult1$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$futilityPerStage, simResult1$futilityPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$earlyStop, simResult1$earlyStop, tolerance = 1e-05) expect_equal(simResult1CodeBased$successPerStage, simResult1$successPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$selectedPopulations, simResult1$selectedPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$numberOfPopulations, simResult1$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$expectedNumberOfSubjects, simResult1$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult1CodeBased$sampleSizes, simResult1$sampleSizes, tolerance = 1e-05) expect_equal(simResult1CodeBased$conditionalPowerAchieved, simResult1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult1), "character") df <- as.data.frame(simResult1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult2 <- getSimulationEnrichmentRates(design, plannedSubjects = c(320, 640), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 1, directionUpper = TRUE, typeOfSelection = "rbest", rValue = 2, adaptations = c(T), intersectionTest = "Simes", stratifiedAnalysis = TRUE, seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentRates object 'simResult2' with expected results expect_equal(simResult2$iterations[1, ], 100) expect_equal(simResult2$iterations[2, ], 100) expect_equal(simResult2$rejectAtLeastOne, 0.72, tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$rejectedPopulationsPerStage)), c(0, 0.28, 0, 0.23, 0, 0.59, 0, 0.18), tolerance = 1e-07) expect_equal(simResult2$futilityPerStage[1, ], 0) expect_equal(simResult2$earlyStop[1, ], 0) expect_equal(simResult2$successPerStage[1, ], 0) expect_equal(simResult2$successPerStage[2, ], 0.56, tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$selectedPopulations)), c(1, 0.53, 1, 0.35, 1, 0.78, 1, 0.34), tolerance = 1e-07) expect_equal(simResult2$numberOfPopulations[1, ], 4) expect_equal(simResult2$numberOfPopulations[2, ], 2) expect_equal(simResult2$expectedNumberOfSubjects, 640) expect_equal(unlist(as.list(simResult2$sampleSizes)), c(32, 33.520523, 48, 39.479817, 64, 69.476358, 32, 41.84929, 0, 0, 57.6, 75.328722, 32, 41.84929, 54.4, 18.496), tolerance = 1e-07) expect_equal(simResult2$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simResult2$conditionalPowerAchieved[2, ], 0.53765301, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult2), NA))) expect_output(print(simResult2)$show()) invisible(capture.output(expect_error(summary(simResult2), NA))) expect_output(summary(simResult2)$show()) simResult2CodeBased <- eval(parse(text = getObjectRCode(simResult2, stringWrapParagraphWidth = NULL))) expect_equal(simResult2CodeBased$iterations, simResult2$iterations, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectAtLeastOne, simResult2$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectedPopulationsPerStage, simResult2$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$futilityPerStage, simResult2$futilityPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$earlyStop, simResult2$earlyStop, tolerance = 1e-05) expect_equal(simResult2CodeBased$successPerStage, simResult2$successPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$selectedPopulations, simResult2$selectedPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$numberOfPopulations, simResult2$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$expectedNumberOfSubjects, simResult2$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult2CodeBased$sampleSizes, simResult2$sampleSizes, tolerance = 1e-05) expect_equal(simResult2CodeBased$conditionalPowerAchieved, simResult2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult2), "character") df <- as.data.frame(simResult2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult3 <- getSimulationEnrichmentRates(design, plannedSubjects = c(320, 640), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 2, directionUpper = TRUE, typeOfSelection = "epsilon", epsilonValue = 0.025, adaptations = c(T), intersectionTest = "Sidak", stratifiedAnalysis = FALSE, seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentRates object 'simResult3' with expected results expect_equal(simResult3$iterations[1, ], 100) expect_equal(simResult3$iterations[2, ], 100) expect_equal(simResult3$rejectAtLeastOne, 0.75, tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$rejectedPopulationsPerStage)), c(0, 0.18, 0, 0.07, 0, 0.52, 0, 0.07), tolerance = 1e-07) expect_equal(simResult3$futilityPerStage[1, ], 0) expect_equal(simResult3$earlyStop[1, ], 0) expect_equal(simResult3$successPerStage[1, ], 0) expect_equal(simResult3$successPerStage[2, ], 0.68, tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$selectedPopulations)), c(1, 0.32, 1, 0.18, 1, 0.7, 1, 0.13), tolerance = 1e-07) expect_equal(simResult3$numberOfPopulations[1, ], 4) expect_equal(simResult3$numberOfPopulations[2, ], 1.33, tolerance = 1e-07) expect_equal(simResult3$expectedNumberOfSubjects, 640) expect_equal(unlist(as.list(simResult3$sampleSizes)), c(32, 27.452201, 48, 16.922841, 64, 86.717056, 32, 31.893658, 0, 0, 57.6, 84.048585, 32, 65.893658, 54.4, 7.072), tolerance = 1e-07) expect_equal(simResult3$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simResult3$conditionalPowerAchieved[2, ], 0.42446427, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult3), NA))) expect_output(print(simResult3)$show()) invisible(capture.output(expect_error(summary(simResult3), NA))) expect_output(summary(simResult3)$show()) simResult3CodeBased <- eval(parse(text = getObjectRCode(simResult3, stringWrapParagraphWidth = NULL))) expect_equal(simResult3CodeBased$iterations, simResult3$iterations, tolerance = 1e-05) expect_equal(simResult3CodeBased$rejectAtLeastOne, simResult3$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult3CodeBased$rejectedPopulationsPerStage, simResult3$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$futilityPerStage, simResult3$futilityPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$earlyStop, simResult3$earlyStop, tolerance = 1e-05) expect_equal(simResult3CodeBased$successPerStage, simResult3$successPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$selectedPopulations, simResult3$selectedPopulations, tolerance = 1e-05) expect_equal(simResult3CodeBased$numberOfPopulations, simResult3$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult3CodeBased$expectedNumberOfSubjects, simResult3$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult3CodeBased$sampleSizes, simResult3$sampleSizes, tolerance = 1e-05) expect_equal(simResult3CodeBased$conditionalPowerAchieved, simResult3$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult3), "character") df <- as.data.frame(simResult3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult4 <- getSimulationEnrichmentRates(design, plannedSubjects = c(320, 640), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 0.5, directionUpper = TRUE, typeOfSelection = "rbest", rValue = 1, adaptations = c(T), intersectionTest = "Simes", stratifiedAnalysis = FALSE, seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentRates object 'simResult4' with expected results expect_equal(simResult4$iterations[1, ], 100) expect_equal(simResult4$iterations[2, ], 100) expect_equal(simResult4$rejectAtLeastOne, 0.91, tolerance = 1e-07) expect_equal(unlist(as.list(simResult4$rejectedPopulationsPerStage)), c(0, 0.36, 0, 0.11, 0, 0.43, 0, 0.01), tolerance = 1e-07) expect_equal(simResult4$futilityPerStage[1, ], 0) expect_equal(simResult4$earlyStop[1, ], 0) expect_equal(simResult4$successPerStage[1, ], 0) expect_equal(simResult4$successPerStage[2, ], 0.91, tolerance = 1e-07) expect_equal(unlist(as.list(simResult4$selectedPopulations)), c(1, 0.39, 1, 0.13, 1, 0.44, 1, 0.04), tolerance = 1e-07) expect_equal(simResult4$numberOfPopulations[1, ], 4) expect_equal(simResult4$numberOfPopulations[2, ], 1) expect_equal(simResult4$expectedNumberOfSubjects, 640) expect_equal(unlist(as.list(simResult4$sampleSizes)), c(32, 42.88, 48, 13.693585, 64, 61.226667, 32, 50.729057, 0, 0, 57.6, 69.232302, 32, 80.06239, 54.4, 2.176), tolerance = 1e-07) expect_equal(simResult4$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simResult4$conditionalPowerAchieved[2, ], 0.50986919, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult4), NA))) expect_output(print(simResult4)$show()) invisible(capture.output(expect_error(summary(simResult4), NA))) expect_output(summary(simResult4)$show()) simResult4CodeBased <- eval(parse(text = getObjectRCode(simResult4, stringWrapParagraphWidth = NULL))) expect_equal(simResult4CodeBased$iterations, simResult4$iterations, tolerance = 1e-05) expect_equal(simResult4CodeBased$rejectAtLeastOne, simResult4$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult4CodeBased$rejectedPopulationsPerStage, simResult4$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$futilityPerStage, simResult4$futilityPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$earlyStop, simResult4$earlyStop, tolerance = 1e-05) expect_equal(simResult4CodeBased$successPerStage, simResult4$successPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$selectedPopulations, simResult4$selectedPopulations, tolerance = 1e-05) expect_equal(simResult4CodeBased$numberOfPopulations, simResult4$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult4CodeBased$expectedNumberOfSubjects, simResult4$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult4CodeBased$sampleSizes, simResult4$sampleSizes, tolerance = 1e-05) expect_equal(simResult4CodeBased$conditionalPowerAchieved, simResult4$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult4), "character") df <- as.data.frame(simResult4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationEnrichmentRates': comparison of base and enrichment for inverse normal and Fisher combination", { options(warn = 0) # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:enrichmentDesigns} # @refFS[Sec.]{fs:sec:simulationFunctions} # @refFS[Sec.]{fs:sec:simulatingEnrichmentDesigns} # @refFS[Sec.]{fs:sec:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:simulationEnrichmentRatesGenerate} # @refFS[Formula]{fs:testStatisticEnrichmentRates} # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} # @refFS[Formula]{fs:simulationEnrichmentSelections} # @refFS[Formula]{fs:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:enrichmentRejectionRule} .skipTestIfDisabled() .skipTestIfNotX64() options(warn = -1) effectList <- list( subGroups = "F", prevalences = 1, piTreatments = matrix(seq(0.1, 0.4, 0.05), byrow = TRUE, ncol = 1), piControl = 0.4 ) design <- getDesignInverseNormal( informationRates = c(0.3, 0.7, 1), typeOfDesign = "asUser", userAlphaSpending = c(0.001, 0.005, 0.025), futilityBounds = c(0.1, 0.2) ) suppressWarnings(x1 <- getSimulationEnrichmentRates(design, plannedSubjects = c(60, 120, 180), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 0.5, directionUpper = FALSE, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA, 10, 10), maxNumberOfSubjectsPerStage = c(NA, 180, 180), seed = 123 )) x2 <- getSimulationRates(design, plannedSubjects = c(60, 120, 180), pi1 = seq(0.1, 0.4, 0.05), maxNumberOfIterations = 100, allocationRatioPlanned = 0.5, pi2 = 0.4, directionUpper = FALSE, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA, 10, 10), maxNumberOfSubjectsPerStage = c(NA, 180, 180), seed = 123 ) comp1 <- x2$overallReject - x1$rejectAtLeastOne ## Comparison of the results of numeric object 'comp1' with expected results expect_equal(comp1, c(0.01, -0.02, -0.05, 0.04, -0.04, -0.01, 0), tolerance = 1e-07) comp2 <- x2$conditionalPowerAchieved - x1$conditionalPowerAchieved ## Comparison of the results of matrixarray object 'comp2' with expected results expect_equal(comp2[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(comp2[2, ], c(-0.02550907, 0.012775115, 0.075223698, -0.03222948, -0.033954309, -0.00098028567, 0.042084407), tolerance = 1e-07) expect_equal(comp2[3, ], c(0.01095201, 0.0017271924, -0.039464288, 0.065814614, -0.078523911, 0.017327136, -0.04091828), tolerance = 1e-07) comp3 <- x2$expectedNumberOfSubjects - x1$expectedNumberOfSubjects ## Comparison of the results of numeric object 'comp3' with expected results expect_equal(comp3, c(-12.438075, -4.4155675, -9.1549552, -5.7278594, -0.099503309, -29.646063, 15.245374), tolerance = 1e-07) design <- getDesignFisher(informationRates = c(0.3, 0.7, 1), method = "fullAlpha", alpha0Vec = c(0.5, 0.4), kMax = 3) suppressWarnings(x1 <- getSimulationEnrichmentRates(design, plannedSubjects = c(60, 120, 180), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 0.5, directionUpper = FALSE, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA, 10, 10), maxNumberOfSubjectsPerStage = c(NA, 180, 180), seed = 123 )) x2 <- getSimulationRates(design, plannedSubjects = c(60, 120, 180), pi1 = seq(0.1, 0.4, 0.05), maxNumberOfIterations = 100, allocationRatioPlanned = 0.5, pi2 = 0.4, directionUpper = FALSE, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA, 10, 10), maxNumberOfSubjectsPerStage = c(NA, 180, 180), seed = 123 ) comp4 <- x2$overallReject - x1$rejectAtLeastOne ## Comparison of the results of numeric object 'comp4' with expected results expect_equal(comp4, c(0, -0.03, -0.07, -0.05, 0.06, 0, 0.03), tolerance = 1e-07) comp5 <- x2$conditionalPowerAchieved - x1$conditionalPowerAchieved ## Comparison of the results of matrixarray object 'comp5' with expected results expect_equal(comp5[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(comp5[2, ], c(0.047883697, -0.012456169, 0.030195535, 0.040269247, -0.012692642, 0.10456209, -0.012774146), tolerance = 1e-07) expect_equal(comp5[3, ], c(0.0080078465, -0.025391141, 0.025293295, -0.036595929, -0.02863805, 0.10921842, 0.014223158), tolerance = 1e-07) comp6 <- x2$expectedNumberOfSubjects - x1$expectedNumberOfSubjects ## Comparison of the results of numeric object 'comp6' with expected results expect_equal(comp6, c(-15.660194, 11.117301, -9.5818058, 12.642212, -11.544347, -34.695117, -0.36035592), tolerance = 1e-07) options(warn = 0) }) rpact/tests/testthat/test-f_design_power_calculator.R0000644000175000017500000102203514154142422023024 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_design_power_calculator.R ## | Creation date: 08 December 2021, 09:08:54 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing the Power Calculation of Testing Means for Different Designs and Arguments") test_that("'getPowerMeans': Power calculation of means in one sample for one-sided group sequential design", { designGS1 <- getDesignGroupSequential(informationRates = c(0.3,0.7,1), sided = 1, alpha = 0.07, beta = 0.1, futilityBounds = c(-0.5,0.5), typeOfDesign = "WT", deltaWT = 0.22) # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:AdjShiftParameterOneSampleMean} powerResult <- getPowerMeans(designGS1, groups = 1, thetaH0 = 0.5, stDev = 2, normalApproximation = FALSE, alternative = c(-1,1.2,1.4), directionUpper = TRUE, maxNumberOfSubjects = 50) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, c(-1.5, 0.7, 0.9), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(1.2624119e-07, 0.79805947, 0.93305789), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(1.2596734e-07, 0.17254516, 0.28730882), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(2.7189457e-10, 0.43368823, 0.5145435), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(1.9550909e-12, 0.19182608, 0.13120557), tolerance = 1e-07) expect_equal(powerResult$futilityStop, c(0.99999942, 0.078678761, 0.02585129), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c(0.99114779, 0.032857727, 0.013099441), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c(0.008851635, 0.045821034, 0.01275185), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.99999955, 0.68491215, 0.82770361), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(15.177049, 35.61826, 31.576281), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 15) expect_equal(powerResult$numberOfSubjects[2, ], 35) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$criticalValuesEffectScale[1, ], 1.8259013, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 1.1288256, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 0.97002208, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.2359398, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 0.67059547, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:AdjShiftParameterOneSampleMean} powerResult <- getPowerMeans(designGS1, groups = 1, thetaH0 = -0.5, stDev = 2, normalApproximation = FALSE, alternative = c(-1.2, -1), directionUpper = FALSE, maxNumberOfSubjects = 50) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, c(-0.7, -0.5), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.79805947, 0.56526867), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.17254516, 0.092241599), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.43368823, 0.28692789), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.19182608, 0.18609918), tolerance = 1e-07) expect_equal(powerResult$futilityStop, c(0.078678761, 0.19394481), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c(0.032857727, 0.072497778), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c(0.045821034, 0.12144703), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.68491215, 0.5731143), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(35.61826, 38.108498), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 15) expect_equal(powerResult$numberOfSubjects[2, ], 35) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$criticalValuesEffectScale[1, ], -1.8259013, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], -1.1288256, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], -0.97002208, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], -0.2359398, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], -0.67059547, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:ShiftParameterOneSampleMean} powerResult <- getPowerMeans(designGS1, groups = 1, thetaH0 = 0.5, stDev = 2, normalApproximation = TRUE, alternative = 1.2, maxNumberOfSubjects = 50) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, 0.7, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.80544254, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.17645213), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.43857394), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.19041646), tolerance = 1e-07) expect_equal(powerResult$futilityStop, 0.075570189, tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c("stage = 1" = 0.031759279), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c("stage = 2" = 0.04381091), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.69059627, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 35.476828, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 15) expect_equal(powerResult$numberOfSubjects[2, ], 35) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$criticalValuesEffectScale[1, ], 1.6797184, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 1.1091952, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 0.96124634, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.24180111, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 0.66903085, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:ShiftParameterOneSampleMean} powerResult <- getPowerMeans(designGS1, groups = 2, thetaH0 = -0.5, stDev = 2, normalApproximation = TRUE, alternative = -1.2, directionUpper = FALSE, maxNumberOfSubjects = 50) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, -0.7, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.37256342, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.0540554), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.17942496), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.13908306), tolerance = 1e-07) expect_equal(powerResult$futilityStop, 0.32503231, tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c("stage = 1" = 0.11944374), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c("stage = 2" = 0.20558857), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.55851267, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 38.152327, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 15) expect_equal(powerResult$numberOfSubjects[2, ], 35) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$criticalValuesEffectScale[1, ], -2.8594368, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], -1.7183904, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], -1.4224927, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.01639778, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], -0.8380617, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerMeans': Power calculation of means in one sample for two-sided group sequential design", { designGS2 <- getDesignGroupSequential(informationRates = c(0.34,0.66,1), alpha = 0.12, sided = 2, beta = 0.15, typeOfDesign = "WT", deltaWT = 0.12) # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:AdjShiftParameterOneSampleMean} powerResult <- getPowerMeans(designGS2, groups = 1, thetaH0 = 0.5, stDev = 2, normalApproximation = FALSE, alternative = 1.2, maxNumberOfSubjects = 50) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, 0.7, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.79752024, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.14049601), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.38370336), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.27332087), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.52419937, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 38.840675, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 17) expect_equal(powerResult$numberOfSubjects[2, ], 33) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], -0.86833341, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], -0.20368487, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], 0.020865698, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 1.8683334, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 1.2036849, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], 0.9791343, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.01229935, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.051692876, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.096614336, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:AdjShiftParameterOneSampleMean} powerResult <- getPowerMeans(designGS2, groups = 1, thetaH0 = -0.5, stDev = 2, normalApproximation = FALSE, alternative = -1.2, maxNumberOfSubjects = 50) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, -0.7, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.79752024, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.14049601), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.38370336), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.27332087), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.52419937, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 38.840675, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 17) expect_equal(powerResult$numberOfSubjects[2, ], 33) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], -1.8683334, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], -1.2036849, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], -0.9791343, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 0.86833341, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 0.20368487, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], -0.020865698, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.01229935, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.051692876, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.096614336, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:ShiftParameterOneSampleMean} powerResult <- getPowerMeans(designGS2, groups = 1, thetaH0 = 0.5, stDev = 2, normalApproximation = TRUE, alternative = 1.2, maxNumberOfSubjects = 50) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, 0.7, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.80597731, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.14453229), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.38954071), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.27190431), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.534073, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 38.608242, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 17) expect_equal(powerResult$numberOfSubjects[2, ], 33) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], -0.71434543, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], -0.17739974, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], 0.03005862, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 1.7143454, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 1.1773997, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], 0.96994138, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.01229935, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.051692876, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.096614336, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:ShiftParameterOneSampleMean} powerResult <- getPowerMeans(designGS2, groups = 1, thetaH0 = -0.5, stDev = 2, normalApproximation = TRUE, alternative = -1.2, maxNumberOfSubjects = 50) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, -0.7, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.80597731, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.14453229), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.38954071), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.27190431), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.534073, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 38.608242, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 17) expect_equal(powerResult$numberOfSubjects[2, ], 33) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], -1.7143454, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], -1.1773997, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], -0.96994138, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 0.71434543, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 0.17739974, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], -0.03005862, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.01229935, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.051692876, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.096614336, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerMeans': Power calculation of mean difference in two samples for one-sided group sequential design", { designGS1 <- getDesignGroupSequential(informationRates = c(0.3,0.7,1), sided = 1, alpha = 0.07, beta = 0.1, futilityBounds = c(-0.5,0.5), typeOfDesign = "WT", deltaWT = 0.22) # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:AdjShiftParameterTwoSamplesMeanDiff} powerResult <- getPowerMeans(designGS1, groups = 2, thetaH0 = 0.5, stDev = 1.5, meanRatio = FALSE, normalApproximation = FALSE, alternative = 1.8, directionUpper = TRUE, maxNumberOfSubjects = 50, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, 1.3, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.84205533, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.19830007), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.46269628), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.18105899), tolerance = 1e-07) expect_equal(powerResult$futilityStop, 0.060564406, tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c("stage = 1" = 0.026384529), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c("stage = 2" = 0.034179878), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.72156075, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 34.682897, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 15) expect_equal(powerResult$numberOfSubjects[2, ], 35) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$numberOfSubjects1[1, ], 11.25, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[2, ], 26.25, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[3, ], 37.5, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[1, ], 3.75, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[2, ], 8.75, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[3, ], 12.5, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 2.8183805, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 1.5902217, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 1.3144249, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.04183972, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 0.79556274, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:AdjShiftParameterTwoSamplesMeanDiff} powerResult <- getPowerMeans(designGS1, groups = 2, thetaH0 = -0.5, stDev = 1.5, meanRatio = FALSE, normalApproximation = FALSE, alternative = -1.8, directionUpper = FALSE, maxNumberOfSubjects = 50, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, -1.3, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.84205533, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.19830007), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.46269628), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.18105899), tolerance = 1e-07) expect_equal(powerResult$futilityStop, 0.060564406, tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c("stage = 1" = 0.026384529), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c("stage = 2" = 0.034179878), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.72156075, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 34.682897, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 15) expect_equal(powerResult$numberOfSubjects[2, ], 35) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$numberOfSubjects1[1, ], 11.25, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[2, ], 26.25, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[3, ], 37.5, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[1, ], 3.75, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[2, ], 8.75, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[3, ], 12.5, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], -2.8183805, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], -1.5902217, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], -1.3144249, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], -0.04183972, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], -0.79556274, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:ShiftParameterTwoSamplesMean} powerResult <- getPowerMeans(designGS1, groups = 2, thetaH0 = 0.5, stDev = 1.5, meanRatio = FALSE, normalApproximation = TRUE, alternative = 1.8, maxNumberOfSubjects = 50, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, 1.3, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.84894434, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.20296684), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.46718133), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.17879617), tolerance = 1e-07) expect_equal(powerResult$futilityStop, 0.057814211, tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c("stage = 1" = 0.025383492), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c("stage = 2" = 0.032430719), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.72796238, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 34.513558, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 15) expect_equal(powerResult$numberOfSubjects[2, ], 35) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$numberOfSubjects1[1, ], 11.25, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[2, ], 26.25, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[3, ], 37.5, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[1, ], 3.75, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[2, ], 8.75, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[3, ], 12.5, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 2.5433322, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 1.555157, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 1.2989021, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.0527864, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 0.79277002, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:ShiftParameterTwoSamplesMean} powerResult <- getPowerMeans(designGS1, groups = 2, thetaH0 = -0.5, stDev = 1.5, meanRatio = FALSE, normalApproximation = TRUE, alternative = -1.8, directionUpper = FALSE, maxNumberOfSubjects = 50, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, -1.3, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.84894434, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.20296684), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.46718133), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.17879617), tolerance = 1e-07) expect_equal(powerResult$futilityStop, 0.057814211, tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c("stage = 1" = 0.025383492), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c("stage = 2" = 0.032430719), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.72796238, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 34.513558, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 15) expect_equal(powerResult$numberOfSubjects[2, ], 35) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$numberOfSubjects1[1, ], 11.25, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[2, ], 26.25, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[3, ], 37.5, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[1, ], 3.75, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[2, ], 8.75, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[3, ], 12.5, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], -2.5433322, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], -1.555157, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], -1.2989021, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], -0.0527864, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], -0.79277002, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:AdjShiftParameterTwoSamplesMeanRatio} powerResult <- getPowerMeans(designGS1, groups = 2, thetaH0 = 0.8, stDev = 1.5, meanRatio = TRUE, normalApproximation = FALSE, alternative = 1.8, directionUpper = TRUE, maxNumberOfSubjects = 50, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, 1) expect_equal(powerResult$overallReject, 0.77427796, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.16086364), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.41797637), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.19543795), tolerance = 1e-07) expect_equal(powerResult$futilityStop, 0.08888951, tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c("stage = 1" = 0.036438496), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c("stage = 2" = 0.052451014), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.66772952, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 36.038015, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 15) expect_equal(powerResult$numberOfSubjects[2, ], 35) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$numberOfSubjects1[1, ], 11.25, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[2, ], 26.25, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[3, ], 37.5, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[1, ], 3.75, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[2, ], 8.75, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[3, ], 12.5, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 2.7808252, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 1.7314858, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 1.495845, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.40854768, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 1.0525289, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:ShiftParameterTwoSamplesMean} powerResult <- getPowerMeans(designGS1, groups = 2, thetaH0 = 0.8, stDev = 1.5, meanRatio = TRUE, normalApproximation = TRUE, alternative = 1.8, maxNumberOfSubjects = 50, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, 1) expect_equal(powerResult$overallReject, 0.7820561, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.16454336), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.42310788), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.19440486), tolerance = 1e-07) expect_equal(powerResult$futilityStop, 0.085516174, tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c("stage = 1" = 0.035259709), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c("stage = 2" = 0.050256465), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.67316741, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 35.906427, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 15) expect_equal(powerResult$numberOfSubjects[2, ], 35) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$numberOfSubjects1[1, ], 11.25, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[2, ], 26.25, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[3, ], 37.5, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[1, ], 3.75, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[2, ], 8.75, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[3, ], 12.5, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 2.5458238, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 1.7015266, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 1.4825823, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.41790054, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 1.0501428, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerMeans': Power calculation of mean difference in two samples for two-sided group sequential design", { designGS2 <- getDesignGroupSequential(informationRates = c(0.3,0.7,1), alpha = 0.4, sided = 2, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.22) # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:AdjShiftParameterTwoSamplesMeanDiff} powerResult <- getPowerMeans(designGS2, groups = 2, stDev = 2, normalApproximation = FALSE, alternative = 1.2, maxNumberOfSubjects = 50, allocationRatioPlanned = 0.7) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, 1.2, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.87442088, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.35754296), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.37848399), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.13839393), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.73602695, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 31.808737, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 15) expect_equal(powerResult$numberOfSubjects[2, ], 35) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$numberOfSubjects1[1, ], 6.1764706, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[2, ], 14.411765, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[3, ], 20.588235, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[1, ], 8.8235294, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[2, ], 20.588235, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[3, ], 29.411765, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], -1.6972761, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], -0.83631454, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], -0.62866109, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 1.6972761, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 0.83631454, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], 0.62866109, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.1297467, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.23204368, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.27946463, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:AdjShiftParameterTwoSamplesMeanDiff} powerResult <- getPowerMeans(designGS2, groups = 2, stDev = 2, normalApproximation = FALSE, alternative = -1.2, maxNumberOfSubjects = 50, allocationRatioPlanned = 0.7) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, -1.2, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.87442088, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.35754296), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.37848399), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.13839393), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.73602695, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 31.808737, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 15) expect_equal(powerResult$numberOfSubjects[2, ], 35) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$numberOfSubjects1[1, ], 6.1764706, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[2, ], 14.411765, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[3, ], 20.588235, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[1, ], 8.8235294, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[2, ], 20.588235, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[3, ], 29.411765, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], -1.6972761, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], -0.83631454, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], -0.62866109, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 1.6972761, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 0.83631454, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], 0.62866109, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.1297467, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.23204368, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.27946463, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:ShiftParameterTwoSamplesMean} powerResult <- getPowerMeans(designGS2, groups = 2, thetaH0 = 0, stDev = 2, normalApproximation = TRUE, alternative = 1.2, maxNumberOfSubjects = 50, allocationRatioPlanned = 0.7) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, 1.2, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.87592587, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.35907583), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.37896773), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.13788231), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.73804356, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 31.74783, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 15) expect_equal(powerResult$numberOfSubjects[2, ], 35) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$numberOfSubjects1[1, ], 6.1764706, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[2, ], 14.411765, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[3, ], 20.588235, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[1, ], 8.8235294, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[2, ], 20.588235, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[3, ], 29.411765, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], -1.5897396, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], -0.82092617, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], -0.62155644, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 1.5897396, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 0.82092617, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], 0.62155644, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.1297467, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.23204368, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.27946463, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:ShiftParameterTwoSamplesMean} powerResult <- getPowerMeans(designGS2, groups = 2, stDev = 2, normalApproximation = TRUE, alternative = -1.2, maxNumberOfSubjects = 50, allocationRatioPlanned = 0.7) ## Comparison of the results of TrialDesignPlanMeans object 'powerResult' with expected results expect_equal(powerResult$effect, -1.2, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.87592587, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.35907583), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.37896773), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.13788231), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.73804356, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 31.74783, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 15) expect_equal(powerResult$numberOfSubjects[2, ], 35) expect_equal(powerResult$numberOfSubjects[3, ], 50) expect_equal(powerResult$numberOfSubjects1[1, ], 6.1764706, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[2, ], 14.411765, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[3, ], 20.588235, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[1, ], 8.8235294, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[2, ], 20.588235, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[3, ], 29.411765, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], -1.5897396, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], -0.82092617, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], -0.62155644, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 1.5897396, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 0.82092617, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], 0.62155644, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.1297467, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.23204368, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.27946463, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ################################################################################################### ################################################################################################### }) context("Testing the Power Calculation of Testing Rates for Different Designs and Arguments") test_that("'getPowerRates': Power calculation of rate in one sample for one-sided group sequential design", { designGS1 <- getDesignGroupSequential(informationRates = c(0.3,0.7,1), sided = 1, alpha = 0.07, beta = 0.1, futilityBounds = c(-0.5,0.5), typeOfDesign = "WT", deltaWT = 0.22) # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:AdjShiftParameterOneSampleRate} powerResult <- getPowerRates(designGS1, groups = 1, thetaH0 = 0.4, pi1 = c(0.2,0.3,0.4), directionUpper = FALSE, maxNumberOfSubjects = 40) ## Comparison of the results of TrialDesignPlanRates object 'powerResult' with expected results expect_equal(powerResult$effect, c(-0.2, -0.1, 0), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(26.793099, 30.568926, 25.859698), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.8850078, 0.38742607, 0.067448723), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.23143452, 0.056551742, 0.011170644), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.48990786, 0.18729986, 0.030436001), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.16366541, 0.14357447, 0.025842077), tolerance = 1e-07) expect_equal(powerResult$futilityStop, c(0.043768704, 0.31327331, 0.71047424), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c(0.020163481, 0.11504671, 0.30853754), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c(0.023605223, 0.1982266, 0.40193671), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.76511109, 0.55712491, 0.75208089), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 12) expect_equal(powerResult$numberOfSubjects[2, ], 28) expect_equal(powerResult$numberOfSubjects[3, ], 40) expect_equal(powerResult$criticalValuesEffectScale[1, ], 0.076920806, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 0.23316503, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 0.27368249, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.47071068, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 0.353709, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:AdjShiftParameterOneSampleRate} powerResult <- getPowerRates(designGS1, groups = 1, thetaH0 = 0.4, pi1 = c(0.4,0.5,0.6), directionUpper = , maxNumberOfSubjects = 40) ## Comparison of the results of TrialDesignPlanRates object 'powerResult' with expected results expect_equal(powerResult$effect, c(0, 0.1, 0.2), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(25.859698, 30.585503, 27.927522), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.067448723, 0.39348465, 0.83236985), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.011170644, 0.057586328, 0.19206788), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.030436001, 0.19052871, 0.45635017), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.025842077, 0.14536961, 0.1839518), tolerance = 1e-07) expect_equal(powerResult$futilityStop, c(0.71047424, 0.30857493, 0.064469377), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c(0.30853754, 0.11330227, 0.027796437), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c(0.40193671, 0.19527267, 0.03667294), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.75208089, 0.55668998, 0.71288743), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 12) expect_equal(powerResult$numberOfSubjects[2, ], 28) expect_equal(powerResult$numberOfSubjects[3, ], 40) expect_equal(powerResult$criticalValuesEffectScale[1, ], 0.72307919, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 0.56683497, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 0.52631751, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.32928932, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 0.446291, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerRates': Power calculation of rate in one sample for two-sided group sequential design", { designGS2 <- getDesignGroupSequential(informationRates = c(0.3,0.7,1), alpha = 0.4, sided = 2, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.22) # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:AdjShiftParameterOneSampleRate} powerResult <- getPowerRates(designGS2, groups = 1, thetaH0 = 0.4, pi1 = seq(0.2,0.6,0.1), maxNumberOfSubjects = 40) ## Comparison of the results of TrialDesignPlanRates object 'powerResult' with expected results expect_equal(powerResult$effect, c(-0.2, -0.1, 0, 0.1, 0.2), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(20.319274, 30.129425, 34.422159, 30.357182, 22.419855), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.97746912, 0.67692518, 0.4, 0.66457209, 0.94801088), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.54595705, 0.22704321, 0.1297467, 0.22142183, 0.46151826), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.36616073, 0.29278043, 0.16207777, 0.28691724, 0.38813612), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.065351333, 0.15710154, 0.10817552, 0.15623302, 0.098356497), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.91211779, 0.51982364, 0.29182448, 0.50833906, 0.84965439), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 12) expect_equal(powerResult$numberOfSubjects[2, ], 28) expect_equal(powerResult$numberOfSubjects[3, ], 40) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], 0.18573229, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], 0.28935423, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], 0.3162256, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 0.61426771, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 0.51064577, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], 0.4837744, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.1297467, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.23204368, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.27946463, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerRates': Power calculation of rate in two samples for one-sided group sequential design, riskRatio = FALSE ", { # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:AdjShiftParameterTwoSamplesRateDiff} # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} designGS1 <- getDesignGroupSequential(informationRates = c(0.3,0.7,1), sided = 1, alpha = 0.07, beta = 0.1, futilityBounds = c(-0.5,0.5), typeOfDesign = "WT", deltaWT = 0.22) # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:AdjShiftParameterTwoSamplesRateDiff} # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} powerResult <- getPowerRates(designGS1, groups = 2, thetaH0 = 0.1, pi2 = 0.4, pi1 = c(0.1,0.2,0.3), directionUpper = FALSE, maxNumberOfSubjects = 40, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanRates object 'powerResult' with expected results expect_equal(powerResult$effect, c(-0.4, -0.3, -0.2), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(27.333747, 30.142404, 30.525807), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.86217083, 0.63525529, 0.37370586), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.21254585, 0.11056737, 0.054245237), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.47569558, 0.32910884, 0.18002797), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.17392941, 0.19557908, 0.13943265), tolerance = 1e-07) expect_equal(powerResult$futilityStop, c(0.05259588, 0.1553509, 0.32411639), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c(0.023466961, 0.059262043, 0.11909962), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c(0.029128919, 0.096088854, 0.20501677), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.74083731, 0.59502711, 0.5583896), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 12) expect_equal(powerResult$numberOfSubjects[2, ], 28) expect_equal(powerResult$numberOfSubjects[3, ], 40) expect_equal(powerResult$numberOfSubjects1[1, ], 9) expect_equal(powerResult$numberOfSubjects1[2, ], 21) expect_equal(powerResult$numberOfSubjects1[3, ], 30) expect_equal(powerResult$numberOfSubjects2[1, ], 3) expect_equal(powerResult$numberOfSubjects2[2, ], 7) expect_equal(powerResult$numberOfSubjects2[3, ], 10) expect_equal(powerResult$criticalValuesEffectScale[1, ], -0.3905544, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], -0.21681979, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], -0.15504053, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.26517501, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], -0.00361566, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:AdjShiftParameterTwoSamplesRateDiff} # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} powerResult <- getPowerRates(designGS1, groups = 2, thetaH0 = -0.1, pi2 = 0.4, pi1 = c(0.2, 0.3, 0.4, 0.5), directionUpper = TRUE, maxNumberOfSubjects = 80, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanRates object 'powerResult' with expected results expect_equal(powerResult$effect, c(-0.1, -2.7755576e-17, 0.1, 0.2), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(42.4454, 51.719397, 58.823585, 61.315141), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.011153335, 0.067448723, 0.22125497, 0.49276327), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.0028716829, 0.011170644, 0.031364648, 0.076178456), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.0049229598, 0.030436001, 0.1027412, 0.24505539), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.0033586921, 0.025842077, 0.087149125, 0.17152942), tolerance = 1e-07) expect_equal(powerResult$futilityStop, c(0.89841517, 0.71047424, 0.46922933, 0.23841544), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c(0.49105221, 0.30853754, 0.17789692, 0.08798644), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c(0.40736296, 0.40193671, 0.29133241, 0.150429), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.90620981, 0.75208089, 0.60333518, 0.55964928), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 24) expect_equal(powerResult$numberOfSubjects[2, ], 56) expect_equal(powerResult$numberOfSubjects[3, ], 80) expect_equal(powerResult$numberOfSubjects1[1, ], 18) expect_equal(powerResult$numberOfSubjects1[2, ], 42) expect_equal(powerResult$numberOfSubjects1[3, ], 60) expect_equal(powerResult$numberOfSubjects2[1, ], 6) expect_equal(powerResult$numberOfSubjects2[2, ], 14) expect_equal(powerResult$numberOfSubjects2[3, ], 20) expect_equal(powerResult$criticalValuesEffectScale[1, ], 0.38186802, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 0.17360028, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 0.10931124, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], -0.20652185, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], -0.02383242, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerRates': Power calculation of rate in two samples for one-sided group sequential design, riskRatio = TRUE ", { designGS1 <- getDesignGroupSequential(informationRates = c(0.3,0.7,1), sided = 1, alpha = 0.07, beta = 0.1, futilityBounds = c(-0.5,0.5), typeOfDesign = "WT", deltaWT = 0.22) # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:AdjShiftParameterTwoSamplesRateRatio} # @refFS[Formula]{fs:EstimatesRatioFarringtonManning} powerResult <- getPowerRates(designGS1, groups = 2, thetaH0 = 0.8, pi2 = 0.5, pi1 = c(0.1,0.2,0.3), riskRatio = TRUE, directionUpper = FALSE, maxNumberOfSubjects = 40, allocationRatioPlanned = 5) ## Comparison of the results of TrialDesignPlanRates object 'powerResult' with expected results expect_equal(powerResult$effect, c(-0.6, -0.4, -0.2), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(29.869153, 30.545915, 28.722194), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.67404635, 0.37979679, 0.17337279), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.12233203, 0.055263055, 0.02493902), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.35325438, 0.1832494, 0.079687483), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.19845995, 0.14128433, 0.068746287), tolerance = 1e-07) expect_equal(powerResult$futilityStop, c(0.13554504, 0.31926733, 0.52845861), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c(0.052497346, 0.11728241, 0.20511002), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c(0.083047698, 0.20198492, 0.32334859), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.61113145, 0.55777979, 0.63308512), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 12) expect_equal(powerResult$numberOfSubjects[2, ], 28) expect_equal(powerResult$numberOfSubjects[3, ], 40) expect_equal(powerResult$numberOfSubjects1[1, ], 10) expect_equal(powerResult$numberOfSubjects1[2, ], 23.333333, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[3, ], 33.333333, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[1, ], 2) expect_equal(powerResult$numberOfSubjects2[2, ], 4.6666667, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[3, ], 6.6666667, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], NA_real_) expect_equal(powerResult$criticalValuesEffectScale[2, ], 0.19789883, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 0.30397209, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 1.1132916, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 0.59448494, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:AdjShiftParameterTwoSamplesRateRatio} # @refFS[Formula]{fs:EstimatesRatioFarringtonManning} powerResult <- getPowerRates(designGS1, groups = 2, thetaH0 = 0.8, pi2 = 0.4, pi1 = c(0.4, 0.5, 0.6), riskRatio = TRUE, directionUpper = TRUE, maxNumberOfSubjects = 80, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanRates object 'powerResult' with expected results expect_equal(powerResult$effect, c(0.2, 0.45, 0.7), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(58.50994, 61.208415, 55.770675), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.20890064, 0.52512104, 0.83467468), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.029681783, 0.083038809, 0.19351805), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.096741134, 0.26351903, 0.45786385), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.082477726, 0.17856321, 0.18329277), tolerance = 1e-07) expect_equal(powerResult$futilityStop, c(0.48366053, 0.21795048, 0.063536004), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c(0.18431999, 0.080816996, 0.027459911), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c(0.29934054, 0.13713348, 0.036076093), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.61008345, 0.56450831, 0.71491791), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 24) expect_equal(powerResult$numberOfSubjects[2, ], 56) expect_equal(powerResult$numberOfSubjects[3, ], 80) expect_equal(powerResult$numberOfSubjects1[1, ], 18) expect_equal(powerResult$numberOfSubjects1[2, ], 42) expect_equal(powerResult$numberOfSubjects1[3, ], 60) expect_equal(powerResult$numberOfSubjects2[1, ], 6) expect_equal(powerResult$numberOfSubjects2[2, ], 14) expect_equal(powerResult$numberOfSubjects2[3, ], 20) expect_equal(powerResult$criticalValuesEffectScale[1, ], 1.8651141, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 1.3871263, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 1.2471692, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.57000905, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 0.96223105, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerRates': Power calculation of rate in two samples for two-sided group sequential design ", { designGS2 <- getDesignGroupSequential(informationRates = c(0.3,0.7,1), alpha = 0.4, sided = 2, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.22) # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:AdjShiftParameterTwoSamplesRateDiff} # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} powerResult <- getPowerRates(designGS2, groups = 2, pi2 = 0.5, pi1 = c(0.1,0.2,0.3), riskRatio = FALSE, maxNumberOfSubjects = 40, allocationRatioPlanned = 0.5) ## Comparison of the results of TrialDesignPlanRates object 'powerResult' with expected results expect_equal(powerResult$effect, c(-0.4, -0.3, -0.2), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(20.586564, 26.282925, 30.696455), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.9745822, 0.84688722, 0.64568809), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.53456929, 0.33187612, 0.2131539), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.37045799, 0.36871195, 0.27793629), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.06955493, 0.14629915, 0.1545979), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.90502727, 0.70058807, 0.49109019), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 12) expect_equal(powerResult$numberOfSubjects[2, ], 28) expect_equal(powerResult$numberOfSubjects[3, ], 40) expect_equal(powerResult$numberOfSubjects1[1, ], 4) expect_equal(powerResult$numberOfSubjects1[2, ], 9.3333333, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects1[3, ], 13.333333, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[1, ], 8) expect_equal(powerResult$numberOfSubjects2[2, ], 18.666667, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects2[3, ], 26.666667, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], -0.44319209, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], -0.2365574, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], -0.18006528, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 0.44319209, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 0.2365574, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], 0.18006528, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.1297467, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.23204368, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.27946463, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:AdjShiftParameterTwoSamplesRateRatio} # @refFS[Formula]{fs:EstimatesRatioFarringtonManning} powerResult <- getPowerRates(designGS2, groups = 2, pi2 = 0.4, pi1 = c(0.4, 0.5, 0.6), riskRatio = TRUE, maxNumberOfSubjects = 80, allocationRatioPlanned = 7) ## Comparison of the results of TrialDesignPlanRates object 'powerResult' with expected results expect_equal(powerResult$effect, c(0, 0.25, 0.5), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(68.844318, 66.97762, 61.620959), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.4, 0.46817413, 0.63921164), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.1297467, 0.14947843, 0.21040306), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.16207777, 0.19381617, 0.27485292), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.10817552, 0.12487952, 0.15395566), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.29182448, 0.3432946, 0.48525598), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[1, ], 24) expect_equal(powerResult$numberOfSubjects[2, ], 56) expect_equal(powerResult$numberOfSubjects[3, ], 80) expect_equal(powerResult$numberOfSubjects1[1, ], 21) expect_equal(powerResult$numberOfSubjects1[2, ], 49) expect_equal(powerResult$numberOfSubjects1[3, ], 70) expect_equal(powerResult$numberOfSubjects2[1, ], 3) expect_equal(powerResult$numberOfSubjects2[2, ], 7) expect_equal(powerResult$numberOfSubjects2[3, ], 10) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], 0.22081341, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], 0.49677588, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], 0.5992042, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 2.0083461, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 1.5897897, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], 1.4538504, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.1297467, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.23204368, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.27946463, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$effect, powerResult$effect, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects1, powerResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects2, powerResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ################################################################################################### ################################################################################################### }) context("Testing the Power Calculation of Survival Designs for Different Designs and Arguments") test_that("'getPowerSurvival': Fixed sample size with minimum required definitions, pi1 = c(0.4, 0.5, 0.6) and pi2 = 0.2 at event time 12, accrual time 12 and follow-up time 6 as default ", { # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:ShiftParameterSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedPatientAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} powerResult <- getPowerSurvival(maxNumberOfEvents = 40, maxNumberOfSubjects = 200) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(37.275405, 23.320299, 16.282985, 12), tolerance = 1e-07) expect_equal(powerResult$median2, 37.275405, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.018595296, 0.029722912, 0.042568802, 0.057762265), tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(powerResult$hazardRatio, c(1, 1.5984103, 2.2892242, 3.1062837), tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, c(6.1115255, 3.442577, 1.6316894, 0.30440109), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(40, 40, 40, 40)) expect_equal(powerResult$overallReject, c(0.025, 0.31674317, 0.74507635, 0.94783846), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(18.111525, 15.442577, 13.631689, 12.304401), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(18.111525, 15.442577, 13.631689, 12.304401), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(200, 200, 200, 200)) expect_equal(powerResult$criticalValuesEffectScale[1, ], 1.8585471, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Power calculation of survival designs for one-sided group sequential design", { designGS1 <- getDesignGroupSequential(informationRates = c(0.3,0.7,1), sided = 1, alpha = 0.07, beta = 0.1, futilityBounds = c(-0.5,0.5), typeOfDesign = "WT", deltaWT = 0.22) # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:ShiftParameterSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedPatientAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalFindFollowUpTime} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} powerResult <- getPowerSurvival(designGS1, pi2 = 0.4, pi1 = c(0.4, 0.5, 0.6), dropoutRate1 = 0.1, dropoutTime = 12, eventTime = 24, maxNumberOfSubjects = 80, maxNumberOfEvents = 45, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(32.565971, 24, 18.155299), tolerance = 1e-07) expect_equal(powerResult$median2, 32.565971, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.021284401, 0.028881133, 0.03817878), tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.021284401, tolerance = 1e-07) expect_equal(powerResult$hazardRatio, c(1, 1.3569154, 1.7937447), tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 6.6666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, c(41.628872, 30.417026, 22.638977), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(29.092161, 33.496718, 34.368969), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.067448723, 0.25463139, 0.54601962), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.011170644, 0.036015488, 0.087726198), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.030436001, 0.11913846, 0.27563412), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.025842077, 0.099477436, 0.1826593), tolerance = 1e-07) expect_equal(powerResult$futilityStop, c(0.71047424, 0.43269831, 0.2052719), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c(0.30853754, 0.16216653, 0.076412449), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c(0.40193671, 0.27053178, 0.12885945), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.75208089, 0.58785226, 0.56863222), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(15.123713, 13.244904, 11.839868), tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], c(32.118539, 26.401459, 22.217088), tolerance = 1e-07) expect_equal(powerResult$analysisTime[3, ], c(53.628872, 42.417026, 34.638977), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(32.017976, 30.394846, 25.872188), tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, c(53.628872, 42.417026, 34.638977), tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 13.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[2, ], 31.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[3, ], 45) expect_equal(powerResult$numberOfSubjects[1, ], c(80, 80, 78.932452), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[2, ], c(80, 80, 80)) expect_equal(powerResult$numberOfSubjects[3, ], c(80, 80, 80)) expect_equal(powerResult$expectedNumberOfSubjects, c(80, 80, 79.824774), tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 4.203458, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 2.0990582, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 1.7531447, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.73032205, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 1.2284311, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:ShiftParameterSurvivalFreedman} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedPatientAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalFindFollowUpTime} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} powerResult <- getPowerSurvival(designGS1, typeOfComputation = "Freedman", pi2 = 0.4, pi1 = c(0.4, 0.5, 0.6), dropoutRate1 = 0.1, dropoutTime = 12, eventTime = 24, maxNumberOfSubjects = 80, maxNumberOfEvents = 45, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(32.565971, 24, 18.155299), tolerance = 1e-07) expect_equal(powerResult$median2, 32.565971, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.021284401, 0.028881133, 0.03817878), tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.021284401, tolerance = 1e-07) expect_equal(powerResult$hazardRatio, c(1, 1.3569154, 1.7937447), tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 6.6666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, c(41.628872, 30.417026, 22.638977), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(29.092161, 33.256688, 34.504982), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.067448723, 0.23410594, 0.44983629), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.011170644, 0.033136424, 0.067729226), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.030436001, 0.10902189, 0.22109606), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.025842077, 0.091947627, 0.16101101), tolerance = 1e-07) expect_equal(powerResult$futilityStop, c(0.71047424, 0.45476178, 0.26727979), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c(0.30853754, 0.1715797, 0.098248524), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c(0.40193671, 0.28318207, 0.16903127), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.75208089, 0.59692009, 0.55610508), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(15.123713, 13.244904, 11.839868), tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], c(32.118539, 26.401459, 22.217088), tolerance = 1e-07) expect_equal(powerResult$analysisTime[3, ], c(53.628872, 42.417026, 34.638977), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(32.017976, 30.163653, 26.008714), tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, c(53.628872, 42.417026, 34.638977), tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 13.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[2, ], 31.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[3, ], 45) expect_equal(powerResult$numberOfSubjects[1, ], c(80, 80, 78.932452), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[2, ], c(80, 80, 80)) expect_equal(powerResult$numberOfSubjects[3, ], c(80, 80, 80)) expect_equal(powerResult$expectedNumberOfSubjects, c(80, 80, 79.822811), tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 4.203458, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 2.0990582, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 1.7531447, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.73032205, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 1.2284311, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:ShiftParameterSurvivalHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedPatientAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalFindFollowUpTime} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} powerResult <- getPowerSurvival(designGS1, typeOfComputation = "HsiehFreedman", pi2 = 0.4, pi1 = c(0.4, 0.5, 0.6), dropoutRate1 = 0.1, dropoutTime = 12, eventTime = 24, maxNumberOfSubjects = 80, maxNumberOfEvents = 45, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(32.565971, 24, 18.155299), tolerance = 1e-07) expect_equal(powerResult$median2, 32.565971, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.021284401, 0.028881133, 0.03817878), tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.021284401, tolerance = 1e-07) expect_equal(powerResult$hazardRatio, c(1, 1.3569154, 1.7937447), tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 6.6666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, c(41.628872, 30.417026, 22.638977), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(29.092161, 33.473935, 34.421802), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.067448723, 0.25255296, 0.52822452), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.011170644, 0.03572104, 0.083721511), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.030436001, 0.11810922, 0.2653086), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.025842077, 0.098722701, 0.17919441), tolerance = 1e-07) expect_equal(powerResult$futilityStop, c(0.71047424, 0.43487767, 0.2160418), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c(0.30853754, 0.16308496, 0.080152238), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c(0.40193671, 0.27179271, 0.13588956), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.75208089, 0.58870793, 0.56507191), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(15.123713, 13.244904, 11.839868), tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], c(32.118539, 26.401459, 22.217088), tolerance = 1e-07) expect_equal(powerResult$analysisTime[3, ], c(53.628872, 42.417026, 34.638977), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(32.017976, 30.372933, 25.919163), tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, c(53.628872, 42.417026, 34.638977), tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 13.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[2, ], 31.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[3, ], 45) expect_equal(powerResult$numberOfSubjects[1, ], c(80, 80, 78.932452), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[2, ], c(80, 80, 80)) expect_equal(powerResult$numberOfSubjects[3, ], c(80, 80, 80)) expect_equal(powerResult$expectedNumberOfSubjects, c(80, 80, 79.825057), tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 4.203458, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 2.0990582, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 1.7531447, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.73032205, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 1.2284311, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:ShiftParameterSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedPatientAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalFindFollowUpTime} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} powerResult <- getPowerSurvival(designGS1, lambda2 = 0.04, thetaH0 = 1.25, hazardRatio = 0.8, directionUpper = FALSE, maxNumberOfSubjects = 200, maxNumberOfEvents = 65, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, 21.660849, tolerance = 1e-07) expect_equal(powerResult$median2, 17.32868, tolerance = 1e-07) expect_equal(powerResult$lambda1, 0.032, tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, 5.7883102, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, 49.818428, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.49283375, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.076192913), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.24509523), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c("stage = 3" = 0.17154561), tolerance = 1e-07) expect_equal(powerResult$futilityStop, 0.2383697, tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c("stage = 1" = 0.087970326), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c("stage = 2" = 0.15039938), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.55965784, tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], 8.7091306, tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], 13.807185, tolerance = 1e-07) expect_equal(powerResult$analysisTime[3, ], 17.78831, tolerance = 1e-07) expect_equal(powerResult$studyDuration, 14.723329, tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, 17.78831, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 19.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[2, ], 45.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[3, ], 65) expect_equal(powerResult$numberOfSubjects[1, ], 145.15218, tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[2, ], 200) expect_equal(powerResult$numberOfSubjects[3, ], 200) expect_equal(powerResult$expectedNumberOfSubjects, 190.996, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 0.37847558, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 0.67448058, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 0.78350426, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 1.623577, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 1.0533329, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:ShiftParameterSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedPatientAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalFindFollowUpTime} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} powerResult <- getPowerSurvival(designGS1, lambda2 = 0.04, thetaH0 = 0.8, hazardRatio = seq(0.8,1.4,0.2), directionUpper = TRUE, maxNumberOfSubjects = 200, maxNumberOfEvents = 65, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(21.660849, 17.32868, 14.440566, 12.377628), tolerance = 1e-07) expect_equal(powerResult$median2, 17.32868, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.032, 0.04, 0.048, 0.056), tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, c(5.1617391, 4.0656056, 3.2120436, 2.5256004), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(42.02201, 48.445748, 49.742518, 47.47852), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.067448723, 0.25860493, 0.52208361, 0.74266051), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.011170644, 0.03658032, 0.082375002, 0.14710823), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.030436001, 0.12110923, 0.26177073, 0.39724295), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.025842077, 0.10091538, 0.17793787, 0.19830932), tolerance = 1e-07) expect_equal(powerResult$futilityStop, c(0.71047424, 0.42856456, 0.21982747, 0.10295201), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c(0.30853754, 0.1604311, 0.08147133, 0.041317452), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c(0.40193671, 0.26813346, 0.13835614, 0.061634556), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.75208089, 0.58625412, 0.5639732, 0.6473032), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(8.4767885, 8.0592408, 7.7076518, 7.4060255), tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], c(13.399188, 12.692623, 12.137705, 11.68467), tolerance = 1e-07) expect_equal(powerResult$analysisTime[3, ], c(17.161739, 16.065606, 15.212044, 14.5256), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(12.758265, 13.175351, 12.752351, 11.880451), tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, c(17.161739, 16.065606, 15.212044, 14.5256), tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 19.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[2, ], 45.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[3, ], 65) expect_equal(powerResult$numberOfSubjects[1, ], c(141.27981, 134.32068, 128.46086, 123.43376), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[2, ], c(200, 200, 200, 194.7445), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[3, ], c(200, 200, 200, 200)) expect_equal(powerResult$expectedNumberOfSubjects, c(181.22667, 187.06042, 188.27858, 183.16132), tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 2.2513678, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 1.3650021, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 1.1988902, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.63788392, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 0.92784212, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:ShiftParameterSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedPatientAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalFindFollowUpTime} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} powerResult <- getPowerSurvival(designGS1, eventTime = 120, pi2 = 0.4, thetaH0 = 0.8, hazardRatio = seq(0.8,1.4,0.2), directionUpper = TRUE, maxNumberOfSubjects = 200, maxNumberOfEvents = 65, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$pi1, c(0.33546019, 0.4, 0.45827173, 0.51088413), tolerance = 1e-07) expect_equal(powerResult$median1, c(203.53732, 162.82985, 135.69154, 116.30704), tolerance = 1e-07) expect_equal(powerResult$median2, 162.82985, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.0034055042, 0.0042568802, 0.0051082562, 0.0059596323), tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.0042568802, tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, c(96.86335, 86.356678, 78.102375, 71.398147), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(42.02201, 48.445748, 49.742518, 47.47852), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.067448723, 0.25860493, 0.52208361, 0.74266051), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.011170644, 0.03658032, 0.082375002, 0.14710823), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.030436001, 0.12110923, 0.26177073, 0.39724295), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.025842077, 0.10091538, 0.17793787, 0.19830932), tolerance = 1e-07) expect_equal(powerResult$futilityStop, c(0.71047424, 0.42856456, 0.21982747, 0.10295201), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[1, ], c(0.30853754, 0.1604311, 0.08147133, 0.041317452), tolerance = 1e-07) expect_equal(powerResult$futilityPerStage[2, ], c(0.40193671, 0.26813346, 0.13835614, 0.061634556), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.75208089, 0.58625412, 0.5639732, 0.6473032), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(32.816894, 30.124548, 27.945787, 26.142615), tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], c(73.505015, 66.662265, 61.211479, 56.744296), tolerance = 1e-07) expect_equal(powerResult$analysisTime[3, ], c(108.86335, 98.356678, 90.102375, 83.398147), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(69.262697, 72.57735, 68.358222, 60.378881), tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, c(108.86335, 98.356678, 90.102375, 83.398147), tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 19.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[2, ], 45.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[3, ], 65) expect_equal(powerResult$numberOfSubjects[1, ], c(200, 200, 200, 200)) expect_equal(powerResult$numberOfSubjects[2, ], c(200, 200, 200, 200)) expect_equal(powerResult$numberOfSubjects[3, ], c(200, 200, 200, 200)) expect_equal(powerResult$expectedNumberOfSubjects, c(200, 200, 200, 200)) expect_equal(powerResult$criticalValuesEffectScale[1, ], 2.2513678, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 1.3650021, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 1.1988902, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[1, ], 0.63788392, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsEffectScale[2, ], 0.92784212, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[1, ], 0.69146246, tolerance = 1e-07) expect_equal(powerResult$futilityBoundsPValueScale[2, ], 0.30853754, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$pi1, powerResult$pi1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityStop, powerResult$futilityStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityPerStage, powerResult$futilityPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsEffectScale, powerResult$futilityBoundsEffectScale, tolerance = 1e-05) expect_equal(powerResultCodeBased$futilityBoundsPValueScale, powerResult$futilityBoundsPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Power calculation of survival designs for two-sided group sequential design ", { designGS2 <- getDesignGroupSequential(informationRates = c(0.3,0.7,1), alpha = 0.11, sided = 2, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.32) # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:ShiftParameterSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedPatientAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalFindFollowUpTime} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} powerResult <- getPowerSurvival(designGS2, pi2 = 0.4, pi1 = c(0.2, 0.4, 0.6), dropoutRate1 = 0.1, dropoutTime = 12, eventTime = 24, maxNumberOfSubjects = 180, maxNumberOfEvents = 55, allocationRatioPlanned = 0.3) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(74.550809, 32.565971, 18.155299), tolerance = 1e-07) expect_equal(powerResult$median2, 32.565971, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.009297648, 0.021284401, 0.03817878), tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.021284401, tolerance = 1e-07) expect_equal(powerResult$hazardRatio, c(0.43682921, 1, 1.7937447), tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 15) expect_equal(powerResult$followUpTime, c(14.361102, 11.603566, 9.1966475), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(40.275667, 53.258703, 46.484493), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.80955491, 0.11, 0.5536311), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.20812766, 0.025692757, 0.10981107), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.4067526, 0.045583354, 0.25986553), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.19467465, 0.038723888, 0.1839545), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.61488026, 0.071276112, 0.3696766), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(11.329861, 10.584003, 9.8033045), tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], c(19.345216, 17.58497, 15.96575), tolerance = 1e-07) expect_equal(powerResult$analysisTime[3, ], c(26.361102, 23.603566, 21.196648), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(20.378955, 22.994709, 18.586202), tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, c(26.361102, 23.603566, 21.196648), tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 16.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[2, ], 38.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[3, ], 55) expect_equal(powerResult$numberOfSubjects[1, ], c(169.94792, 158.76005, 147.04957), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[2, ], c(180, 180, 180)) expect_equal(powerResult$numberOfSubjects[3, ], c(180, 180, 180)) expect_equal(powerResult$expectedNumberOfSubjects, c(177.90788, 179.45429, 176.38168), tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], 0.27158358, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], 0.48064547, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], 0.5627937, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 3.6821078, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 2.0805356, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], 1.77685, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.025692757, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.055458318, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.072467622, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:ShiftParameterSurvivalFreedman} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedPatientAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalFindFollowUpTime} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} powerResult <- getPowerSurvival(designGS2, typeOfComputation = "Freedman", pi2 = 0.4, pi1 = c(0.2, 0.4, 0.6), dropoutRate1 = 0.1, dropoutTime = 12, eventTime = 24, maxNumberOfSubjects = 180, maxNumberOfEvents = 55, allocationRatioPlanned = 0.3) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(74.550809, 32.565971, 18.155299), tolerance = 1e-07) expect_equal(powerResult$median2, 32.565971, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.009297648, 0.021284401, 0.03817878), tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.021284401, tolerance = 1e-07) expect_equal(powerResult$hazardRatio, c(0.43682921, 1, 1.7937447), tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 15) expect_equal(powerResult$followUpTime, c(14.361102, 11.603566, 9.1966475), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(44.992896, 53.258703, 44.408918), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.62751278, 0.11, 0.65422406), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.13113454, 0.025692757, 0.13983652), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.30051056, 0.045583354, 0.31559857), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.19586767, 0.038723888, 0.19878897), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.4316451, 0.071276112, 0.45543509), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(11.329861, 10.584003, 9.8033045), tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], c(19.345216, 17.58497, 15.96575), tolerance = 1e-07) expect_equal(powerResult$analysisTime[3, ], c(26.361102, 23.603566, 21.196648), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(22.281639, 22.994709, 17.952578), tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, c(26.361102, 23.603566, 21.196648), tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 16.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[2, ], 38.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[3, ], 55) expect_equal(powerResult$numberOfSubjects[1, ], c(169.94792, 158.76005, 147.04957), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[2, ], c(180, 180, 180)) expect_equal(powerResult$numberOfSubjects[3, ], c(180, 180, 180)) expect_equal(powerResult$expectedNumberOfSubjects, c(178.68182, 179.45429, 175.39233), tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], 0.27158358, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], 0.48064547, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], 0.5627937, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 3.6821078, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 2.0805356, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], 1.77685, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.025692757, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.055458318, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.072467622, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:ShiftParameterSurvivalHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedPatientAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalFindFollowUpTime} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} powerResult <- getPowerSurvival(designGS2, typeOfComputation = "HsiehFreedman", pi2 = 0.4, pi1 = c(0.2, 0.4, 0.6), dropoutRate1 = 0.1, dropoutTime = 12, eventTime = 24, maxNumberOfSubjects = 180, maxNumberOfEvents = 55, allocationRatioPlanned = 0.3) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(74.550809, 32.565971, 18.155299), tolerance = 1e-07) expect_equal(powerResult$median2, 32.565971, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.009297648, 0.021284401, 0.03817878), tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.021284401, tolerance = 1e-07) expect_equal(powerResult$hazardRatio, c(0.43682921, 1, 1.7937447), tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 15) expect_equal(powerResult$followUpTime, c(14.361102, 11.603566, 9.1966475), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(41.467466, 53.258703, 46.846888), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.77062516, 0.11, 0.53442991), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.18711904, 0.025692757, 0.10481397), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.38354247, 0.045583354, 0.24956205), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.19996364, 0.038723888, 0.18005389), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.57066151, 0.071276112, 0.35437602), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(11.329861, 10.584003, 9.8033045), tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], c(19.345216, 17.58497, 15.96575), tolerance = 1e-07) expect_equal(powerResult$analysisTime[3, ], c(26.361102, 23.603566, 21.196648), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(20.85758, 22.994709, 18.697033), tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, c(26.361102, 23.603566, 21.196648), tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 16.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[2, ], 38.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[3, ], 55) expect_equal(powerResult$numberOfSubjects[1, ], c(169.94792, 158.76005, 147.04957), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[2, ], c(180, 180, 180)) expect_equal(powerResult$numberOfSubjects[3, ], c(180, 180, 180)) expect_equal(powerResult$expectedNumberOfSubjects, c(178.11906, 179.45429, 176.54633), tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], 0.27158358, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], 0.48064547, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], 0.5627937, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 3.6821078, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 2.0805356, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], 1.77685, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.025692757, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.055458318, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.072467622, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:ShiftParameterSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedPatientAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalFindFollowUpTime} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} powerResult <- getPowerSurvival(designGS2, lambda2 = 0.04, hazardRatio = c(0.4,1,1.8), dropoutRate1 = 0.1, dropoutTime = 12, maxNumberOfSubjects = 180, maxNumberOfEvents = 55, allocationRatioPlanned = 0.3) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(43.321699, 17.32868, 9.6270442), tolerance = 1e-07) expect_equal(powerResult$median2, 17.32868, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.016, 0.04, 0.072), tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 15) expect_equal(powerResult$followUpTime, c(5.0603074, 3.4618446, 2.2113432), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(37.895698, 53.258703, 46.404972), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.8740886, 0.11, 0.55777827), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.25384788, 0.025692757, 0.11091682), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.44431262, 0.045583354, 0.26210486), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.17592811, 0.038723888, 0.18475659), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.6981605, 0.071276112, 0.37302168), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(8.4193774, 7.8220347, 7.2555625), tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], c(13.316286, 12.307189, 11.466641), tolerance = 1e-07) expect_equal(powerResult$analysisTime[3, ], c(17.060307, 15.461845, 14.211343), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(13.20331, 15.121757, 12.72043), tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, c(17.060307, 15.461845, 14.211343), tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 16.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[2, ], 38.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[3, ], 55) expect_equal(powerResult$numberOfSubjects[1, ], c(126.29066, 117.33052, 108.83344), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[2, ], c(180, 180, 171.99961), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[3, ], c(180, 180, 180)) expect_equal(powerResult$expectedNumberOfSubjects, c(166.366, 178.38985, 170.00949), tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], 0.27158358, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], 0.48064547, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], 0.5627937, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 3.6821078, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 2.0805356, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], 1.77685, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.025692757, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.055458318, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.072467622, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:ShiftParameterSurvivalFreedman} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedPatientAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalFindFollowUpTime} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} powerResult <- getPowerSurvival(designGS2, typeOfComputation = "Freedman", lambda2 = 0.04, hazardRatio = c(0.4,1,1.8), dropoutRate1 = 0.1, dropoutTime = 12, maxNumberOfSubjects = 180, maxNumberOfEvents = 55, allocationRatioPlanned = 0.3) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(43.321699, 17.32868, 9.6270442), tolerance = 1e-07) expect_equal(powerResult$median2, 17.32868, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.016, 0.04, 0.072), tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 15) expect_equal(powerResult$followUpTime, c(5.0603074, 3.4618446, 2.2113432), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(43.761896, 53.258703, 44.296935), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.68239647, 0.11, 0.65920633), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.14972738, 0.025692757, 0.14152926), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.33173334, 0.045583354, 0.31843565), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.20093576, 0.038723888, 0.19924141), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.48146072, 0.071276112, 0.45996492), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(8.4193774, 7.8220347, 7.2555625), tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], c(13.316286, 12.307189, 11.466641), tolerance = 1e-07) expect_equal(powerResult$analysisTime[3, ], c(17.060307, 15.461845, 14.211343), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(14.524507, 15.121757, 12.352885), tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, c(17.060307, 15.461845, 14.211343), tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 16.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[2, ], 38.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[3, ], 55) expect_equal(powerResult$numberOfSubjects[1, ], c(126.29066, 117.33052, 108.83344), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[2, ], c(180, 180, 171.99961), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[3, ], c(180, 180, 180)) expect_equal(powerResult$expectedNumberOfSubjects, c(171.95824, 178.38985, 167.38024), tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], 0.27158358, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], 0.48064547, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], 0.5627937, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 3.6821078, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 2.0805356, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], 1.77685, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.025692757, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.055458318, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.072467622, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:PowerGroupSequentialTwoSided} # @refFS[Formula]{fs:ShiftParameterSurvivalHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedPatientAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalFindFollowUpTime} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} powerResult <- getPowerSurvival(designGS2, typeOfComputation = "HsiehFreedman", lambda2 = 0.04, hazardRatio = c(0.4,1,1.8), dropoutRate1 = 0.1, dropoutTime = 12, maxNumberOfSubjects = 180, maxNumberOfEvents = 55, allocationRatioPlanned = 0.3) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(43.321699, 17.32868, 9.6270442), tolerance = 1e-07) expect_equal(powerResult$median2, 17.32868, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.016, 0.04, 0.072), tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 15) expect_equal(powerResult$followUpTime, c(5.0603074, 3.4618446, 2.2113432), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(39.493229, 53.258703, 46.77542), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.83266548, 0.11, 0.53825584), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.2225769, 0.025692757, 0.10579404), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.42045819, 0.045583354, 0.25160664), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.18963039, 0.038723888, 0.18085515), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.64303509, 0.071276112, 0.35740069), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(8.4193774, 7.8220347, 7.2555625), tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], c(13.316286, 12.307189, 11.466641), tolerance = 1e-07) expect_equal(powerResult$analysisTime[3, ], c(17.060307, 15.461845, 14.211343), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(13.562832, 15.121757, 12.784878), tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, c(17.060307, 15.461845, 14.211343), tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 16.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[2, ], 38.5, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[3, ], 55) expect_equal(powerResult$numberOfSubjects[1, ], c(126.29066, 117.33052, 108.83344), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[2, ], c(180, 180, 171.99961), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[3, ], c(180, 180, 180)) expect_equal(powerResult$expectedNumberOfSubjects, c(168.04554, 178.38985, 170.45805), tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[1, ], 0.27158358, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[2, ], 0.48064547, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleLower[3, ], 0.5627937, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[1, ], 3.6821078, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[2, ], 2.0805356, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScaleUpper[3, ], 1.77685, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[1, ], 0.025692757, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[2, ], 0.055458318, tolerance = 1e-07) expect_equal(powerResult$criticalValuesPValueScale[3, ], 0.072467622, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleLower, powerResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScaleUpper, powerResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesPValueScale, powerResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ################################################################################################### ################################################################################################### }) context("Testing the Power Calculation of Survival Designs for Other Parameter Variants") test_that("'getPowerSurvival': Four stage O'Brien and Fleming group sequential design with minimum required definitions, pi1 = c(0.4, 0.5, 0.6) and pi2 = 0.2 at event time 12, accrual time 12 and follow-up time 6 as default ", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:PowerGroupSequentialOneSided} # @refFS[Formula]{fs:ShiftParameterSurvivalSchoenfeld} powerResult <- getPowerSurvival(design = getDesignGroupSequential(kMax = 4), maxNumberOfEvents = 40, maxNumberOfSubjects = 200) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(37.275405, 23.320299, 16.282985, 12), tolerance = 1e-07) expect_equal(powerResult$median2, 37.275405, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.018595296, 0.029722912, 0.042568802, 0.057762265), tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(powerResult$hazardRatio, c(1, 1.5984103, 2.2892242, 3.1062837), tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, c(6.1115255, 3.442577, 1.6316894, 0.30440109), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(39.87408, 38.142534, 33.62741, 28.346513), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.025, 0.30882929, 0.73475105, 0.94374207), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(2.5763449e-05, 0.00047146778, 0.0030806507, 0.012020122), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.0020845834, 0.034441261, 0.15314753, 0.35953485), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[3, ], c(0.0083455469, 0.11544971, 0.32172195, 0.41021864), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[4, ], c(0.014544106, 0.15846685, 0.25680093, 0.16196846), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.010455897, 0.15036244, 0.47795013, 0.78177362), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(8.2382885, 7.2643376, 6.5021817, 5.8683997), tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], c(11.775158, 10.405299, 9.3411982, 8.4606249), tolerance = 1e-07) expect_equal(powerResult$analysisTime[3, ], c(14.851313, 12.90759, 11.580651, 10.517763), tolerance = 1e-07) expect_equal(powerResult$analysisTime[4, ], c(18.111525, 15.442577, 13.631689, 12.304401), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(18.070854, 14.972567, 12.292784, 10.112156), tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, c(18.111525, 15.442577, 13.631689, 12.304401), tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 10) expect_equal(powerResult$eventsPerStage[2, ], 20) expect_equal(powerResult$eventsPerStage[3, ], 30) expect_equal(powerResult$eventsPerStage[4, ], 40) expect_equal(powerResult$numberOfSubjects[1, ], c(137.30481, 121.07229, 108.36969, 97.806661), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[2, ], c(196.25264, 173.42164, 155.68664, 141.01041), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[3, ], c(200, 200, 193.01085, 175.29605), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[4, ], c(200, 200, 200, 200)) expect_equal(powerResult$expectedNumberOfSubjects, c(199.99057, 199.0474, 190.68267, 167.42879), tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 12.942983, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 3.5976357, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[3, ], 2.3478921, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[4, ], 1.8967435, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': For fixed sample design, determine necessary accrual time if 200 subjects and 30 subjects per time unit can be recruited ", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:ShiftParameterSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} powerResult <- getPowerSurvival(maxNumberOfEvents = 40, accrualTime = c(0), accrualIntensity = 30, maxNumberOfSubjects = 200) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(37.275405, 23.320299, 16.282985, 12), tolerance = 1e-07) expect_equal(powerResult$median2, 37.275405, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.018595296, 0.029722912, 0.042568802, 0.057762265), tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(powerResult$hazardRatio, c(1, 1.5984103, 2.2892242, 3.1062837), tolerance = 1e-07) expect_equal(powerResult$followUpTime, c(8.7010979, 6.004962, 4.1561659, 2.779256), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(40, 40, 40, 40)) expect_equal(powerResult$overallReject, c(0.025, 0.31674317, 0.74507635, 0.94783846), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(15.367765, 12.671629, 10.822833, 9.4459226), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(15.367765, 12.671629, 10.822833, 9.4459226), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(200, 200, 200, 200)) expect_equal(powerResult$criticalValuesEffectScale[1, ], 1.8585471, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Determine necessary accrual time if 200 subjects and if the first 6 time units 20 subjects per time unit can be recruited, then 30 subjects per time unit ", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:ShiftParameterSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} powerResult <- getPowerSurvival(maxNumberOfEvents = 40, accrualTime = c(0, 6), accrualIntensity = c(20, 30), maxNumberOfSubjects = 200) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(37.275405, 23.320299, 16.282985, 12), tolerance = 1e-07) expect_equal(powerResult$median2, 37.275405, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.018595296, 0.029722912, 0.042568802, 0.057762265), tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(powerResult$hazardRatio, c(1, 1.5984103, 2.2892242, 3.1062837), tolerance = 1e-07) expect_equal(powerResult$totalAccrualTime, 8.6666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, c(8.127286, 5.4402735, 3.6040872, 2.2435211), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(40, 40, 40, 40)) expect_equal(powerResult$overallReject, c(0.025, 0.31674317, 0.74507635, 0.94783846), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(16.793953, 14.10694, 12.270754, 10.910188), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(16.793953, 14.10694, 12.270754, 10.910188), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(200, 200, 200, 200)) expect_equal(powerResult$criticalValuesEffectScale[1, ], 1.8585471, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$totalAccrualTime, powerResult$totalAccrualTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Determine maximum number of Subjects if the first 6 time units 20 subjects per time unit can be recruited, and after 10 time units 30 subjects per time unit", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:ShiftParameterSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} powerResult <- getPowerSurvival(maxNumberOfEvents = 40, accrualTime = c(0, 6, 10), accrualIntensity = c(20, 30)) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(37.275405, 23.320299, 16.282985, 12), tolerance = 1e-07) expect_equal(powerResult$median2, 37.275405, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.018595296, 0.029722912, 0.042568802, 0.057762265), tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(powerResult$hazardRatio, c(1, 1.5984103, 2.2892242, 3.1062837), tolerance = 1e-07) expect_equal(powerResult$maxNumberOfSubjects, 240) expect_equal(powerResult$totalAccrualTime, 10) expect_equal(powerResult$followUpTime, c(5.3825871, 3.1889048, 1.691326, 0.58951828), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(40, 40, 40, 40)) expect_equal(powerResult$overallReject, c(0.025, 0.31674317, 0.74507635, 0.94783846), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(15.382587, 13.188905, 11.691326, 10.589518), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(15.382587, 13.188905, 11.691326, 10.589518), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(240, 240, 240, 240)) expect_equal(powerResult$criticalValuesEffectScale[1, ], 1.8585471, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxNumberOfSubjects, powerResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$totalAccrualTime, powerResult$totalAccrualTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Specify accrual time as a list", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:ShiftParameterSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} at <- list("0 - <6" = 20, "6 - Inf" = 30) powerResult <- getPowerSurvival(maxNumberOfEvents = 40, accrualTime = at, maxNumberOfSubjects = 200) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(37.275405, 23.320299, 16.282985, 12), tolerance = 1e-07) expect_equal(powerResult$median2, 37.275405, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.018595296, 0.029722912, 0.042568802, 0.057762265), tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(powerResult$hazardRatio, c(1, 1.5984103, 2.2892242, 3.1062837), tolerance = 1e-07) expect_equal(powerResult$totalAccrualTime, 8.6666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, c(8.127286, 5.4402735, 3.6040872, 2.2435211), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(40, 40, 40, 40)) expect_equal(powerResult$overallReject, c(0.025, 0.31674317, 0.74507635, 0.94783846), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(16.793953, 14.10694, 12.270754, 10.910188), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(16.793953, 14.10694, 12.270754, 10.910188), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(200, 200, 200, 200)) expect_equal(powerResult$criticalValuesEffectScale[1, ], 1.8585471, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$totalAccrualTime, powerResult$totalAccrualTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Specify accrual time as a list, if maximum number of subjects need to be calculated", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:ShiftParameterSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} at <- list("0 - <6" = 20, "6 - <=10" = 30) powerResult <- getPowerSurvival(maxNumberOfEvents = 40, accrualTime = at) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, c(37.275405, 23.320299, 16.282985, 12), tolerance = 1e-07) expect_equal(powerResult$median2, 37.275405, tolerance = 1e-07) expect_equal(powerResult$lambda1, c(0.018595296, 0.029722912, 0.042568802, 0.057762265), tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(powerResult$hazardRatio, c(1, 1.5984103, 2.2892242, 3.1062837), tolerance = 1e-07) expect_equal(powerResult$maxNumberOfSubjects, 240) expect_equal(powerResult$totalAccrualTime, 10) expect_equal(powerResult$followUpTime, c(5.3825871, 3.1889048, 1.691326, 0.58951828), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(40, 40, 40, 40)) expect_equal(powerResult$overallReject, c(0.025, 0.31674317, 0.74507635, 0.94783846), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(15.382587, 13.188905, 11.691326, 10.589518), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(15.382587, 13.188905, 11.691326, 10.589518), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, c(240, 240, 240, 240)) expect_equal(powerResult$criticalValuesEffectScale[1, ], 1.8585471, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxNumberOfSubjects, powerResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$totalAccrualTime, powerResult$totalAccrualTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Specify effect size for a two-stage group design with O'Brien & Fleming boundaries Effect size is based on event rates at specified event time, directionUpper = FALSE needs to be specified because it should be shown that hazard ratio < 1", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:ShiftParameterSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} powerResult <- getPowerSurvival(design = getDesignGroupSequential(kMax = 2), pi1 = 0.2, pi2 = 0.3, eventTime = 24, maxNumberOfEvents = 40, maxNumberOfSubjects = 200, directionUpper = FALSE) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, 74.550809, tolerance = 1e-07) expect_equal(powerResult$median2, 46.640597, tolerance = 1e-07) expect_equal(powerResult$lambda1, 0.009297648, tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.014861456, tolerance = 1e-07) expect_equal(powerResult$hazardRatio, 0.62562161, tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, 12.65889, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, 39.194966, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.31394451, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.04025172), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.27369279), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.040251721, tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], 14.822645, tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], 24.65889, tolerance = 1e-07) expect_equal(powerResult$studyDuration, 24.262964, tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, 24.65889, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 20) expect_equal(powerResult$eventsPerStage[2, ], 40) expect_equal(powerResult$numberOfSubjects[1, ], 200) expect_equal(powerResult$numberOfSubjects[2, ], 200) expect_equal(powerResult$expectedNumberOfSubjects, 200) expect_equal(powerResult$criticalValuesEffectScale[1, ], 0.28632231, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 0.53509093, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Effect size is based on event rate at specified event time for the reference group and hazard ratio, directionUpper = FALSE needs to be specified because it should be shown that hazard ratio < 1", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:ShiftParameterSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} powerResult <- getPowerSurvival(design = getDesignGroupSequential(kMax = 2), hazardRatio = 0.5, pi2 = 0.3, eventTime = 24, maxNumberOfEvents = 40, maxNumberOfSubjects = 200, directionUpper = FALSE) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$pi1, 0.16333997, tolerance = 1e-07) expect_equal(powerResult$median1, 93.281194, tolerance = 1e-07) expect_equal(powerResult$median2, 46.640597, tolerance = 1e-07) expect_equal(powerResult$lambda1, 0.007430728, tolerance = 1e-07) expect_equal(powerResult$lambda2, 0.014861456, tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, 14.346945, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, 37.874505, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.5879328, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.10627477), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.48165803), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.10627477, tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], 15.582247, tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], 26.346945, tolerance = 1e-07) expect_equal(powerResult$studyDuration, 25.202929, tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, 26.346945, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 20) expect_equal(powerResult$eventsPerStage[2, ], 40) expect_equal(powerResult$numberOfSubjects[1, ], 200) expect_equal(powerResult$numberOfSubjects[2, ], 200) expect_equal(powerResult$expectedNumberOfSubjects, 200, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 0.28632231, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 0.53509093, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$pi1, powerResult$pi1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda2, powerResult$lambda2, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Effect size is based on hazard rate for the reference group and hazard ratio, directionUpper = FALSE needs to be specified because it should be shown that hazard ratio < 1", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} powerResult <- getPowerSurvival(design = getDesignGroupSequential(kMax = 2), hazardRatio = 0.5, lambda2 = 0.02, maxNumberOfEvents = 40, maxNumberOfSubjects = 200, directionUpper = FALSE) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, 69.314718, tolerance = 1e-07) expect_equal(powerResult$median2, 34.657359, tolerance = 1e-07) expect_equal(powerResult$lambda1, 0.01, tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, 9.1631017, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, 37.874505, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.5879328, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.10627477), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.48165803), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.10627477, tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], 13.164641, tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], 21.163102, tolerance = 1e-07) expect_equal(powerResult$studyDuration, 20.313067, tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, 21.163102, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 20) expect_equal(powerResult$eventsPerStage[2, ], 40) expect_equal(powerResult$numberOfSubjects[1, ], 200) expect_equal(powerResult$numberOfSubjects[2, ], 200) expect_equal(powerResult$expectedNumberOfSubjects, 200, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 0.28632231, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 0.53509093, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$lambda1, powerResult$lambda1, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Specification of piecewise exponential survival time and hazard ratios ", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalExponentialPieceWiseAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalGeneralPieceWiseAccrual} # @refFS[Formula]{fs:pieceWiseExponentialSurvival} powerResult <- getPowerSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.01,0.02,0.04), hazardRatio = c(1.5, 1.8, 2), maxNumberOfEvents = 40, maxNumberOfSubjects = 200) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, c(4.2070411, 3.5734432, 3.2068918), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(39.412236, 38.617073, 37.874505), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.24668111, 0.45613948, 0.5879328), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.0293882, 0.069146371, 0.10627477), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.21729291, 0.38699311, 0.48165803), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.029388201, 0.069146372, 0.10627477), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(12.173669, 11.705285, 11.428161), tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], c(16.207041, 15.573443, 15.206892), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(16.088508, 15.305974, 14.805308), tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, c(16.207041, 15.573443, 15.206892), tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 20) expect_equal(powerResult$eventsPerStage[2, ], 40) expect_equal(powerResult$numberOfSubjects[1, ], c(200, 195.08808, 190.46935), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[2, ], c(200, 200, 200)) expect_equal(powerResult$expectedNumberOfSubjects, c(200, 199.66036, 198.98713), tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 3.4925675, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 1.8688412, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Specification of piecewise exponential survival time as list and hazard ratios ", { .skipTestIfDisabled() # @refFS[Formula]{fs:sampleSizeSurvivalExponentialPieceWiseAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalGeneralPieceWiseAccrual} # @refFS[Formula]{fs:pieceWiseExponentialSurvival} pws <- list("0 - <5" = 0.01, "5 - <10" = 0.02, ">=10" = 0.04) powerResult <- getPowerSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = pws, hazardRatio = c(1.5, 1.8, 2), maxNumberOfEvents = 40, maxNumberOfSubjects = 200) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, c(4.2070411, 3.5734432, 3.2068918), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(39.412236, 38.617073, 37.874505), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.24668111, 0.45613948, 0.5879328), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.0293882, 0.069146371, 0.10627477), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.21729291, 0.38699311, 0.48165803), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.029388201, 0.069146372, 0.10627477), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(12.173669, 11.705285, 11.428161), tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], c(16.207041, 15.573443, 15.206892), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(16.088508, 15.305974, 14.805308), tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, c(16.207041, 15.573443, 15.206892), tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 20) expect_equal(powerResult$eventsPerStage[2, ], 40) expect_equal(powerResult$numberOfSubjects[1, ], c(200, 195.08808, 190.46935), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[2, ], c(200, 200, 200)) expect_equal(powerResult$expectedNumberOfSubjects, c(200, 199.66036, 198.98713), tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 3.4925675, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 1.8688412, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Specification of piecewise exponential survival time for both treatment arms ", { .skipTestIfDisabled() # @refFS[Formula]{fs:sampleSizeSurvivalExponentialPieceWiseAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalGeneralPieceWiseAccrual} # @refFS[Formula]{fs:pieceWiseExponentialSurvival} powerResult <- getPowerSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.01, 0.02, 0.04), lambda1 = c(0.015,0.03,0.06), maxNumberOfEvents = 40, maxNumberOfSubjects = 200) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$hazardRatio, 1.5, tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, 4.2070411, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, 39.412236, tolerance = 1e-07) expect_equal(powerResult$overallReject, 0.24668111, tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c("stage = 1" = 0.0293882), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c("stage = 2" = 0.21729291), tolerance = 1e-07) expect_equal(powerResult$earlyStop, 0.029388201, tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], 12.173669, tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], 16.207041, tolerance = 1e-07) expect_equal(powerResult$studyDuration, 16.088508, tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, 16.207041, tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 20) expect_equal(powerResult$eventsPerStage[2, ], 40) expect_equal(powerResult$numberOfSubjects[1, ], 200) expect_equal(powerResult$numberOfSubjects[2, ], 200) expect_equal(powerResult$expectedNumberOfSubjects, 200) expect_equal(powerResult$criticalValuesEffectScale[1, ], 3.4925675, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 1.8688412, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Specification of piecewise exponential survival time as a list", { .skipTestIfDisabled() # @refFS[Formula]{fs:sampleSizeSurvivalExponentialPieceWiseAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalGeneralPieceWiseAccrual} # @refFS[Formula]{fs:pieceWiseExponentialSurvival} pws <- list("0 - <5" = 0.01, "5 - <10" = 0.02, ">=10" = 0.04) powerResult <- getPowerSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = pws, hazardRatio = c(1.5, 1.8, 2), maxNumberOfEvents = 40, maxNumberOfSubjects = 200) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, c(4.2070411, 3.5734432, 3.2068918), tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, c(39.412236, 38.617073, 37.874505), tolerance = 1e-07) expect_equal(powerResult$overallReject, c(0.24668111, 0.45613948, 0.5879328), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[1, ], c(0.0293882, 0.069146371, 0.10627477), tolerance = 1e-07) expect_equal(powerResult$rejectPerStage[2, ], c(0.21729291, 0.38699311, 0.48165803), tolerance = 1e-07) expect_equal(powerResult$earlyStop, c(0.029388201, 0.069146372, 0.10627477), tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], c(12.173669, 11.705285, 11.428161), tolerance = 1e-07) expect_equal(powerResult$analysisTime[2, ], c(16.207041, 15.573443, 15.206892), tolerance = 1e-07) expect_equal(powerResult$studyDuration, c(16.088508, 15.305974, 14.805308), tolerance = 1e-07) expect_equal(powerResult$maxStudyDuration, c(16.207041, 15.573443, 15.206892), tolerance = 1e-07) expect_equal(powerResult$eventsPerStage[1, ], 20) expect_equal(powerResult$eventsPerStage[2, ], 40) expect_equal(powerResult$numberOfSubjects[1, ], c(200, 195.08808, 190.46935), tolerance = 1e-07) expect_equal(powerResult$numberOfSubjects[2, ], c(200, 200, 200)) expect_equal(powerResult$expectedNumberOfSubjects, c(200, 199.66036, 198.98713), tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 3.4925675, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[2, ], 1.8688412, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$rejectPerStage, powerResult$rejectPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$earlyStop, powerResult$earlyStop, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$maxStudyDuration, powerResult$maxStudyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$eventsPerStage, powerResult$eventsPerStage, tolerance = 1e-05) expect_equal(powerResultCodeBased$numberOfSubjects, powerResult$numberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Specify effect size based on median survival times (median1 = 5, median2 = 3)", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:lambdabymedian} powerResult <- getPowerSurvival(lambda1 = log(2) / 5, lambda2 = log(2) / 3, maxNumberOfEvents = 40, maxNumberOfSubjects = 200, directionUpper = FALSE) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, 5) expect_equal(powerResult$median2, 3) expect_equal(powerResult$hazardRatio, 0.6, tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, -5.9093279, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, 40) expect_equal(powerResult$overallReject, 0.36520074, tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], 6.0906721, tolerance = 1e-07) expect_equal(powerResult$studyDuration, 6.0906721, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 101.5112, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 0.53805471, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Specify effect size based on median survival times of Weibull distribtion with kappa = 2 (median1 = 5, median2 = 3)", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:lambdabymedian} powerResult <- getPowerSurvival( lambda1 = getLambdaByMedian(median = 5, kappa = 2), lambda2 = getLambdaByMedian(median = 3, kappa = 2), kappa = 2, maxNumberOfEvents = 40, maxNumberOfSubjects = 200, directionUpper = FALSE) ## Comparison of the results of TrialDesignPlanSurvival object 'powerResult' with expected results expect_equal(powerResult$median1, 5) expect_equal(powerResult$median2, 3) expect_equal(powerResult$hazardRatio, 0.36, tolerance = 1e-07) expect_equal(powerResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(powerResult$followUpTime, -5.7378582, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfEvents, 40) expect_equal(powerResult$overallReject, 0.8980967, tolerance = 1e-07) expect_equal(powerResult$analysisTime[1, ], 6.2621418, tolerance = 1e-07) expect_equal(powerResult$studyDuration, 6.2621418, tolerance = 1e-07) expect_equal(powerResult$expectedNumberOfSubjects, 104.36903, tolerance = 1e-07) expect_equal(powerResult$criticalValuesEffectScale[1, ], 0.53805471, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(powerResult), NA))) expect_output(print(powerResult)$show()) invisible(capture.output(expect_error(summary(powerResult), NA))) expect_output(summary(powerResult)$show()) powerResultCodeBased <- eval(parse(text = getObjectRCode(powerResult, stringWrapParagraphWidth = NULL))) expect_equal(powerResultCodeBased$median1, powerResult$median1, tolerance = 1e-05) expect_equal(powerResultCodeBased$median2, powerResult$median2, tolerance = 1e-05) expect_equal(powerResultCodeBased$hazardRatio, powerResult$hazardRatio, tolerance = 1e-05) expect_equal(powerResultCodeBased$accrualIntensity, powerResult$accrualIntensity, tolerance = 1e-05) expect_equal(powerResultCodeBased$followUpTime, powerResult$followUpTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfEvents, powerResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(powerResultCodeBased$overallReject, powerResult$overallReject, tolerance = 1e-05) expect_equal(powerResultCodeBased$analysisTime, powerResult$analysisTime, tolerance = 1e-05) expect_equal(powerResultCodeBased$studyDuration, powerResult$studyDuration, tolerance = 1e-05) expect_equal(powerResultCodeBased$expectedNumberOfSubjects, powerResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(powerResultCodeBased$criticalValuesEffectScale, powerResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(powerResult), "character") df <- as.data.frame(powerResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(powerResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getPowerSurvival': Analysis time at last stage equals accrual time + follow-up time", { x1 <- getPowerSurvival(getDesignGroupSequential(typeOfDesign = "P"), accrualTime = 12, lambda2 = 0.005, lambda1 = 0.01, maxNumberOfSubjects = 766, maxNumberOfEvents = 76) expect_equal(x1$overallReject, 1 - x1$.design$beta, tolerance = 0.01) expect_equal(x1$analysisTime[3], x1$accrualTime + x1$followUpTime) x2 <- getPowerSurvival(getDesignGroupSequential(typeOfDesign = "P"), accrualTime = 12, maxNumberOfEvents = 76, maxNumberOfSubjects = 766, lambda2 = 0.005, lambda1 = 0.01) expect_equal(x2$analysisTime[3], x2$accrualTime + x2$followUpTime) x3 <- getPowerSurvival(getDesignGroupSequential(typeOfDesign = "WT", deltaWT = 0.3), accrualTime = c(0, 12, 15), accrualIntensity = c(20, 30), lambda2 = 0.005, lambda1 = 0.01, maxNumberOfEvents = 76) expect_equal(x3$analysisTime[length(x3$analysisTime)], x3$accrualTime[length(x3$accrualTime)] + x3$followUpTime) x4 <- getPowerSurvival(getDesignGroupSequential(typeOfDesign = "WT", deltaWT = 0.3), accrualTime = c(0, 12, 15), accrualIntensity = c(40, 60), maxNumberOfEvents = 76, piecewiseSurvivalTime = c(0, 5), lambda2 = c(0.005, 0.01), hazardRatio = 0.8) expect_equal(x4$analysisTime[length(x4$analysisTime)], x4$accrualTime[length(x4$accrualTime)] + x4$followUpTime) }) rpact/tests/testthat/test-f_simulation_multiarm_survival.R0000644000175000017500000041052414154142422024162 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_simulation_multiarm_survival.R ## | Creation date: 08 December 2021, 09:10:05 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Simulation Multi-Arm Survival Function") test_that("'getSimulationMultiArmSurvival': several configurations", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmSurvival} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmSurvivalCholeskyTransformation} # @refFS[Formula]{fs:SimulationMultiArmSurvivalCorrMatrix} # @refFS[Formula]{fs:SimulationMultiArmSurvivalEvents} # @refFS[Formula]{fs:SimulationMultiArmSurvivalLogRanks} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} x1 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), typeOfShape = "linear", activeArms = 4, plannedEvents = c(10, 30, 50), omegaMaxVector = seq(1, 1.6, 0.2), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x1' with expected results expect_equal(x1$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x1$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x1$iterations[3, ], c(10, 10, 9, 9)) expect_equal(x1$rejectAtLeastOne, c(0, 0.1, 0.4, 0.5), tolerance = 1e-07) expect_equal(unlist(as.list(x1$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0.2, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0, 0, 0.2), tolerance = 1e-07) expect_equal(x1$futilityStop, c(0, 0, 0, 0)) expect_equal(x1$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x1$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x1$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x1$earlyStop[2, ], c(0, 0, 0.1, 0.1), tolerance = 1e-07) expect_equal(x1$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x1$successPerStage[2, ], c(0, 0, 0.1, 0.1), tolerance = 1e-07) expect_equal(x1$successPerStage[3, ], c(0, 0.1, 0.3, 0.4), tolerance = 1e-07) expect_equal(unlist(as.list(x1$selectedArms)), c(1, 0.3, 0.3, 1, 0.3, 0.3, 1, 0.1, 0.1, 1, 0.2, 0.1, 1, 0.2, 0.2, 1, 0.2, 0.2, 1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.5, 0.5, 1, 0.4, 0.4, 1, 0.4, 0.4, 1, 0.5, 0.5, 1, 0, 0, 1, 0.1, 0.1, 1, 0.4, 0.3, 1, 0.2, 0.2), tolerance = 1e-07) expect_equal(x1$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x1$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x1$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x1$expectedNumberOfEvents, c(182.68801, 153.5825, 114.70922, 140.61265), tolerance = 1e-07) expect_equal(unlist(as.list(x1$eventsPerStage)), c(4, 35.860669, 73.075204, 3.7272727, 24.561041, 57.244387, 3.5, 20.751077, 42.303464, 3.3076923, 22.100961, 49.222492, 4, 35.860669, 73.075204, 3.8181818, 25.16009, 58.640591, 3.6666667, 21.739223, 44.317915, 3.5384615, 23.642889, 52.65662, 4, 35.860669, 73.075204, 3.9090909, 25.75914, 60.036796, 3.8333333, 22.72737, 46.332366, 3.7692308, 25.184816, 56.090747, 4, 35.860669, 73.075204, 4, 26.35819, 61.433001, 4, 23.715516, 48.346816, 4, 26.726744, 59.524874), tolerance = 1e-07) expect_equal(unlist(as.list(x1$singleNumberOfEventsPerStage)), c(2, 15.930334, 18.607268, 1.9090909, 10.670954, 16.74025, 1.8333333, 9.0362783, 11.289346, 1.7692308, 10.052214, 14.506865, 2, 15.930334, 18.607268, 2, 11.179095, 17.537405, 2, 9.8577582, 12.31565, 2, 11.363372, 16.399065, 2, 15.930334, 18.607268, 2.0909091, 11.687236, 18.33456, 2.1666667, 10.679238, 13.341954, 2.2307692, 12.67453, 18.291265, 2, 15.930334, 18.607268, 2.1818182, 12.195376, 19.131715, 2.3333333, 11.500718, 14.368258, 2.4615385, 13.985688, 20.183465, 2, 15.930334, 18.607268, 1.8181818, 10.162814, 15.943096, 1.6666667, 8.2147985, 10.263042, 1.5384615, 8.7410553, 12.614666), tolerance = 1e-07) expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$conditionalPowerAchieved[2, ], c(5.8245202e-05, 0.033918251, 0.017570415, 0.062651459), tolerance = 1e-07) expect_equal(x1$conditionalPowerAchieved[3, ], c(0.081443645, 0.17714318, 0.49831, 0.30622362), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-05) expect_equal(x1CodeBased$rejectAtLeastOne, x1$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x1CodeBased$rejectedArmsPerStage, x1$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$futilityStop, x1$futilityStop, tolerance = 1e-05) expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-05) expect_equal(x1CodeBased$successPerStage, x1$successPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$selectedArms, x1$selectedArms, tolerance = 1e-05) expect_equal(x1CodeBased$numberOfActiveArms, x1$numberOfActiveArms, tolerance = 1e-05) expect_equal(x1CodeBased$expectedNumberOfEvents, x1$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x1CodeBased$eventsPerStage, x1$eventsPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$singleNumberOfEventsPerStage, x1$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x2 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), typeOfShape = "userDefined", activeArms = 4, plannedEvents = c(10, 30, 50), adaptations = rep(TRUE, 2), effectMatrix = matrix(c(0.1,0.2,0.3,0.4,0.2,0.3,0.4,0.5), ncol = 4), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x2' with expected results expect_equal(x2$iterations[1, ], c(10, 10)) expect_equal(x2$iterations[2, ], c(10, 10)) expect_equal(x2$iterations[3, ], c(3, 9)) expect_equal(x2$rejectAtLeastOne, c(0, 0)) expect_equal(unlist(as.list(x2$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x2$futilityStop, c(0.7, 0.1), tolerance = 1e-07) expect_equal(x2$futilityPerStage[1, ], c(0, 0)) expect_equal(x2$futilityPerStage[2, ], c(0.7, 0.1), tolerance = 1e-07) expect_equal(x2$earlyStop[1, ], c(0, 0)) expect_equal(x2$earlyStop[2, ], c(0.7, 0.1), tolerance = 1e-07) expect_equal(x2$successPerStage[1, ], c(0, 0)) expect_equal(x2$successPerStage[2, ], c(0, 0)) expect_equal(x2$successPerStage[3, ], c(0, 0)) expect_equal(unlist(as.list(x2$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0.4, 0.1, 1, 0.5, 0.5, 1, 0.4, 0.1, 1, 0.1, 0, 1, 0.2, 0.1, 1, 0.4, 0.4), tolerance = 1e-07) expect_equal(x2$numberOfActiveArms[1, ], c(4, 4)) expect_equal(x2$numberOfActiveArms[2, ], c(1, 1)) expect_equal(x2$numberOfActiveArms[3, ], c(1, 1)) expect_equal(x2$expectedNumberOfEvents, c(140, 189.47868), tolerance = 1e-07) expect_equal(unlist(as.list(x2$eventsPerStage)), c(5.5, 60.5, 115.5, 5, 49.739341, 99.739341, 6.5, 71.5, 136.5, 5.8333333, 58.029231, 116.36256, 6, 66, 126, 5.4166667, 53.884286, 108.05095, 7, 77, 147, 6.25, 62.174176, 124.67418), tolerance = 1e-07) expect_equal(unlist(as.list(x2$singleNumberOfEventsPerStage)), c(0.5, 5, 5, 0.83333333, 7.4565568, 8.3333333, 1.5, 15, 15, 1.6666667, 14.913114, 16.666667, 1, 10, 10, 1.25, 11.184835, 12.5, 2, 20, 20, 2.0833333, 18.641392, 20.833333, 5, 50, 50, 4.1666667, 37.282784, 41.666667), tolerance = 1e-07) expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_)) expect_equal(x2$conditionalPowerAchieved[2, ], c(0, 1.5253195e-09), tolerance = 1e-07) expect_equal(x2$conditionalPowerAchieved[3, ], c(0, 1.1842379e-15), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-05) expect_equal(x2CodeBased$rejectAtLeastOne, x2$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x2CodeBased$rejectedArmsPerStage, x2$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$futilityStop, x2$futilityStop, tolerance = 1e-05) expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-05) expect_equal(x2CodeBased$successPerStage, x2$successPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$selectedArms, x2$selectedArms, tolerance = 1e-05) expect_equal(x2CodeBased$numberOfActiveArms, x2$numberOfActiveArms, tolerance = 1e-05) expect_equal(x2CodeBased$expectedNumberOfEvents, x2$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x2CodeBased$eventsPerStage, x2$eventsPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$singleNumberOfEventsPerStage, x2$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() x3 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), typeOfShape = "sigmoidEmax", gED50 = 2, slope = 0.5, activeArms = 4, plannedEvents = c(10, 30, 50), omegaMaxVector = seq(1, 1.6, 0.2), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x3' with expected results expect_equal(x3$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x3$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x3$iterations[3, ], c(10, 10, 10, 9)) expect_equal(x3$rejectAtLeastOne, c(0, 0.1, 0.3, 0.3), tolerance = 1e-07) expect_equal(unlist(as.list(x3$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.1), tolerance = 1e-07) expect_equal(x3$futilityStop, c(0, 0, 0, 0)) expect_equal(x3$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x3$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x3$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x3$earlyStop[2, ], c(0, 0, 0, 0.1), tolerance = 1e-07) expect_equal(x3$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x3$successPerStage[2, ], c(0, 0, 0, 0.1), tolerance = 1e-07) expect_equal(x3$successPerStage[3, ], c(0, 0.1, 0.3, 0.2), tolerance = 1e-07) expect_equal(unlist(as.list(x3$selectedArms)), c(1, 0.3, 0.3, 1, 0.3, 0.3, 1, 0.2, 0.2, 1, 0.4, 0.3, 1, 0.2, 0.2, 1, 0.2, 0.2, 1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.5, 0.5, 1, 0.4, 0.4, 1, 0.4, 0.4, 1, 0.4, 0.4, 1, 0, 0, 1, 0.1, 0.1, 1, 0.3, 0.3, 1, 0.1, 0.1), tolerance = 1e-07) expect_equal(x3$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x3$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x3$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x3$expectedNumberOfEvents, c(182.68801, 158.69386, 129.88152, 143.2193), tolerance = 1e-07) expect_equal(unlist(as.list(x3$eventsPerStage)), c(4, 35.860669, 73.075204, 3.8499139, 25.950748, 61.095771, 3.7209785, 22.452769, 48.328635, 3.6090171, 24.278187, 54.733634, 4, 35.860669, 73.075204, 3.8816273, 26.164515, 61.599044, 3.7799362, 22.808526, 49.094387, 3.6916324, 24.833947, 55.986561, 4, 35.860669, 73.075204, 3.9002999, 26.29038, 61.895366, 3.8146499, 23.017992, 49.545254, 3.7402755, 25.161174, 56.724273, 4, 35.860669, 73.075204, 3.9133408, 26.378283, 62.102317, 3.8388939, 23.164282, 49.860138, 3.7742477, 25.389708, 57.239488), tolerance = 1e-07) expect_equal(unlist(as.list(x3$singleNumberOfEventsPerStage)), c(2, 15.930334, 18.607268, 2.0015199, 11.489935, 18.271439, 2.0028257, 10.082432, 13.927748, 2.0039595, 11.476859, 16.910832, 2, 15.930334, 18.607268, 2.0332334, 11.671989, 18.560944, 2.0617834, 10.379231, 14.337743, 2.0865748, 11.950004, 17.607999, 2, 15.930334, 18.607268, 2.0519059, 11.779181, 18.731401, 2.0964971, 10.553983, 14.579144, 2.135218, 12.228588, 18.018484, 2, 15.930334, 18.607268, 2.0649468, 11.854043, 18.850449, 2.120741, 10.67603, 14.747737, 2.1691901, 12.423149, 18.305166, 2, 15.930334, 18.607268, 1.848394, 10.610899, 16.873585, 1.7181528, 8.6493588, 11.948119, 1.6050576, 9.1923108, 13.544615), tolerance = 1e-07) expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$conditionalPowerAchieved[2, ], c(5.8245202e-05, 0.027881828, 0.017394693, 0.05621525), tolerance = 1e-07) expect_equal(x3$conditionalPowerAchieved[3, ], c(0.081443645, 0.17047212, 0.40326875, 0.20898924), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-05) expect_equal(x3CodeBased$rejectAtLeastOne, x3$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x3CodeBased$rejectedArmsPerStage, x3$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$futilityStop, x3$futilityStop, tolerance = 1e-05) expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-05) expect_equal(x3CodeBased$successPerStage, x3$successPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$selectedArms, x3$selectedArms, tolerance = 1e-05) expect_equal(x3CodeBased$numberOfActiveArms, x3$numberOfActiveArms, tolerance = 1e-05) expect_equal(x3CodeBased$expectedNumberOfEvents, x3$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x3CodeBased$eventsPerStage, x3$eventsPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$singleNumberOfEventsPerStage, x3$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x4 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "all", plannedEvents = c(10, 30, 50), omegaMaxVector = seq(1, 1.6, 0.2), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x4' with expected results expect_equal(x4$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x4$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x4$iterations[3, ], c(10, 10, 10, 10)) expect_equal(x4$rejectAtLeastOne, c(0, 0.1, 0.2, 0.2), tolerance = 1e-07) expect_equal(unlist(as.list(x4$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.1, 0, 0, 0.1, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.2, 0, 0, 0.1), tolerance = 1e-07) expect_equal(x4$futilityStop, c(0, 0, 0, 0)) expect_equal(x4$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x4$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x4$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x4$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x4$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x4$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x4$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x4$selectedArms)), c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)) expect_equal(x4$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x4$numberOfActiveArms[2, ], c(4, 4, 4, 4)) expect_equal(x4$numberOfActiveArms[3, ], c(4, 4, 4, 4)) expect_equal(x4$expectedNumberOfEvents, c(209.51335, 210, 205.68884, 195.53918), tolerance = 1e-07) expect_equal(unlist(as.list(x4$eventsPerStage)), c(4, 43.80534, 83.80534, 3.7272727, 41, 78.272727, 3.5, 36.991095, 71.991095, 3.3076923, 31.601422, 64.678345, 4, 43.80534, 83.80534, 3.8181818, 42, 80.181818, 3.6666667, 38.752575, 75.419242, 3.5384615, 33.806172, 69.190787, 4, 43.80534, 83.80534, 3.9090909, 43, 82.090909, 3.8333333, 40.514056, 78.847389, 3.7692308, 36.010922, 73.70323, 4, 43.80534, 83.80534, 4, 44, 84, 4, 42.275537, 82.275537, 4, 38.215673, 78.215673), tolerance = 1e-07) expect_equal(unlist(as.list(x4$singleNumberOfEventsPerStage)), c(2, 19.90267, 20, 1.9090909, 19.090909, 19.090909, 1.8333333, 17.542954, 18.333333, 1.7692308, 15.133855, 17.692308, 2, 19.90267, 20, 2, 20, 20, 2, 19.137768, 20, 2, 17.107836, 20, 2, 19.90267, 20, 2.0909091, 20.909091, 20.909091, 2.1666667, 20.732582, 21.666667, 2.2307692, 19.081818, 22.307692, 2, 19.90267, 20, 2.1818182, 21.818182, 21.818182, 2.3333333, 22.327396, 23.333333, 2.4615385, 21.055799, 24.615385, 2, 19.90267, 20, 1.8181818, 18.181818, 18.181818, 1.6666667, 15.94814, 16.666667, 1.5384615, 13.159874, 15.384615), tolerance = 1e-07) expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x4$conditionalPowerAchieved[2, ], c(0.09225544, 0.10755451, 0.080008195, 0.16137979), tolerance = 1e-07) expect_equal(x4$conditionalPowerAchieved[3, ], c(0.011907723, 0.030096405, 0.063317228, 0.080810126), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-05) expect_equal(x4CodeBased$rejectAtLeastOne, x4$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x4CodeBased$rejectedArmsPerStage, x4$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$futilityStop, x4$futilityStop, tolerance = 1e-05) expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-05) expect_equal(x4CodeBased$successPerStage, x4$successPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$selectedArms, x4$selectedArms, tolerance = 1e-05) expect_equal(x4CodeBased$numberOfActiveArms, x4$numberOfActiveArms, tolerance = 1e-05) expect_equal(x4CodeBased$expectedNumberOfEvents, x4$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x4CodeBased$eventsPerStage, x4$eventsPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$singleNumberOfEventsPerStage, x4$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x5 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "rBest", rValue = 2, plannedEvents = c(10, 30, 50), omegaMaxVector = seq(1, 1.6, 0.2), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x5' with expected results expect_equal(x5$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x5$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x5$iterations[3, ], c(10, 10, 10, 10)) expect_equal(x5$rejectAtLeastOne, c(0.1, 0, 0.2, 0.6), tolerance = 1e-07) expect_equal(unlist(as.list(x5$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.1, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0.4), tolerance = 1e-07) expect_equal(x5$futilityStop, c(0, 0, 0, 0)) expect_equal(x5$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x5$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x5$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x5$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x5$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x5$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x5$successPerStage[3, ], c(0, 0, 0.2, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x5$selectedArms)), c(1, 0.7, 0.7, 1, 0.4, 0.4, 1, 0.2, 0.2, 1, 0.3, 0.3, 1, 0.5, 0.5, 1, 0.3, 0.3, 1, 0.6, 0.6, 1, 0.4, 0.4, 1, 0.5, 0.5, 1, 0.5, 0.5, 1, 0.7, 0.7, 1, 0.5, 0.5, 1, 0.3, 0.3, 1, 0.8, 0.8, 1, 0.5, 0.5, 1, 0.8, 0.8), tolerance = 1e-07) expect_equal(x5$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x5$numberOfActiveArms[2, ], c(2, 2, 2, 2)) expect_equal(x5$numberOfActiveArms[3, ], c(2, 2, 2, 2)) expect_equal(x5$expectedNumberOfEvents, c(181.7241, 185.49972, 161.03264, 167.26743), tolerance = 1e-07) expect_equal(unlist(as.list(x5$eventsPerStage)), c(4, 37.648344, 72.689642, 3.7272727, 34.12598, 69.140806, 3.5, 24.454168, 56.361423, 3.3076923, 29.564881, 55.326921, 4, 37.648344, 72.689642, 3.8181818, 34.958321, 70.827167, 3.6666667, 25.618652, 59.0453, 3.5384615, 31.627547, 59.186938, 4, 37.648344, 72.689642, 3.9090909, 35.790662, 72.513528, 3.8333333, 26.783137, 61.729177, 3.7692308, 33.690213, 63.046956, 4, 37.648344, 72.689642, 4, 36.623003, 74.199889, 4, 27.947621, 64.413055, 4, 35.75288, 66.906974), tolerance = 1e-07) expect_equal(unlist(as.list(x5$singleNumberOfEventsPerStage)), c(2, 16.824172, 17.520649, 1.9090909, 15.57007, 17.934423, 1.8333333, 10.975993, 16.713324, 1.7692308, 14.044543, 13.779695, 2, 16.824172, 17.520649, 2, 16.311501, 18.788443, 2, 11.97381, 18.232717, 2, 15.87644, 15.577047, 2, 16.824172, 17.520649, 2.0909091, 17.052933, 19.642463, 2.1666667, 12.971628, 19.75211, 2.2307692, 17.708337, 17.374399, 2, 16.824172, 17.520649, 2.1818182, 17.794365, 20.496483, 2.3333333, 13.969446, 21.271503, 2.4615385, 19.540234, 19.17175, 2, 16.824172, 17.520649, 1.8181818, 14.828638, 17.080403, 1.6666667, 9.9781754, 15.193931, 1.5384615, 12.212646, 11.982344), tolerance = 1e-07) expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x5$conditionalPowerAchieved[2, ], c(0.0011884888, 0.025687618, 0.050936222, 0.056920177), tolerance = 1e-07) expect_equal(x5$conditionalPowerAchieved[3, ], c(0.16000064, 0.17717891, 0.25226702, 0.41435883), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x5), NA))) expect_output(print(x5)$show()) invisible(capture.output(expect_error(summary(x5), NA))) expect_output(summary(x5)$show()) x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-05) expect_equal(x5CodeBased$rejectAtLeastOne, x5$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x5CodeBased$rejectedArmsPerStage, x5$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$futilityStop, x5$futilityStop, tolerance = 1e-05) expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-05) expect_equal(x5CodeBased$successPerStage, x5$successPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$selectedArms, x5$selectedArms, tolerance = 1e-05) expect_equal(x5CodeBased$numberOfActiveArms, x5$numberOfActiveArms, tolerance = 1e-05) expect_equal(x5CodeBased$expectedNumberOfEvents, x5$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x5CodeBased$eventsPerStage, x5$eventsPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$singleNumberOfEventsPerStage, x5$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x5), "character") df <- as.data.frame(x5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x6 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "epsilon", epsilonValue = 0.1, plannedEvents = c(10, 30, 50), omegaMaxVector = seq(1, 1.6, 0.2), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x6' with expected results expect_equal(x6$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x6$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x6$iterations[3, ], c(10, 9, 9, 10)) expect_equal(x6$rejectAtLeastOne, c(0, 0.3, 0.5, 0.4), tolerance = 1e-07) expect_equal(unlist(as.list(x6$rejectedArmsPerStage)), c(0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0, 0, 0, 0.2, 0, 0, 0.3, 0, 0, 0.2), tolerance = 1e-07) expect_equal(x6$futilityStop, c(0, 0, 0, 0)) expect_equal(x6$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x6$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x6$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x6$earlyStop[2, ], c(0, 0.1, 0.1, 0), tolerance = 1e-07) expect_equal(x6$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x6$successPerStage[2, ], c(0, 0.1, 0.1, 0), tolerance = 1e-07) expect_equal(x6$successPerStage[3, ], c(0, 0.2, 0.4, 0.4), tolerance = 1e-07) expect_equal(unlist(as.list(x6$selectedArms)), c(1, 0.5, 0.5, 1, 0.3, 0, 1, 0.3, 0.2, 1, 0.3, 0.2, 1, 0.3, 0.2, 1, 0.5, 0.5, 1, 0.2, 0.1, 1, 0.3, 0.3, 1, 0.1, 0.1, 1, 0.2, 0.2, 1, 0.1, 0.1, 1, 0.3, 0.2, 1, 0.2, 0.2, 1, 0.3, 0.3, 1, 0.5, 0.5, 1, 0.3, 0.3), tolerance = 1e-07) expect_equal(x6$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x6$numberOfActiveArms[2, ], c(1.1, 1.3, 1.1, 1.2), tolerance = 1e-07) expect_equal(x6$numberOfActiveArms[3, ], c(1, 1.1111111, 1, 1), tolerance = 1e-07) expect_equal(x6$expectedNumberOfEvents, c(182.78185, 142.9628, 156.19514, 150.78355), tolerance = 1e-07) expect_equal(unlist(as.list(x6$eventsPerStage)), c(4, 36.65721, 73.112738, 3.7272727, 24.638721, 56.469181, 3.5, 26.818726, 57.762697, 3.3076923, 22.27063, 49.87456, 4, 36.65721, 73.112738, 3.8181818, 25.239665, 57.846478, 3.6666667, 28.095809, 60.513301, 3.5384615, 23.824395, 53.354181, 4, 36.65721, 73.112738, 3.9090909, 25.84061, 59.223775, 3.8333333, 29.372891, 63.263906, 3.7692308, 25.37816, 56.833801, 4, 36.65721, 73.112738, 4, 26.441554, 60.601072, 4, 30.649973, 66.01451, 4, 26.931924, 60.313422), tolerance = 1e-07) expect_equal(unlist(as.list(x6$singleNumberOfEventsPerStage)), c(2, 16.328605, 18.227764, 1.9090909, 10.710742, 16.303406, 1.8333333, 12.214571, 16.208746, 1.7692308, 10.142967, 14.764893, 2, 16.328605, 18.227764, 2, 11.220777, 17.079759, 2, 13.324987, 17.682269, 2, 11.465962, 16.690749, 2, 16.328605, 18.227764, 2.0909091, 11.730812, 17.856112, 2.1666667, 14.435402, 19.155791, 2.2307692, 12.788958, 18.616604, 2, 16.328605, 18.227764, 2.1818182, 12.240848, 18.632464, 2.3333333, 15.545818, 20.629313, 2.4615385, 14.111953, 20.54246, 2, 16.328605, 18.227764, 1.8181818, 10.200706, 15.527054, 1.6666667, 11.104155, 14.735224, 1.5384615, 8.8199709, 12.839037), tolerance = 1e-07) expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x6$conditionalPowerAchieved[2, ], c(0.018816179, 0.071905821, 0.002298516, 0.067085771), tolerance = 1e-07) expect_equal(x6$conditionalPowerAchieved[3, ], c(0.080015186, 0.29125387, 0.18887123, 0.4033636), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x6), NA))) expect_output(print(x6)$show()) invisible(capture.output(expect_error(summary(x6), NA))) expect_output(summary(x6)$show()) x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-05) expect_equal(x6CodeBased$rejectAtLeastOne, x6$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x6CodeBased$rejectedArmsPerStage, x6$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$futilityStop, x6$futilityStop, tolerance = 1e-05) expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-05) expect_equal(x6CodeBased$successPerStage, x6$successPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$selectedArms, x6$selectedArms, tolerance = 1e-05) expect_equal(x6CodeBased$numberOfActiveArms, x6$numberOfActiveArms, tolerance = 1e-05) expect_equal(x6CodeBased$expectedNumberOfEvents, x6$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x6CodeBased$eventsPerStage, x6$eventsPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$singleNumberOfEventsPerStage, x6$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x6), "character") df <- as.data.frame(x6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x7 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, plannedEvents = c(10, 30, 50), omegaMaxVector = seq(1, 1.6, 0.2), adaptations = c(TRUE, FALSE), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x7' with expected results expect_equal(x7$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x7$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x7$iterations[3, ], c(10, 10, 9, 9)) expect_equal(x7$rejectAtLeastOne, c(0, 0.1, 0.4, 0.4), tolerance = 1e-07) expect_equal(unlist(as.list(x7$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0, 0, 0.2), tolerance = 1e-07) expect_equal(x7$futilityStop, c(0, 0, 0, 0)) expect_equal(x7$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x7$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x7$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x7$earlyStop[2, ], c(0, 0, 0.1, 0.1), tolerance = 1e-07) expect_equal(x7$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x7$successPerStage[2, ], c(0, 0, 0.1, 0.1), tolerance = 1e-07) expect_equal(x7$successPerStage[3, ], c(0, 0.1, 0.3, 0.3), tolerance = 1e-07) expect_equal(unlist(as.list(x7$selectedArms)), c(1, 0.3, 0.3, 1, 0.3, 0.3, 1, 0.1, 0.1, 1, 0.2, 0.1, 1, 0.2, 0.2, 1, 0.2, 0.2, 1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.5, 0.5, 1, 0.4, 0.4, 1, 0.4, 0.4, 1, 0.5, 0.5, 1, 0, 0, 1, 0.1, 0.1, 1, 0.4, 0.3, 1, 0.2, 0.2), tolerance = 1e-07) expect_equal(x7$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x7$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x7$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x7$expectedNumberOfEvents, c(169.30334, 121.79095, 98.577582, 123.23372), tolerance = 1e-07) expect_equal(unlist(as.list(x7$eventsPerStage)), c(4, 35.860669, 67.721337, 3.7272727, 24.561041, 45.394809, 3.5, 20.751077, 36.030051, 3.3076923, 22.100961, 42.835362, 4, 35.860669, 67.721337, 3.8181818, 25.16009, 46.501999, 3.6666667, 21.739223, 37.745768, 3.5384615, 23.642889, 45.823876, 4, 35.860669, 67.721337, 3.9090909, 25.75914, 47.60919, 3.8333333, 22.72737, 39.461484, 3.7692308, 25.184816, 48.81239, 4, 35.860669, 67.721337, 4, 26.35819, 48.71638, 4, 23.715516, 41.177201, 4, 26.726744, 51.800903), tolerance = 1e-07) expect_equal(unlist(as.list(x7$singleNumberOfEventsPerStage)), c(2, 15.930334, 15.930334, 1.9090909, 10.670954, 10.670954, 1.8333333, 9.0362783, 8.0032722, 1.7692308, 10.052214, 11.090494, 2, 15.930334, 15.930334, 2, 11.179095, 11.179095, 2, 9.8577582, 8.7308424, 2, 11.363372, 12.53708, 2, 15.930334, 15.930334, 2.0909091, 11.687236, 11.687236, 2.1666667, 10.679238, 9.4584126, 2.2307692, 12.67453, 13.983666, 2, 15.930334, 15.930334, 2.1818182, 12.195376, 12.195376, 2.3333333, 11.500718, 10.185983, 2.4615385, 13.985688, 15.430252, 2, 15.930334, 15.930334, 1.8181818, 10.162814, 10.162814, 1.6666667, 8.2147985, 7.275702, 1.5384615, 8.7410553, 9.6439076), tolerance = 1e-07) expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x7$conditionalPowerAchieved[2, ], c(5.8245202e-05, 0.033918251, 0.017570415, 0.062651459), tolerance = 1e-07) expect_equal(x7$conditionalPowerAchieved[3, ], c(0.075858531, 0.086024261, 0.37522404, 0.19729909), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x7), NA))) expect_output(print(x7)$show()) invisible(capture.output(expect_error(summary(x7), NA))) expect_output(summary(x7)$show()) x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-05) expect_equal(x7CodeBased$rejectAtLeastOne, x7$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x7CodeBased$rejectedArmsPerStage, x7$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$futilityStop, x7$futilityStop, tolerance = 1e-05) expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-05) expect_equal(x7CodeBased$successPerStage, x7$successPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$selectedArms, x7$selectedArms, tolerance = 1e-05) expect_equal(x7CodeBased$numberOfActiveArms, x7$numberOfActiveArms, tolerance = 1e-05) expect_equal(x7CodeBased$expectedNumberOfEvents, x7$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x7CodeBased$eventsPerStage, x7$eventsPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$singleNumberOfEventsPerStage, x7$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x7), "character") df <- as.data.frame(x7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x8 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "all", plannedEvents = c(10, 30, 50), omegaMaxVector = seq(1, 1.6, 0.2), adaptations = c(TRUE, FALSE), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x8' with expected results expect_equal(x8$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x8$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x8$iterations[3, ], c(10, 10, 10, 10)) expect_equal(x8$rejectAtLeastOne, c(0, 0.1, 0.2, 0.2), tolerance = 1e-07) expect_equal(unlist(as.list(x8$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.1, 0, 0, 0.1, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.2, 0, 0, 0.1), tolerance = 1e-07) expect_equal(x8$futilityStop, c(0, 0, 0, 0)) expect_equal(x8$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x8$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x8$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x8$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x8$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x8$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x8$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x8$selectedArms)), c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)) expect_equal(x8$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x8$numberOfActiveArms[2, ], c(4, 4, 4, 4)) expect_equal(x8$numberOfActiveArms[3, ], c(4, 4, 4, 4)) expect_equal(x8$expectedNumberOfEvents, c(209.0267, 210, 201.37768, 181.07836), tolerance = 1e-07) expect_equal(unlist(as.list(x8$eventsPerStage)), c(4, 43.80534, 83.61068, 3.7272727, 41, 78.272727, 3.5, 36.991095, 70.482189, 3.3076923, 31.601422, 59.895151, 4, 43.80534, 83.61068, 3.8181818, 42, 80.181818, 3.6666667, 38.752575, 73.838484, 3.5384615, 33.806172, 64.073883, 4, 43.80534, 83.61068, 3.9090909, 43, 82.090909, 3.8333333, 40.514056, 77.194778, 3.7692308, 36.010922, 68.252614, 4, 43.80534, 83.61068, 4, 44, 84, 4, 42.275537, 80.551073, 4, 38.215673, 72.431346), tolerance = 1e-07) expect_equal(unlist(as.list(x8$singleNumberOfEventsPerStage)), c(2, 19.90267, 19.90267, 1.9090909, 19.090909, 19.090909, 1.8333333, 17.542954, 17.542954, 1.7692308, 15.133855, 15.133855, 2, 19.90267, 19.90267, 2, 20, 20, 2, 19.137768, 19.137768, 2, 17.107836, 17.107836, 2, 19.90267, 19.90267, 2.0909091, 20.909091, 20.909091, 2.1666667, 20.732582, 20.732582, 2.2307692, 19.081818, 19.081818, 2, 19.90267, 19.90267, 2.1818182, 21.818182, 21.818182, 2.3333333, 22.327396, 22.327396, 2.4615385, 21.055799, 21.055799, 2, 19.90267, 19.90267, 1.8181818, 18.181818, 18.181818, 1.6666667, 15.94814, 15.94814, 1.5384615, 13.159874, 13.159874), tolerance = 1e-07) expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x8$conditionalPowerAchieved[2, ], c(0.09225544, 0.10755451, 0.080008195, 0.16137979), tolerance = 1e-07) expect_equal(x8$conditionalPowerAchieved[3, ], c(0.011968708, 0.030096405, 0.063317862, 0.066369104), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x8), NA))) expect_output(print(x8)$show()) invisible(capture.output(expect_error(summary(x8), NA))) expect_output(summary(x8)$show()) x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-05) expect_equal(x8CodeBased$rejectAtLeastOne, x8$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x8CodeBased$rejectedArmsPerStage, x8$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$futilityStop, x8$futilityStop, tolerance = 1e-05) expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-05) expect_equal(x8CodeBased$successPerStage, x8$successPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$selectedArms, x8$selectedArms, tolerance = 1e-05) expect_equal(x8CodeBased$numberOfActiveArms, x8$numberOfActiveArms, tolerance = 1e-05) expect_equal(x8CodeBased$expectedNumberOfEvents, x8$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x8CodeBased$eventsPerStage, x8$eventsPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$singleNumberOfEventsPerStage, x8$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x8), "character") df <- as.data.frame(x8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x9 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "rBest", rValue = 2, plannedEvents = c(10, 30, 50), omegaMaxVector = seq(1, 1.6, 0.2), adaptations = c(TRUE, FALSE), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x9' with expected results expect_equal(x9$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x9$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x9$iterations[3, ], c(10, 10, 10, 10)) expect_equal(x9$rejectAtLeastOne, c(0.1, 0, 0.2, 0.6), tolerance = 1e-07) expect_equal(unlist(as.list(x9$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.1, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0.4), tolerance = 1e-07) expect_equal(x9$futilityStop, c(0, 0, 0, 0)) expect_equal(x9$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x9$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x9$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x9$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x9$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x9$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x9$successPerStage[3, ], c(0, 0, 0.2, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x9$selectedArms)), c(1, 0.7, 0.7, 1, 0.4, 0.4, 1, 0.2, 0.2, 1, 0.3, 0.3, 1, 0.5, 0.5, 1, 0.3, 0.3, 1, 0.6, 0.6, 1, 0.4, 0.4, 1, 0.5, 0.5, 1, 0.5, 0.5, 1, 0.7, 0.7, 1, 0.5, 0.5, 1, 0.3, 0.3, 1, 0.8, 0.8, 1, 0.5, 0.5, 1, 0.8, 0.8), tolerance = 1e-07) expect_equal(x9$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x9$numberOfActiveArms[2, ], c(2, 2, 2, 2)) expect_equal(x9$numberOfActiveArms[3, ], c(2, 2, 2, 2)) expect_equal(x9$expectedNumberOfEvents, c(178.24172, 173.11501, 129.7381, 168.7644), tolerance = 1e-07) expect_equal(unlist(as.list(x9$eventsPerStage)), c(4, 37.648344, 71.296689, 3.7272727, 34.12598, 64.524687, 3.5, 24.454168, 45.408337, 3.3076923, 29.564881, 55.82207, 4, 37.648344, 71.296689, 3.8181818, 34.958321, 66.09846, 3.6666667, 25.618652, 47.570638, 3.5384615, 31.627547, 59.716633, 4, 37.648344, 71.296689, 3.9090909, 35.790662, 67.672233, 3.8333333, 26.783137, 49.73294, 3.7692308, 33.690213, 63.611196, 4, 37.648344, 71.296689, 4, 36.623003, 69.246006, 4, 27.947621, 51.895242, 4, 35.75288, 67.505759), tolerance = 1e-07) expect_equal(unlist(as.list(x9$singleNumberOfEventsPerStage)), c(2, 16.824172, 16.824172, 1.9090909, 15.57007, 15.57007, 1.8333333, 10.975993, 10.975993, 1.7692308, 14.044543, 14.044543, 2, 16.824172, 16.824172, 2, 16.311501, 16.311501, 2, 11.97381, 11.97381, 2, 15.87644, 15.87644, 2, 16.824172, 16.824172, 2.0909091, 17.052933, 17.052933, 2.1666667, 12.971628, 12.971628, 2.2307692, 17.708337, 17.708337, 2, 16.824172, 16.824172, 2.1818182, 17.794365, 17.794365, 2.3333333, 13.969446, 13.969446, 2.4615385, 19.540234, 19.540234, 2, 16.824172, 16.824172, 1.8181818, 14.828638, 14.828638, 1.6666667, 9.9781754, 9.9781754, 1.5384615, 12.212646, 12.212646), tolerance = 1e-07) expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x9$conditionalPowerAchieved[2, ], c(0.0011884888, 0.025687618, 0.050936222, 0.056920177), tolerance = 1e-07) expect_equal(x9$conditionalPowerAchieved[3, ], c(0.13630501, 0.14441052, 0.13257023, 0.41932885), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x9), NA))) expect_output(print(x9)$show()) invisible(capture.output(expect_error(summary(x9), NA))) expect_output(summary(x9)$show()) x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-05) expect_equal(x9CodeBased$rejectAtLeastOne, x9$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x9CodeBased$rejectedArmsPerStage, x9$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$futilityStop, x9$futilityStop, tolerance = 1e-05) expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-05) expect_equal(x9CodeBased$successPerStage, x9$successPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$selectedArms, x9$selectedArms, tolerance = 1e-05) expect_equal(x9CodeBased$numberOfActiveArms, x9$numberOfActiveArms, tolerance = 1e-05) expect_equal(x9CodeBased$expectedNumberOfEvents, x9$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x9CodeBased$eventsPerStage, x9$eventsPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$singleNumberOfEventsPerStage, x9$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x9), "character") df <- as.data.frame(x9) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x9) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x10 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "epsilon", epsilonValue = 0.1, plannedEvents = c(10, 30, 50), omegaMaxVector = seq(1, 1.6, 0.2), adaptations = c(TRUE, FALSE), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), intersectionTest = "Hierarchical", maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x10' with expected results expect_equal(x10$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x10$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x10$iterations[3, ], c(6, 3, 2, 1)) expect_equal(x10$rejectAtLeastOne, c(0, 0, 0, 0)) expect_equal(unlist(as.list(x10$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x10$futilityStop, c(0.4, 0.7, 0.8, 0.9), tolerance = 1e-07) expect_equal(x10$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x10$futilityPerStage[2, ], c(0.4, 0.7, 0.8, 0.9), tolerance = 1e-07) expect_equal(x10$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x10$earlyStop[2, ], c(0.4, 0.7, 0.8, 0.9), tolerance = 1e-07) expect_equal(x10$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x10$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x10$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x10$selectedArms)), c(1, 0.6, 0.6, 1, 0.3, 0.3, 1, 0.2, 0.2, 1, 0.1, 0.1, 1, 0.5, 0.4, 1, 0.1, 0, 1, 0.4, 0, 1, 0.1, 0, 1, 0.2, 0, 1, 0.4, 0, 1, 0.3, 0, 1, 0.3, 0, 1, 0.2, 0.1, 1, 0.4, 0.1, 1, 0.4, 0, 1, 0.5, 0), tolerance = 1e-07) expect_equal(x10$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x10$numberOfActiveArms[2, ], c(1.5, 1.2, 1.3, 1), tolerance = 1e-07) expect_equal(x10$numberOfActiveArms[3, ], c(1.8333333, 1.3333333, 1, 1), tolerance = 1e-07) expect_equal(x10$expectedNumberOfEvents, c(148.64919, 116.07216, 81.180483, 62.574824), tolerance = 1e-07) expect_equal(unlist(as.list(x10$eventsPerStage)), c(4, 36.228838, 74.946902, 3.7272727, 32.081441, 69.354168, 3.5, 24.722719, 43.17497, 3.3076923, 20.210056, 25.087756, 4, 36.228838, 74.946902, 3.8181818, 32.863915, 71.045733, 3.6666667, 25.899991, 45.230921, 3.5384615, 21.62006, 26.838065, 4, 36.228838, 74.946902, 3.9090909, 33.646389, 72.737298, 3.8333333, 27.077263, 47.286871, 3.7692308, 23.030064, 28.588373, 4, 36.228838, 74.946902, 4, 34.428863, 74.428863, 4, 28.254536, 49.342822, 4, 24.440068, 30.338682), tolerance = 1e-07) expect_equal(unlist(as.list(x10$singleNumberOfEventsPerStage)), c(2, 16.114419, 19.359032, 1.9090909, 14.522866, 19.090909, 1.8333333, 11.116662, 9.6654647, 1.7692308, 9.0407994, 2.6090022, 2, 16.114419, 19.359032, 2, 15.214432, 20, 2, 12.127268, 10.544143, 2, 10.220034, 2.9493068, 2, 16.114419, 19.359032, 2.0909091, 15.905997, 20.909091, 2.1666667, 13.137874, 11.422822, 2.2307692, 11.399269, 3.2896115, 2, 16.114419, 19.359032, 2.1818182, 16.597562, 21.818182, 2.3333333, 14.148479, 12.301501, 2.4615385, 12.578503, 3.6299161, 2, 16.114419, 19.359032, 1.8181818, 13.831301, 18.181818, 1.6666667, 10.106057, 8.7867861, 1.5384615, 7.8615647, 2.2686976), tolerance = 1e-07) expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x10$conditionalPowerAchieved[2, ], c(0.0031444794, 0.00037604601, 0.038145414, 0.045847923), tolerance = 1e-07) expect_equal(x10$conditionalPowerAchieved[3, ], c(7.9302274e-08, 1.361166e-06, 0.16667791, 0.040805908), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x10), NA))) expect_output(print(x10)$show()) invisible(capture.output(expect_error(summary(x10), NA))) expect_output(summary(x10)$show()) x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-05) expect_equal(x10CodeBased$rejectAtLeastOne, x10$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x10CodeBased$rejectedArmsPerStage, x10$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$futilityStop, x10$futilityStop, tolerance = 1e-05) expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-05) expect_equal(x10CodeBased$successPerStage, x10$successPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$selectedArms, x10$selectedArms, tolerance = 1e-05) expect_equal(x10CodeBased$numberOfActiveArms, x10$numberOfActiveArms, tolerance = 1e-05) expect_equal(x10CodeBased$expectedNumberOfEvents, x10$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x10CodeBased$eventsPerStage, x10$eventsPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$singleNumberOfEventsPerStage, x10$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x10), "character") df <- as.data.frame(x10) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x10) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x11 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, directionUpper = FALSE,threshold = 0, plannedEvents = c(10, 30, 50), omegaMaxVector = 1/seq(0.1, 0.3, 0.1), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), intersectionTest = "Hierarchical", maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x11' with expected results expect_equal(x11$iterations[1, ], c(10, 10, 10)) expect_equal(x11$iterations[2, ], c(0, 0, 0)) expect_equal(x11$iterations[3, ], c(0, 0, 0)) expect_equal(x11$rejectAtLeastOne, c(0, 0, 0)) expect_equal(unlist(as.list(x11$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x11$futilityStop, c(1, 1, 1)) expect_equal(x11$futilityPerStage[1, ], c(1, 1, 1)) expect_equal(x11$futilityPerStage[2, ], c(0, 0, 0)) expect_equal(x11$earlyStop[1, ], c(1, 1, 1)) expect_equal(x11$earlyStop[2, ], c(0, 0, 0)) expect_equal(x11$successPerStage[1, ], c(0, 0, 0)) expect_equal(x11$successPerStage[2, ], c(0, 0, 0)) expect_equal(x11$successPerStage[3, ], c(0, 0, 0)) expect_equal(unlist(as.list(x11$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0)) expect_equal(x11$numberOfActiveArms[1, ], c(4, 4, 4)) expect_equal(x11$numberOfActiveArms[2, ], c(NaN, NaN, NaN)) expect_equal(x11$numberOfActiveArms[3, ], c(NaN, NaN, NaN)) expect_equal(x11$expectedNumberOfEvents, c(NaN, NaN, NaN)) expect_equal(unlist(as.list(x11$eventsPerStage)), c(1.5454545, 1.5454545, 1.5454545, 2, 2, 2, 2.3846154, 2.3846154, 2.3846154, 2.3636364, 2.3636364, 2.3636364, 2.6666667, 2.6666667, 2.6666667, 2.9230769, 2.9230769, 2.9230769, 3.1818182, 3.1818182, 3.1818182, 3.3333333, 3.3333333, 3.3333333, 3.4615385, 3.4615385, 3.4615385, 4, 4, 4, 4, 4, 4, 4, 4, 4), tolerance = 1e-07) expect_equal(unlist(as.list(x11$singleNumberOfEventsPerStage)), c(1.1818182, NaN, NaN, 1.3333333, NaN, NaN, 1.4615385, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2.8181818, NaN, NaN, 2.6666667, NaN, NaN, 2.5384615, NaN, NaN, 3.6363636, NaN, NaN, 3.3333333, NaN, NaN, 3.0769231, NaN, NaN, 0.36363636, NaN, NaN, 0.66666667, NaN, NaN, 0.92307692, NaN, NaN), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x11), NA))) expect_output(print(x11)$show()) invisible(capture.output(expect_error(summary(x11), NA))) expect_output(summary(x11)$show()) x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) expect_equal(x11CodeBased$iterations, x11$iterations, tolerance = 1e-05) expect_equal(x11CodeBased$rejectAtLeastOne, x11$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x11CodeBased$rejectedArmsPerStage, x11$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$futilityStop, x11$futilityStop, tolerance = 1e-05) expect_equal(x11CodeBased$futilityPerStage, x11$futilityPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$earlyStop, x11$earlyStop, tolerance = 1e-05) expect_equal(x11CodeBased$successPerStage, x11$successPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$selectedArms, x11$selectedArms, tolerance = 1e-05) expect_equal(x11CodeBased$numberOfActiveArms, x11$numberOfActiveArms, tolerance = 1e-05) expect_equal(x11CodeBased$expectedNumberOfEvents, x11$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x11CodeBased$eventsPerStage, x11$eventsPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$singleNumberOfEventsPerStage, x11$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_type(names(x11), "character") df <- as.data.frame(x11) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x11) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x12 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), typeOfShape = "linear", activeArms = 4, directionUpper = FALSE,threshold = 0, plannedEvents = c(10, 30, 50), omegaMaxVector = 1/seq(1, 1.6, 0.2), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), intersectionTest = "Hierarchical", maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x12' with expected results expect_equal(x12$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x12$iterations[2, ], c(0, 0, 0, 0)) expect_equal(x12$iterations[3, ], c(0, 0, 0, 0)) expect_equal(x12$rejectAtLeastOne, c(0, 0, 0, 0)) expect_equal(unlist(as.list(x12$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x12$futilityStop, c(1, 1, 1, 1)) expect_equal(x12$futilityPerStage[1, ], c(1, 1, 1, 1)) expect_equal(x12$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x12$earlyStop[1, ], c(1, 1, 1, 1)) expect_equal(x12$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x12$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x12$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x12$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x12$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0)) expect_equal(x12$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x12$numberOfActiveArms[2, ], c(NaN, NaN, NaN, NaN)) expect_equal(x12$numberOfActiveArms[3, ], c(NaN, NaN, NaN, NaN)) expect_equal(x12$expectedNumberOfEvents, c(NaN, NaN, NaN, NaN)) expect_equal(unlist(as.list(x12$eventsPerStage)), c(4, 4, 4, 4.2727273, 4.2727273, 4.2727273, 4.5, 4.5, 4.5, 4.6923077, 4.6923077, 4.6923077, 4, 4, 4, 4.1818182, 4.1818182, 4.1818182, 4.3333333, 4.3333333, 4.3333333, 4.4615385, 4.4615385, 4.4615385, 4, 4, 4, 4.0909091, 4.0909091, 4.0909091, 4.1666667, 4.1666667, 4.1666667, 4.2307692, 4.2307692, 4.2307692, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4), tolerance = 1e-07) expect_equal(unlist(as.list(x12$singleNumberOfEventsPerStage)), c(2, NaN, NaN, 2.0909091, NaN, NaN, 2.1666667, NaN, NaN, 2.2307692, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 1.9090909, NaN, NaN, 1.8333333, NaN, NaN, 1.7692308, NaN, NaN, 2, NaN, NaN, 1.8181818, NaN, NaN, 1.6666667, NaN, NaN, 1.5384615, NaN, NaN, 2, NaN, NaN, 2.1818182, NaN, NaN, 2.3333333, NaN, NaN, 2.4615385, NaN, NaN), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x12), NA))) expect_output(print(x12)$show()) invisible(capture.output(expect_error(summary(x12), NA))) expect_output(summary(x12)$show()) x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) expect_equal(x12CodeBased$iterations, x12$iterations, tolerance = 1e-05) expect_equal(x12CodeBased$rejectAtLeastOne, x12$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x12CodeBased$rejectedArmsPerStage, x12$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$futilityStop, x12$futilityStop, tolerance = 1e-05) expect_equal(x12CodeBased$futilityPerStage, x12$futilityPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$earlyStop, x12$earlyStop, tolerance = 1e-05) expect_equal(x12CodeBased$successPerStage, x12$successPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$selectedArms, x12$selectedArms, tolerance = 1e-05) expect_equal(x12CodeBased$numberOfActiveArms, x12$numberOfActiveArms, tolerance = 1e-05) expect_equal(x12CodeBased$expectedNumberOfEvents, x12$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x12CodeBased$eventsPerStage, x12$eventsPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$singleNumberOfEventsPerStage, x12$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_type(names(x12), "character") df <- as.data.frame(x12) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x12) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x13 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), typeOfShape = "userDefined", activeArms = 4, directionUpper = FALSE, threshold = 0, plannedEvents = c(10, 30, 50), adaptations = rep(TRUE, 2), effectMatrix = matrix(c(0.1,0.2,0.3,0.4,0.2,0.3,0.4,0.5), ncol = 4), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), intersectionTest = "Sidak", maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x13' with expected results expect_equal(x13$iterations[1, ], c(10, 10)) expect_equal(x13$iterations[2, ], c(0, 0)) expect_equal(x13$iterations[3, ], c(0, 0)) expect_equal(x13$rejectAtLeastOne, c(0, 0)) expect_equal(unlist(as.list(x13$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x13$futilityStop, c(1, 1)) expect_equal(x13$futilityPerStage[1, ], c(1, 1)) expect_equal(x13$futilityPerStage[2, ], c(0, 0)) expect_equal(x13$earlyStop[1, ], c(1, 1)) expect_equal(x13$earlyStop[2, ], c(0, 0)) expect_equal(x13$successPerStage[1, ], c(0, 0)) expect_equal(x13$successPerStage[2, ], c(0, 0)) expect_equal(x13$successPerStage[3, ], c(0, 0)) expect_equal(unlist(as.list(x13$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0)) expect_equal(x13$numberOfActiveArms[1, ], c(4, 4)) expect_equal(x13$numberOfActiveArms[2, ], c(NaN, NaN)) expect_equal(x13$numberOfActiveArms[3, ], c(NaN, NaN)) expect_equal(x13$expectedNumberOfEvents, c(NaN, NaN)) expect_equal(unlist(as.list(x13$eventsPerStage)), c(5.5, 5.5, 5.5, 5, 5, 5, 6.5, 6.5, 6.5, 5.8333333, 5.8333333, 5.8333333, 6, 6, 6, 5.4166667, 5.4166667, 5.4166667, 7, 7, 7, 6.25, 6.25, 6.25), tolerance = 1e-07) expect_equal(unlist(as.list(x13$singleNumberOfEventsPerStage)), c(0.5, NaN, NaN, 0.83333333, NaN, NaN, 1.5, NaN, NaN, 1.6666667, NaN, NaN, 1, NaN, NaN, 1.25, NaN, NaN, 2, NaN, NaN, 2.0833333, NaN, NaN, 5, NaN, NaN, 4.1666667, NaN, NaN), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x13), NA))) expect_output(print(x13)$show()) invisible(capture.output(expect_error(summary(x13), NA))) expect_output(summary(x13)$show()) x13CodeBased <- eval(parse(text = getObjectRCode(x13, stringWrapParagraphWidth = NULL))) expect_equal(x13CodeBased$iterations, x13$iterations, tolerance = 1e-05) expect_equal(x13CodeBased$rejectAtLeastOne, x13$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x13CodeBased$rejectedArmsPerStage, x13$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x13CodeBased$futilityStop, x13$futilityStop, tolerance = 1e-05) expect_equal(x13CodeBased$futilityPerStage, x13$futilityPerStage, tolerance = 1e-05) expect_equal(x13CodeBased$earlyStop, x13$earlyStop, tolerance = 1e-05) expect_equal(x13CodeBased$successPerStage, x13$successPerStage, tolerance = 1e-05) expect_equal(x13CodeBased$selectedArms, x13$selectedArms, tolerance = 1e-05) expect_equal(x13CodeBased$numberOfActiveArms, x13$numberOfActiveArms, tolerance = 1e-05) expect_equal(x13CodeBased$expectedNumberOfEvents, x13$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x13CodeBased$eventsPerStage, x13$eventsPerStage, tolerance = 1e-05) expect_equal(x13CodeBased$singleNumberOfEventsPerStage, x13$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_type(names(x13), "character") df <- as.data.frame(x13) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x13) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x14 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), typeOfShape = "sigmoidEmax", gED50 = 2, slope = 0.5, activeArms = 4, directionUpper = FALSE,threshold = 0, plannedEvents = c(10, 30, 50), omegaMaxVector = 1/seq(1, 1.6, 0.2), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), intersectionTest = "Sidak", maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x14' with expected results expect_equal(x14$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x14$iterations[2, ], c(0, 0, 0, 0)) expect_equal(x14$iterations[3, ], c(0, 0, 0, 0)) expect_equal(x14$rejectAtLeastOne, c(0, 0, 0, 0)) expect_equal(unlist(as.list(x14$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x14$futilityStop, c(1, 1, 1, 1)) expect_equal(x14$futilityPerStage[1, ], c(1, 1, 1, 1)) expect_equal(x14$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x14$earlyStop[1, ], c(1, 1, 1, 1)) expect_equal(x14$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x14$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x14$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x14$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x14$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0)) expect_equal(x14$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x14$numberOfActiveArms[2, ], c(NaN, NaN, NaN, NaN)) expect_equal(x14$numberOfActiveArms[3, ], c(NaN, NaN, NaN, NaN)) expect_equal(x14$expectedNumberOfEvents, c(NaN, NaN, NaN, NaN)) expect_equal(unlist(as.list(x14$eventsPerStage)), c(4, 4, 4, 4.1452587, 4.1452587, 4.1452587, 4.2627857, 4.2627857, 4.2627857, 4.3598306, 4.3598306, 4.3598306, 4, 4, 4, 4.1145653, 4.1145653, 4.1145653, 4.2072587, 4.2072587, 4.2072587, 4.2837979, 4.2837979, 4.2837979, 4, 4, 4, 4.0964933, 4.0964933, 4.0964933, 4.1745649, 4.1745649, 4.1745649, 4.2390305, 4.2390305, 4.2390305, 4, 4, 4, 4.0838719, 4.0838719, 4.0838719, 4.1517317, 4.1517317, 4.1517317, 4.2077651, 4.2077651, 4.2077651), tolerance = 1e-07) expect_equal(unlist(as.list(x14$singleNumberOfEventsPerStage)), c(2, NaN, NaN, 1.9985289, NaN, NaN, 1.9973387, NaN, NaN, 1.996356, NaN, NaN, 2, NaN, NaN, 1.9678356, NaN, NaN, 1.9418117, NaN, NaN, 1.9203232, NaN, NaN, 2, NaN, NaN, 1.9497636, NaN, NaN, 1.9091179, NaN, NaN, 1.8755558, NaN, NaN, 2, NaN, NaN, 1.9371422, NaN, NaN, 1.8862847, NaN, NaN, 1.8442904, NaN, NaN, 2, NaN, NaN, 2.1467297, NaN, NaN, 2.265447, NaN, NaN, 2.3634747, NaN, NaN), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x14), NA))) expect_output(print(x14)$show()) invisible(capture.output(expect_error(summary(x14), NA))) expect_output(summary(x14)$show()) x14CodeBased <- eval(parse(text = getObjectRCode(x14, stringWrapParagraphWidth = NULL))) expect_equal(x14CodeBased$iterations, x14$iterations, tolerance = 1e-05) expect_equal(x14CodeBased$rejectAtLeastOne, x14$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x14CodeBased$rejectedArmsPerStage, x14$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x14CodeBased$futilityStop, x14$futilityStop, tolerance = 1e-05) expect_equal(x14CodeBased$futilityPerStage, x14$futilityPerStage, tolerance = 1e-05) expect_equal(x14CodeBased$earlyStop, x14$earlyStop, tolerance = 1e-05) expect_equal(x14CodeBased$successPerStage, x14$successPerStage, tolerance = 1e-05) expect_equal(x14CodeBased$selectedArms, x14$selectedArms, tolerance = 1e-05) expect_equal(x14CodeBased$numberOfActiveArms, x14$numberOfActiveArms, tolerance = 1e-05) expect_equal(x14CodeBased$expectedNumberOfEvents, x14$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x14CodeBased$eventsPerStage, x14$eventsPerStage, tolerance = 1e-05) expect_equal(x14CodeBased$singleNumberOfEventsPerStage, x14$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_type(names(x14), "character") df <- as.data.frame(x14) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x14) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x15 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, directionUpper = FALSE,threshold = 0, typeOfSelection = "all", plannedEvents = c(10, 30, 50), omegaMaxVector = 1/seq(1, 1.6, 0.2), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), intersectionTest = "Sidak", maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x15' with expected results expect_equal(x15$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x15$iterations[2, ], c(0, 0, 0, 0)) expect_equal(x15$iterations[3, ], c(0, 0, 0, 0)) expect_equal(x15$rejectAtLeastOne, c(0, 0, 0, 0)) expect_equal(unlist(as.list(x15$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x15$futilityStop, c(1, 1, 1, 1)) expect_equal(x15$futilityPerStage[1, ], c(1, 1, 1, 1)) expect_equal(x15$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x15$earlyStop[1, ], c(1, 1, 1, 1)) expect_equal(x15$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x15$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x15$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x15$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x15$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0)) expect_equal(x15$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x15$numberOfActiveArms[2, ], c(NaN, NaN, NaN, NaN)) expect_equal(x15$numberOfActiveArms[3, ], c(NaN, NaN, NaN, NaN)) expect_equal(x15$expectedNumberOfEvents, c(NaN, NaN, NaN, NaN)) expect_equal(unlist(as.list(x15$eventsPerStage)), c(4, 4, 4, 4.2727273, 4.2727273, 4.2727273, 4.5, 4.5, 4.5, 4.6923077, 4.6923077, 4.6923077, 4, 4, 4, 4.1818182, 4.1818182, 4.1818182, 4.3333333, 4.3333333, 4.3333333, 4.4615385, 4.4615385, 4.4615385, 4, 4, 4, 4.0909091, 4.0909091, 4.0909091, 4.1666667, 4.1666667, 4.1666667, 4.2307692, 4.2307692, 4.2307692, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4), tolerance = 1e-07) expect_equal(unlist(as.list(x15$singleNumberOfEventsPerStage)), c(2, NaN, NaN, 2.0909091, NaN, NaN, 2.1666667, NaN, NaN, 2.2307692, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 1.9090909, NaN, NaN, 1.8333333, NaN, NaN, 1.7692308, NaN, NaN, 2, NaN, NaN, 1.8181818, NaN, NaN, 1.6666667, NaN, NaN, 1.5384615, NaN, NaN, 2, NaN, NaN, 2.1818182, NaN, NaN, 2.3333333, NaN, NaN, 2.4615385, NaN, NaN), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x15), NA))) expect_output(print(x15)$show()) invisible(capture.output(expect_error(summary(x15), NA))) expect_output(summary(x15)$show()) x15CodeBased <- eval(parse(text = getObjectRCode(x15, stringWrapParagraphWidth = NULL))) expect_equal(x15CodeBased$iterations, x15$iterations, tolerance = 1e-05) expect_equal(x15CodeBased$rejectAtLeastOne, x15$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x15CodeBased$rejectedArmsPerStage, x15$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x15CodeBased$futilityStop, x15$futilityStop, tolerance = 1e-05) expect_equal(x15CodeBased$futilityPerStage, x15$futilityPerStage, tolerance = 1e-05) expect_equal(x15CodeBased$earlyStop, x15$earlyStop, tolerance = 1e-05) expect_equal(x15CodeBased$successPerStage, x15$successPerStage, tolerance = 1e-05) expect_equal(x15CodeBased$selectedArms, x15$selectedArms, tolerance = 1e-05) expect_equal(x15CodeBased$numberOfActiveArms, x15$numberOfActiveArms, tolerance = 1e-05) expect_equal(x15CodeBased$expectedNumberOfEvents, x15$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x15CodeBased$eventsPerStage, x15$eventsPerStage, tolerance = 1e-05) expect_equal(x15CodeBased$singleNumberOfEventsPerStage, x15$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_type(names(x15), "character") df <- as.data.frame(x15) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x15) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x16 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, directionUpper = FALSE,threshold = 0, typeOfSelection = "rBest", rValue = 2, plannedEvents = c(10, 30, 50), omegaMaxVector = 1/seq(1, 1.6, 0.2), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), intersectionTest = "Simes", maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x16' with expected results expect_equal(x16$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x16$iterations[2, ], c(0, 0, 0, 0)) expect_equal(x16$iterations[3, ], c(0, 0, 0, 0)) expect_equal(x16$rejectAtLeastOne, c(0, 0, 0, 0)) expect_equal(unlist(as.list(x16$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x16$futilityStop, c(1, 1, 1, 1)) expect_equal(x16$futilityPerStage[1, ], c(1, 1, 1, 1)) expect_equal(x16$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x16$earlyStop[1, ], c(1, 1, 1, 1)) expect_equal(x16$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x16$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x16$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x16$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x16$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0)) expect_equal(x16$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x16$numberOfActiveArms[2, ], c(NaN, NaN, NaN, NaN)) expect_equal(x16$numberOfActiveArms[3, ], c(NaN, NaN, NaN, NaN)) expect_equal(x16$expectedNumberOfEvents, c(NaN, NaN, NaN, NaN)) expect_equal(unlist(as.list(x16$eventsPerStage)), c(4, 4, 4, 4.2727273, 4.2727273, 4.2727273, 4.5, 4.5, 4.5, 4.6923077, 4.6923077, 4.6923077, 4, 4, 4, 4.1818182, 4.1818182, 4.1818182, 4.3333333, 4.3333333, 4.3333333, 4.4615385, 4.4615385, 4.4615385, 4, 4, 4, 4.0909091, 4.0909091, 4.0909091, 4.1666667, 4.1666667, 4.1666667, 4.2307692, 4.2307692, 4.2307692, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4), tolerance = 1e-07) expect_equal(unlist(as.list(x16$singleNumberOfEventsPerStage)), c(2, NaN, NaN, 2.0909091, NaN, NaN, 2.1666667, NaN, NaN, 2.2307692, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 1.9090909, NaN, NaN, 1.8333333, NaN, NaN, 1.7692308, NaN, NaN, 2, NaN, NaN, 1.8181818, NaN, NaN, 1.6666667, NaN, NaN, 1.5384615, NaN, NaN, 2, NaN, NaN, 2.1818182, NaN, NaN, 2.3333333, NaN, NaN, 2.4615385, NaN, NaN), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x16), NA))) expect_output(print(x16)$show()) invisible(capture.output(expect_error(summary(x16), NA))) expect_output(summary(x16)$show()) x16CodeBased <- eval(parse(text = getObjectRCode(x16, stringWrapParagraphWidth = NULL))) expect_equal(x16CodeBased$iterations, x16$iterations, tolerance = 1e-05) expect_equal(x16CodeBased$rejectAtLeastOne, x16$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x16CodeBased$rejectedArmsPerStage, x16$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x16CodeBased$futilityStop, x16$futilityStop, tolerance = 1e-05) expect_equal(x16CodeBased$futilityPerStage, x16$futilityPerStage, tolerance = 1e-05) expect_equal(x16CodeBased$earlyStop, x16$earlyStop, tolerance = 1e-05) expect_equal(x16CodeBased$successPerStage, x16$successPerStage, tolerance = 1e-05) expect_equal(x16CodeBased$selectedArms, x16$selectedArms, tolerance = 1e-05) expect_equal(x16CodeBased$numberOfActiveArms, x16$numberOfActiveArms, tolerance = 1e-05) expect_equal(x16CodeBased$expectedNumberOfEvents, x16$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x16CodeBased$eventsPerStage, x16$eventsPerStage, tolerance = 1e-05) expect_equal(x16CodeBased$singleNumberOfEventsPerStage, x16$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_type(names(x16), "character") df <- as.data.frame(x16) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x16) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x17 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, directionUpper = FALSE,threshold = 0, typeOfSelection = "epsilon", epsilonValue = 0.1, plannedEvents = c(10, 30, 50), omegaMaxVector = 1/seq(1, 1.6, 0.2), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), intersectionTest = "Simes", maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x17' with expected results expect_equal(x17$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x17$iterations[2, ], c(0, 0, 0, 0)) expect_equal(x17$iterations[3, ], c(0, 0, 0, 0)) expect_equal(x17$rejectAtLeastOne, c(0, 0, 0, 0)) expect_equal(unlist(as.list(x17$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x17$futilityStop, c(1, 1, 1, 1)) expect_equal(x17$futilityPerStage[1, ], c(1, 1, 1, 1)) expect_equal(x17$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x17$earlyStop[1, ], c(1, 1, 1, 1)) expect_equal(x17$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x17$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x17$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x17$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x17$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0)) expect_equal(x17$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x17$numberOfActiveArms[2, ], c(NaN, NaN, NaN, NaN)) expect_equal(x17$numberOfActiveArms[3, ], c(NaN, NaN, NaN, NaN)) expect_equal(x17$expectedNumberOfEvents, c(NaN, NaN, NaN, NaN)) expect_equal(unlist(as.list(x17$eventsPerStage)), c(4, 4, 4, 4.2727273, 4.2727273, 4.2727273, 4.5, 4.5, 4.5, 4.6923077, 4.6923077, 4.6923077, 4, 4, 4, 4.1818182, 4.1818182, 4.1818182, 4.3333333, 4.3333333, 4.3333333, 4.4615385, 4.4615385, 4.4615385, 4, 4, 4, 4.0909091, 4.0909091, 4.0909091, 4.1666667, 4.1666667, 4.1666667, 4.2307692, 4.2307692, 4.2307692, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4), tolerance = 1e-07) expect_equal(unlist(as.list(x17$singleNumberOfEventsPerStage)), c(2, NaN, NaN, 2.0909091, NaN, NaN, 2.1666667, NaN, NaN, 2.2307692, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 1.9090909, NaN, NaN, 1.8333333, NaN, NaN, 1.7692308, NaN, NaN, 2, NaN, NaN, 1.8181818, NaN, NaN, 1.6666667, NaN, NaN, 1.5384615, NaN, NaN, 2, NaN, NaN, 2.1818182, NaN, NaN, 2.3333333, NaN, NaN, 2.4615385, NaN, NaN), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x17), NA))) expect_output(print(x17)$show()) invisible(capture.output(expect_error(summary(x17), NA))) expect_output(summary(x17)$show()) x17CodeBased <- eval(parse(text = getObjectRCode(x17, stringWrapParagraphWidth = NULL))) expect_equal(x17CodeBased$iterations, x17$iterations, tolerance = 1e-05) expect_equal(x17CodeBased$rejectAtLeastOne, x17$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x17CodeBased$rejectedArmsPerStage, x17$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x17CodeBased$futilityStop, x17$futilityStop, tolerance = 1e-05) expect_equal(x17CodeBased$futilityPerStage, x17$futilityPerStage, tolerance = 1e-05) expect_equal(x17CodeBased$earlyStop, x17$earlyStop, tolerance = 1e-05) expect_equal(x17CodeBased$successPerStage, x17$successPerStage, tolerance = 1e-05) expect_equal(x17CodeBased$selectedArms, x17$selectedArms, tolerance = 1e-05) expect_equal(x17CodeBased$numberOfActiveArms, x17$numberOfActiveArms, tolerance = 1e-05) expect_equal(x17CodeBased$expectedNumberOfEvents, x17$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x17CodeBased$eventsPerStage, x17$eventsPerStage, tolerance = 1e-05) expect_equal(x17CodeBased$singleNumberOfEventsPerStage, x17$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_type(names(x17), "character") df <- as.data.frame(x17) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x17) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x18 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, directionUpper = FALSE,threshold = 0, plannedEvents = c(10, 30, 50), omegaMaxVector = 1/seq(1, 1.6, 0.2), adaptations = c(TRUE, FALSE), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), intersectionTest = "Simes", maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x18' with expected results expect_equal(x18$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x18$iterations[2, ], c(0, 0, 0, 0)) expect_equal(x18$iterations[3, ], c(0, 0, 0, 0)) expect_equal(x18$rejectAtLeastOne, c(0, 0, 0, 0)) expect_equal(unlist(as.list(x18$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x18$futilityStop, c(1, 1, 1, 1)) expect_equal(x18$futilityPerStage[1, ], c(1, 1, 1, 1)) expect_equal(x18$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x18$earlyStop[1, ], c(1, 1, 1, 1)) expect_equal(x18$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x18$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x18$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x18$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x18$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0)) expect_equal(x18$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x18$numberOfActiveArms[2, ], c(NaN, NaN, NaN, NaN)) expect_equal(x18$numberOfActiveArms[3, ], c(NaN, NaN, NaN, NaN)) expect_equal(x18$expectedNumberOfEvents, c(NaN, NaN, NaN, NaN)) expect_equal(unlist(as.list(x18$eventsPerStage)), c(4, 4, 4, 4.2727273, 4.2727273, 4.2727273, 4.5, 4.5, 4.5, 4.6923077, 4.6923077, 4.6923077, 4, 4, 4, 4.1818182, 4.1818182, 4.1818182, 4.3333333, 4.3333333, 4.3333333, 4.4615385, 4.4615385, 4.4615385, 4, 4, 4, 4.0909091, 4.0909091, 4.0909091, 4.1666667, 4.1666667, 4.1666667, 4.2307692, 4.2307692, 4.2307692, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4), tolerance = 1e-07) expect_equal(unlist(as.list(x18$singleNumberOfEventsPerStage)), c(2, NaN, NaN, 2.0909091, NaN, NaN, 2.1666667, NaN, NaN, 2.2307692, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 1.9090909, NaN, NaN, 1.8333333, NaN, NaN, 1.7692308, NaN, NaN, 2, NaN, NaN, 1.8181818, NaN, NaN, 1.6666667, NaN, NaN, 1.5384615, NaN, NaN, 2, NaN, NaN, 2.1818182, NaN, NaN, 2.3333333, NaN, NaN, 2.4615385, NaN, NaN), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x18), NA))) expect_output(print(x18)$show()) invisible(capture.output(expect_error(summary(x18), NA))) expect_output(summary(x18)$show()) x18CodeBased <- eval(parse(text = getObjectRCode(x18, stringWrapParagraphWidth = NULL))) expect_equal(x18CodeBased$iterations, x18$iterations, tolerance = 1e-05) expect_equal(x18CodeBased$rejectAtLeastOne, x18$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x18CodeBased$rejectedArmsPerStage, x18$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x18CodeBased$futilityStop, x18$futilityStop, tolerance = 1e-05) expect_equal(x18CodeBased$futilityPerStage, x18$futilityPerStage, tolerance = 1e-05) expect_equal(x18CodeBased$earlyStop, x18$earlyStop, tolerance = 1e-05) expect_equal(x18CodeBased$successPerStage, x18$successPerStage, tolerance = 1e-05) expect_equal(x18CodeBased$selectedArms, x18$selectedArms, tolerance = 1e-05) expect_equal(x18CodeBased$numberOfActiveArms, x18$numberOfActiveArms, tolerance = 1e-05) expect_equal(x18CodeBased$expectedNumberOfEvents, x18$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x18CodeBased$eventsPerStage, x18$eventsPerStage, tolerance = 1e-05) expect_equal(x18CodeBased$singleNumberOfEventsPerStage, x18$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_type(names(x18), "character") df <- as.data.frame(x18) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x18) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x19 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, directionUpper = FALSE,threshold = 0, typeOfSelection = "all", plannedEvents = c(10, 30, 50), omegaMaxVector = 1/seq(1, 1.6, 0.2), adaptations = c(TRUE, FALSE), conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), intersectionTest = "Bonferroni", maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x19' with expected results expect_equal(x19$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x19$iterations[2, ], c(0, 0, 0, 0)) expect_equal(x19$iterations[3, ], c(0, 0, 0, 0)) expect_equal(x19$rejectAtLeastOne, c(0, 0, 0, 0)) expect_equal(unlist(as.list(x19$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x19$futilityStop, c(1, 1, 1, 1)) expect_equal(x19$futilityPerStage[1, ], c(1, 1, 1, 1)) expect_equal(x19$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x19$earlyStop[1, ], c(1, 1, 1, 1)) expect_equal(x19$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x19$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x19$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x19$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x19$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0)) expect_equal(x19$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x19$numberOfActiveArms[2, ], c(NaN, NaN, NaN, NaN)) expect_equal(x19$numberOfActiveArms[3, ], c(NaN, NaN, NaN, NaN)) expect_equal(x19$expectedNumberOfEvents, c(NaN, NaN, NaN, NaN)) expect_equal(unlist(as.list(x19$eventsPerStage)), c(4, 4, 4, 4.2727273, 4.2727273, 4.2727273, 4.5, 4.5, 4.5, 4.6923077, 4.6923077, 4.6923077, 4, 4, 4, 4.1818182, 4.1818182, 4.1818182, 4.3333333, 4.3333333, 4.3333333, 4.4615385, 4.4615385, 4.4615385, 4, 4, 4, 4.0909091, 4.0909091, 4.0909091, 4.1666667, 4.1666667, 4.1666667, 4.2307692, 4.2307692, 4.2307692, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4), tolerance = 1e-07) expect_equal(unlist(as.list(x19$singleNumberOfEventsPerStage)), c(2, NaN, NaN, 2.0909091, NaN, NaN, 2.1666667, NaN, NaN, 2.2307692, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 1.9090909, NaN, NaN, 1.8333333, NaN, NaN, 1.7692308, NaN, NaN, 2, NaN, NaN, 1.8181818, NaN, NaN, 1.6666667, NaN, NaN, 1.5384615, NaN, NaN, 2, NaN, NaN, 2.1818182, NaN, NaN, 2.3333333, NaN, NaN, 2.4615385, NaN, NaN), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x19), NA))) expect_output(print(x19)$show()) invisible(capture.output(expect_error(summary(x19), NA))) expect_output(summary(x19)$show()) x19CodeBased <- eval(parse(text = getObjectRCode(x19, stringWrapParagraphWidth = NULL))) expect_equal(x19CodeBased$iterations, x19$iterations, tolerance = 1e-05) expect_equal(x19CodeBased$rejectAtLeastOne, x19$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x19CodeBased$rejectedArmsPerStage, x19$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x19CodeBased$futilityStop, x19$futilityStop, tolerance = 1e-05) expect_equal(x19CodeBased$futilityPerStage, x19$futilityPerStage, tolerance = 1e-05) expect_equal(x19CodeBased$earlyStop, x19$earlyStop, tolerance = 1e-05) expect_equal(x19CodeBased$successPerStage, x19$successPerStage, tolerance = 1e-05) expect_equal(x19CodeBased$selectedArms, x19$selectedArms, tolerance = 1e-05) expect_equal(x19CodeBased$numberOfActiveArms, x19$numberOfActiveArms, tolerance = 1e-05) expect_equal(x19CodeBased$expectedNumberOfEvents, x19$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x19CodeBased$eventsPerStage, x19$eventsPerStage, tolerance = 1e-05) expect_equal(x19CodeBased$singleNumberOfEventsPerStage, x19$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_type(names(x19), "character") df <- as.data.frame(x19) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x19) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x20 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, directionUpper = FALSE,threshold = 0, typeOfSelection = "rBest", rValue = 2, plannedEvents = c(10, 30, 50), omegaMaxVector = 1/seq(1, 1.6, 0.2), adaptations = c(TRUE, FALSE), intersectionTest = "Bonferroni", conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x20' with expected results expect_equal(x20$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x20$iterations[2, ], c(0, 0, 0, 0)) expect_equal(x20$iterations[3, ], c(0, 0, 0, 0)) expect_equal(x20$rejectAtLeastOne, c(0, 0, 0, 0)) expect_equal(unlist(as.list(x20$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x20$futilityStop, c(1, 1, 1, 1)) expect_equal(x20$futilityPerStage[1, ], c(1, 1, 1, 1)) expect_equal(x20$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x20$earlyStop[1, ], c(1, 1, 1, 1)) expect_equal(x20$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x20$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x20$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x20$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x20$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0)) expect_equal(x20$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x20$numberOfActiveArms[2, ], c(NaN, NaN, NaN, NaN)) expect_equal(x20$numberOfActiveArms[3, ], c(NaN, NaN, NaN, NaN)) expect_equal(x20$expectedNumberOfEvents, c(NaN, NaN, NaN, NaN)) expect_equal(unlist(as.list(x20$eventsPerStage)), c(4, 4, 4, 4.2727273, 4.2727273, 4.2727273, 4.5, 4.5, 4.5, 4.6923077, 4.6923077, 4.6923077, 4, 4, 4, 4.1818182, 4.1818182, 4.1818182, 4.3333333, 4.3333333, 4.3333333, 4.4615385, 4.4615385, 4.4615385, 4, 4, 4, 4.0909091, 4.0909091, 4.0909091, 4.1666667, 4.1666667, 4.1666667, 4.2307692, 4.2307692, 4.2307692, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4), tolerance = 1e-07) expect_equal(unlist(as.list(x20$singleNumberOfEventsPerStage)), c(2, NaN, NaN, 2.0909091, NaN, NaN, 2.1666667, NaN, NaN, 2.2307692, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 1.9090909, NaN, NaN, 1.8333333, NaN, NaN, 1.7692308, NaN, NaN, 2, NaN, NaN, 1.8181818, NaN, NaN, 1.6666667, NaN, NaN, 1.5384615, NaN, NaN, 2, NaN, NaN, 2.1818182, NaN, NaN, 2.3333333, NaN, NaN, 2.4615385, NaN, NaN), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x20), NA))) expect_output(print(x20)$show()) invisible(capture.output(expect_error(summary(x20), NA))) expect_output(summary(x20)$show()) x20CodeBased <- eval(parse(text = getObjectRCode(x20, stringWrapParagraphWidth = NULL))) expect_equal(x20CodeBased$iterations, x20$iterations, tolerance = 1e-05) expect_equal(x20CodeBased$rejectAtLeastOne, x20$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x20CodeBased$rejectedArmsPerStage, x20$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x20CodeBased$futilityStop, x20$futilityStop, tolerance = 1e-05) expect_equal(x20CodeBased$futilityPerStage, x20$futilityPerStage, tolerance = 1e-05) expect_equal(x20CodeBased$earlyStop, x20$earlyStop, tolerance = 1e-05) expect_equal(x20CodeBased$successPerStage, x20$successPerStage, tolerance = 1e-05) expect_equal(x20CodeBased$selectedArms, x20$selectedArms, tolerance = 1e-05) expect_equal(x20CodeBased$numberOfActiveArms, x20$numberOfActiveArms, tolerance = 1e-05) expect_equal(x20CodeBased$expectedNumberOfEvents, x20$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x20CodeBased$eventsPerStage, x20$eventsPerStage, tolerance = 1e-05) expect_equal(x20CodeBased$singleNumberOfEventsPerStage, x20$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_type(names(x20), "character") df <- as.data.frame(x20) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x20) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x21 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, directionUpper = FALSE,threshold = 0, typeOfSelection = "epsilon", epsilonValue = 0.1, plannedEvents = c(10, 30, 50), omegaMaxVector = 1/seq(1, 1.6, 0.2), adaptations = c(TRUE, FALSE), intersectionTest = "Bonferroni", conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x21' with expected results expect_equal(x21$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x21$iterations[2, ], c(0, 0, 0, 0)) expect_equal(x21$iterations[3, ], c(0, 0, 0, 0)) expect_equal(x21$rejectAtLeastOne, c(0, 0, 0, 0)) expect_equal(unlist(as.list(x21$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x21$futilityStop, c(1, 1, 1, 1)) expect_equal(x21$futilityPerStage[1, ], c(1, 1, 1, 1)) expect_equal(x21$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x21$earlyStop[1, ], c(1, 1, 1, 1)) expect_equal(x21$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x21$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x21$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x21$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x21$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0)) expect_equal(x21$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x21$numberOfActiveArms[2, ], c(NaN, NaN, NaN, NaN)) expect_equal(x21$numberOfActiveArms[3, ], c(NaN, NaN, NaN, NaN)) expect_equal(x21$expectedNumberOfEvents, c(NaN, NaN, NaN, NaN)) expect_equal(unlist(as.list(x21$eventsPerStage)), c(4, 4, 4, 4.2727273, 4.2727273, 4.2727273, 4.5, 4.5, 4.5, 4.6923077, 4.6923077, 4.6923077, 4, 4, 4, 4.1818182, 4.1818182, 4.1818182, 4.3333333, 4.3333333, 4.3333333, 4.4615385, 4.4615385, 4.4615385, 4, 4, 4, 4.0909091, 4.0909091, 4.0909091, 4.1666667, 4.1666667, 4.1666667, 4.2307692, 4.2307692, 4.2307692, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4), tolerance = 1e-07) expect_equal(unlist(as.list(x21$singleNumberOfEventsPerStage)), c(2, NaN, NaN, 2.0909091, NaN, NaN, 2.1666667, NaN, NaN, 2.2307692, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 2, NaN, NaN, 1.9090909, NaN, NaN, 1.8333333, NaN, NaN, 1.7692308, NaN, NaN, 2, NaN, NaN, 1.8181818, NaN, NaN, 1.6666667, NaN, NaN, 1.5384615, NaN, NaN, 2, NaN, NaN, 2.1818182, NaN, NaN, 2.3333333, NaN, NaN, 2.4615385, NaN, NaN), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x21), NA))) expect_output(print(x21)$show()) invisible(capture.output(expect_error(summary(x21), NA))) expect_output(summary(x21)$show()) x21CodeBased <- eval(parse(text = getObjectRCode(x21, stringWrapParagraphWidth = NULL))) expect_equal(x21CodeBased$iterations, x21$iterations, tolerance = 1e-05) expect_equal(x21CodeBased$rejectAtLeastOne, x21$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x21CodeBased$rejectedArmsPerStage, x21$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x21CodeBased$futilityStop, x21$futilityStop, tolerance = 1e-05) expect_equal(x21CodeBased$futilityPerStage, x21$futilityPerStage, tolerance = 1e-05) expect_equal(x21CodeBased$earlyStop, x21$earlyStop, tolerance = 1e-05) expect_equal(x21CodeBased$successPerStage, x21$successPerStage, tolerance = 1e-05) expect_equal(x21CodeBased$selectedArms, x21$selectedArms, tolerance = 1e-05) expect_equal(x21CodeBased$numberOfActiveArms, x21$numberOfActiveArms, tolerance = 1e-05) expect_equal(x21CodeBased$expectedNumberOfEvents, x21$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x21CodeBased$eventsPerStage, x21$eventsPerStage, tolerance = 1e-05) expect_equal(x21CodeBased$singleNumberOfEventsPerStage, x21$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_type(names(x21), "character") df <- as.data.frame(x21) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x21) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x22 <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, directionUpper = FALSE,threshold = 0.1, plannedEvents = c(10, 30, 50), omegaMaxVector = seq(0.1, 0.3, 0.1), intersectionTest = "Bonferroni", conditionalPower = 0.8, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x22' with expected results expect_equal(x22$iterations[1, ], c(10, 10, 10)) expect_equal(x22$iterations[2, ], c(1, 4, 3)) expect_equal(x22$iterations[3, ], c(0, 0, 0)) expect_equal(x22$rejectAtLeastOne, c(0.1, 0.3, 0.2), tolerance = 1e-07) expect_equal(unlist(as.list(x22$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.2, 0, 0, 0.2, 0), tolerance = 1e-07) expect_equal(x22$futilityStop, c(0.9, 0.7, 0.8), tolerance = 1e-07) expect_equal(x22$futilityPerStage[1, ], c(0.9, 0.6, 0.7), tolerance = 1e-07) expect_equal(x22$futilityPerStage[2, ], c(0, 0.1, 0.1), tolerance = 1e-07) expect_equal(x22$earlyStop[1, ], c(0.9, 0.6, 0.7), tolerance = 1e-07) expect_equal(x22$earlyStop[2, ], c(0.1, 0.4, 0.3), tolerance = 1e-07) expect_equal(x22$successPerStage[1, ], c(0, 0, 0)) expect_equal(x22$successPerStage[2, ], c(0.1, 0.3, 0.2), tolerance = 1e-07) expect_equal(x22$successPerStage[3, ], c(0, 0, 0)) expect_equal(unlist(as.list(x22$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0.1, 0, 1, 0.1, 0, 1, 0, 0, 1, 0.1, 0, 1, 0, 0, 1, 0.1, 0, 1, 0.2, 0, 1, 0.2, 0), tolerance = 1e-07) expect_equal(x22$numberOfActiveArms[1, ], c(4, 4, 4)) expect_equal(x22$numberOfActiveArms[2, ], c(1, 1, 1)) expect_equal(x22$numberOfActiveArms[3, ], c(NaN, NaN, NaN)) expect_equal(x22$expectedNumberOfEvents, c(NaN, NaN, NaN)) expect_equal(unlist(as.list(x22$eventsPerStage)), c(6.4545455, 9.0363636, 9.0363636, 6, 8.5078894, 8.5078894, 5.6153846, 8.0390249, 8.0390249, 5.6363636, 7.8909091, 7.8909091, 5.3333333, 7.5625684, 7.5625684, 5.0769231, 7.2681595, 7.2681595, 4.8181818, 6.7454545, 6.7454545, 4.6666667, 6.6172473, 6.6172473, 4.5384615, 6.4972941, 6.4972941, 4, 5.6, 5.6, 4, 5.6719263, 5.6719263, 4, 5.7264287, 5.7264287), tolerance = 1e-07) expect_equal(unlist(as.list(x22$singleNumberOfEventsPerStage)), c(2.8181818, 1.1272727, NaN, 2.6666667, 1.1146175, NaN, 2.5384615, 1.0956182, NaN, 2, 0.8, NaN, 2, 0.83596315, NaN, 2, 0.86321435, NaN, 1.1818182, 0.47272727, NaN, 1.3333333, 0.55730877, NaN, 1.4615385, 0.63081049, NaN, 0.36363636, 0.14545455, NaN, 0.66666667, 0.27865438, NaN, 0.92307692, 0.39840662, NaN, 3.6363636, 1.4545455, NaN, 3.3333333, 1.3932719, NaN, 3.0769231, 1.3280221, NaN), tolerance = 1e-07) expect_equal(x22$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x22$conditionalPowerAchieved[2, ], c(0.99998124, 0.93006261, 0.86196268), tolerance = 1e-07) expect_equal(x22$conditionalPowerAchieved[3, ], c(NaN, NaN, NaN)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x22), NA))) expect_output(print(x22)$show()) invisible(capture.output(expect_error(summary(x22), NA))) expect_output(summary(x22)$show()) x22CodeBased <- eval(parse(text = getObjectRCode(x22, stringWrapParagraphWidth = NULL))) expect_equal(x22CodeBased$iterations, x22$iterations, tolerance = 1e-05) expect_equal(x22CodeBased$rejectAtLeastOne, x22$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x22CodeBased$rejectedArmsPerStage, x22$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x22CodeBased$futilityStop, x22$futilityStop, tolerance = 1e-05) expect_equal(x22CodeBased$futilityPerStage, x22$futilityPerStage, tolerance = 1e-05) expect_equal(x22CodeBased$earlyStop, x22$earlyStop, tolerance = 1e-05) expect_equal(x22CodeBased$successPerStage, x22$successPerStage, tolerance = 1e-05) expect_equal(x22CodeBased$selectedArms, x22$selectedArms, tolerance = 1e-05) expect_equal(x22CodeBased$numberOfActiveArms, x22$numberOfActiveArms, tolerance = 1e-05) expect_equal(x22CodeBased$expectedNumberOfEvents, x22$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(x22CodeBased$eventsPerStage, x22$eventsPerStage, tolerance = 1e-05) expect_equal(x22CodeBased$singleNumberOfEventsPerStage, x22$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(x22CodeBased$conditionalPowerAchieved, x22$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x22), "character") df <- as.data.frame(x22) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x22) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationMultiArmSurvival': using calcSubjectsFunction", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmSurvival} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmSurvivalCholeskyTransformation} # @refFS[Formula]{fs:SimulationMultiArmSurvivalCorrMatrix} # @refFS[Formula]{fs:SimulationMultiArmSurvivalEvents} # @refFS[Formula]{fs:SimulationMultiArmSurvivalLogRanks} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} calcSubjectsFunctionSimulationMultiArmSurvival <- function(..., stage, minNumberOfEventsPerStage) { return(ifelse(stage == 3, 33, minNumberOfEventsPerStage[stage])) } x <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), typeOfShape = "linear", activeArms = 4, plannedEvents = c(10, 30, 50), omegaMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2),directionUpper = FALSE, minNumberOfEventsPerStage = c(10, 4, 4), maxNumberOfEventsPerStage = c(10, 100, 100), maxNumberOfIterations = 10, calcEventsFunction = calcSubjectsFunctionSimulationMultiArmSurvival) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x' with expected results expect_equal(x$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x$iterations[3, ], c(9, 10, 8, 9)) expect_equal(x$rejectAtLeastOne, c(0.3, 0.4, 0.7, 0.3), tolerance = 1e-07) expect_equal(unlist(as.list(x$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0, 0, 0, 0, 0.1, 0.2, 0, 0, 0.1, 0, 0, 0.1, 0, 0, 0.3, 0, 0.1, 0.3, 0, 0, 0.1), tolerance = 1e-07) expect_equal(x$futilityStop, c(0, 0, 0, 0)) expect_equal(x$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x$earlyStop[2, ], c(0.1, 0, 0.2, 0.1), tolerance = 1e-07) expect_equal(x$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x$successPerStage[2, ], c(0.1, 0, 0.2, 0.1), tolerance = 1e-07) expect_equal(x$successPerStage[3, ], c(0.2, 0.4, 0.5, 0.2), tolerance = 1e-07) expect_equal(unlist(as.list(x$selectedArms)), c(1, 0.1, 0.1, 1, 0, 0, 1, 0.1, 0.1, 1, 0.2, 0.1, 1, 0.2, 0.2, 1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.4, 0.3, 1, 0.4, 0.4, 1, 0.4, 0.3, 1, 0.5, 0.5, 1, 0.3, 0.3, 1, 0.5, 0.5, 1, 0.4, 0.3, 1, 0.2, 0.2), tolerance = 1e-07) expect_equal(x$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x$expectedNumberOfEvents, c(43.7, 47, 40.4, 43.7), tolerance = 1e-07) expect_equal(unlist(as.list(x$eventsPerStage)), c(5.6153846, 7.8615385, 26.392308, 5.2857143, 7.4, 24.842857, 5, 7, 23.5, 4.75, 6.65, 22.325, 5.0769231, 7.1076923, 23.861538, 4.8571429, 6.8, 22.828571, 4.6666667, 6.5333333, 21.933333, 4.5, 6.3, 21.15, 4.5384615, 6.3538462, 21.330769, 4.4285714, 6.2, 20.814286, 4.3333333, 6.0666667, 20.366667, 4.25, 5.95, 19.975, 4, 5.6, 18.8, 4, 5.6, 18.8, 4, 5.6, 18.8, 4, 5.6, 18.8), tolerance = 1e-07) expect_equal(unlist(as.list(x$singleNumberOfEventsPerStage)), c(2.5384615, 1.0153846, 8.3769231, 2.4285714, 0.97142857, 8.0142857, 2.3333333, 0.93333333, 7.7, 2.25, 0.9, 7.425, 2, 0.8, 6.6, 2, 0.8, 6.6, 2, 0.8, 6.6, 2, 0.8, 6.6, 1.4615385, 0.58461538, 4.8230769, 1.5714286, 0.62857143, 5.1857143, 1.6666667, 0.66666667, 5.5, 1.75, 0.7, 5.775, 0.92307692, 0.36923077, 3.0461538, 1.1428571, 0.45714286, 3.7714286, 1.3333333, 0.53333333, 4.4, 1.5, 0.6, 4.95, 3.0769231, 1.2307692, 10.153846, 2.8571429, 1.1428571, 9.4285714, 2.6666667, 1.0666667, 8.8, 2.5, 1, 8.25), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$conditionalPowerAchieved[2, ], c(0.13227215, 0.33500952, 0.32478794, 0.19174696), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[3, ], c(0.28682503, 0.6076832, 0.60939504, 0.37477275), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x), NA))) expect_output(print(x)$show()) invisible(capture.output(expect_error(summary(x), NA))) expect_output(summary(x)$show()) xCodeBased <- eval(parse(text = getObjectRCode(x, stringWrapParagraphWidth = NULL))) expect_equal(xCodeBased$iterations, x$iterations, tolerance = 1e-05) expect_equal(xCodeBased$rejectAtLeastOne, x$rejectAtLeastOne, tolerance = 1e-05) expect_equal(xCodeBased$rejectedArmsPerStage, x$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$futilityStop, x$futilityStop, tolerance = 1e-05) expect_equal(xCodeBased$futilityPerStage, x$futilityPerStage, tolerance = 1e-05) expect_equal(xCodeBased$earlyStop, x$earlyStop, tolerance = 1e-05) expect_equal(xCodeBased$successPerStage, x$successPerStage, tolerance = 1e-05) expect_equal(xCodeBased$selectedArms, x$selectedArms, tolerance = 1e-05) expect_equal(xCodeBased$numberOfActiveArms, x$numberOfActiveArms, tolerance = 1e-05) expect_equal(xCodeBased$expectedNumberOfEvents, x$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(xCodeBased$eventsPerStage, x$eventsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$singleNumberOfEventsPerStage, x$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$conditionalPowerAchieved, x$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x), "character") df <- as.data.frame(x) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationMultiArmSurvival': using selectArmsFunction", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmSurvival} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmSurvivalCholeskyTransformation} # @refFS[Formula]{fs:SimulationMultiArmSurvivalCorrMatrix} # @refFS[Formula]{fs:SimulationMultiArmSurvivalEvents} # @refFS[Formula]{fs:SimulationMultiArmSurvivalLogRanks} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} selectArmsFunctionSimulationMultiArmSurvival <- function(effectSizes) { return(c(TRUE, FALSE, FALSE, FALSE)) } x <- getSimulationMultiArmSurvival(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), typeOfShape = "linear", activeArms = 4, plannedEvents = c(10, 30, 50), omegaMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2),directionUpper = FALSE, maxNumberOfIterations = 10, selectArmsFunction = selectArmsFunctionSimulationMultiArmSurvival, typeOfSelection = "userDefined") ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x' with expected results expect_equal(x$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x$iterations[3, ], c(10, 10, 10, 9)) expect_equal(x$rejectAtLeastOne, c(0, 0, 0, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), tolerance = 1e-07) expect_equal(x$futilityStop, c(0, 0, 0, 0)) expect_equal(x$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x$earlyStop[2, ], c(0, 0, 0, 0.1), tolerance = 1e-07) expect_equal(x$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x$successPerStage[2, ], c(0, 0, 0, 0.1), tolerance = 1e-07) expect_equal(x$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x$selectedArms)), c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0.9, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0), tolerance = 1e-07) expect_equal(x$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x$expectedNumberOfEvents, c(50, 50, 50, 48)) expect_equal(unlist(as.list(x$eventsPerStage)), c(5.6153846, 16.846154, 28.076923, 5.2857143, 15.857143, 26.428571, 5, 15, 25, 4.75, 14.25, 23.75, 5.0769231, 15.230769, 25.384615, 4.8571429, 14.571429, 24.285714, 4.6666667, 14, 23.333333, 4.5, 13.5, 22.5, 4.5384615, 13.615385, 22.692308, 4.4285714, 13.285714, 22.142857, 4.3333333, 13, 21.666667, 4.25, 12.75, 21.25, 4, 12, 20, 4, 12, 20, 4, 12, 20, 4, 12, 20), tolerance = 1e-07) expect_equal(unlist(as.list(x$singleNumberOfEventsPerStage)), c(2.5384615, 5.0769231, 5.0769231, 2.4285714, 4.8571429, 4.8571429, 2.3333333, 4.6666667, 4.6666667, 2.25, 4.5, 4.5, 2, 4, 4, 2, 4, 4, 2, 4, 4, 2, 4, 4, 1.4615385, 2.9230769, 2.9230769, 1.5714286, 3.1428571, 3.1428571, 1.6666667, 3.3333333, 3.3333333, 1.75, 3.5, 3.5, 0.92307692, 1.8461538, 1.8461538, 1.1428571, 2.2857143, 2.2857143, 1.3333333, 2.6666667, 2.6666667, 1.5, 3, 3, 3.0769231, 6.1538462, 6.1538462, 2.8571429, 5.7142857, 5.7142857, 2.6666667, 5.3333333, 5.3333333, 2.5, 5, 5), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$conditionalPowerAchieved[2, ], c(0.33564601, 0.59192905, 0.61161484, 0.44432847), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[3, ], c(0.10158651, 0.080642472, 0.3234231, 0.034914809), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x), NA))) expect_output(print(x)$show()) invisible(capture.output(expect_error(summary(x), NA))) expect_output(summary(x)$show()) xCodeBased <- eval(parse(text = getObjectRCode(x, stringWrapParagraphWidth = NULL))) expect_equal(xCodeBased$iterations, x$iterations, tolerance = 1e-05) expect_equal(xCodeBased$rejectAtLeastOne, x$rejectAtLeastOne, tolerance = 1e-05) expect_equal(xCodeBased$rejectedArmsPerStage, x$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$futilityStop, x$futilityStop, tolerance = 1e-05) expect_equal(xCodeBased$futilityPerStage, x$futilityPerStage, tolerance = 1e-05) expect_equal(xCodeBased$earlyStop, x$earlyStop, tolerance = 1e-05) expect_equal(xCodeBased$successPerStage, x$successPerStage, tolerance = 1e-05) expect_equal(xCodeBased$selectedArms, x$selectedArms, tolerance = 1e-05) expect_equal(xCodeBased$numberOfActiveArms, x$numberOfActiveArms, tolerance = 1e-05) expect_equal(xCodeBased$expectedNumberOfEvents, x$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(xCodeBased$eventsPerStage, x$eventsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$singleNumberOfEventsPerStage, x$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$conditionalPowerAchieved, x$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x), "character") df <- as.data.frame(x) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationMultiArmSurvival': typeOfShape = sigmoidEmax", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmSurvival} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmSurvivalCholeskyTransformation} # @refFS[Formula]{fs:SimulationMultiArmSurvivalCorrMatrix} # @refFS[Formula]{fs:SimulationMultiArmSurvivalEvents} # @refFS[Formula]{fs:SimulationMultiArmSurvivalLogRanks} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} designIN <- getDesignInverseNormal(typeOfDesign = "P", kMax = 3, futilityBounds = c(0, 0)) x <- getSimulationMultiArmSurvival(designIN, activeArms = 3, typeOfShape = "sigmoidEmax", omegaMaxVector = seq(1, 1.9, 0.3), gED50 = 2, plannedEvents = cumsum(rep(50, 3)), intersectionTest = "Sidak", typeOfSelection = "rBest", rValue = 2, threshold = -Inf, successCriterion = "all", maxNumberOfIterations = 100, seed = 3456) ## Comparison of the results of SimulationResultsMultiArmSurvival object 'x' with expected results expect_equal(x$iterations[1, ], c(100, 100, 100, 100)) expect_equal(x$iterations[2, ], c(40, 57, 66, 79)) expect_equal(x$iterations[3, ], c(27, 48, 55, 70)) expect_equal(x$rejectAtLeastOne, c(0.02, 0.07, 0.19, 0.21), tolerance = 1e-07) expect_equal(unlist(as.list(x$rejectedArmsPerStage)), c(0, 0, 0, 0.01, 0.01, 0.01, 0.02, 0.01, 0.02, 0, 0.02, 0.02, 0.01, 0, 0, 0, 0.01, 0.02, 0.03, 0.03, 0.01, 0.03, 0.06, 0.01, 0.01, 0, 0, 0.01, 0.01, 0.02, 0.04, 0.03, 0.07, 0.03, 0.09, 0.06), tolerance = 1e-07) expect_equal(x$futilityStop, c(0.73, 0.51, 0.41, 0.24), tolerance = 1e-07) expect_equal(x$futilityPerStage[1, ], c(0.6, 0.43, 0.34, 0.21), tolerance = 1e-07) expect_equal(x$futilityPerStage[2, ], c(0.13, 0.08, 0.07, 0.03), tolerance = 1e-07) expect_equal(x$earlyStop[1, ], c(0.6, 0.43, 0.34, 0.21), tolerance = 1e-07) expect_equal(x$earlyStop[2, ], c(0.13, 0.09, 0.11, 0.09), tolerance = 1e-07) expect_equal(x$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x$successPerStage[2, ], c(0, 0.01, 0.04, 0.06), tolerance = 1e-07) expect_equal(x$successPerStage[3, ], c(0, 0.02, 0.03, 0.05), tolerance = 1e-07) expect_equal(unlist(as.list(x$selectedArms)), c(1, 0.3, 0.2, 1, 0.31, 0.28, 1, 0.42, 0.37, 1, 0.35, 0.32, 1, 0.26, 0.19, 1, 0.45, 0.36, 1, 0.38, 0.31, 1, 0.59, 0.52, 1, 0.24, 0.15, 1, 0.38, 0.32, 1, 0.52, 0.42, 1, 0.64, 0.56), tolerance = 1e-07) expect_equal(x$numberOfActiveArms[1, ], c(3, 3, 3, 3)) expect_equal(x$numberOfActiveArms[2, ], c(2, 2, 2, 2)) expect_equal(x$numberOfActiveArms[3, ], c(2, 2, 2, 2)) expect_equal(x$expectedNumberOfEvents, c(83.5, 102.5, 110.5, 124.5), tolerance = 1e-07) expect_equal(unlist(as.list(x$eventsPerStage)), c(25, 50, 75, 23.702032, 47.404063, 71.106095, 22.633745, 45.26749, 67.901235, 21.73913, 43.478261, 65.217391, 25, 50, 75, 24.266366, 48.532731, 72.799097, 23.662551, 47.325103, 70.987654, 23.1569, 46.3138, 69.470699, 25, 50, 75, 24.604966, 49.209932, 73.814898, 24.279835, 48.559671, 72.839506, 24.007561, 48.015123, 72.022684), tolerance = 1e-07) expect_equal(unlist(as.list(x$singleNumberOfEventsPerStage)), c(12.5, 12.5, 12.5, 12.41535, 12.41535, 12.41535, 12.345679, 12.345679, 12.345679, 12.287335, 12.287335, 12.287335, 12.5, 12.5, 12.5, 12.979684, 12.979684, 12.979684, 13.374486, 13.374486, 13.374486, 13.705104, 13.705104, 13.705104, 12.5, 12.5, 12.5, 13.318284, 13.318284, 13.318284, 13.99177, 13.99177, 13.99177, 14.555766, 14.555766, 14.555766, 12.5, 12.5, 12.5, 11.286682, 11.286682, 11.286682, 10.288066, 10.288066, 10.288066, 9.4517958, 9.4517958, 9.4517958), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$conditionalPowerAchieved[2, ], c(0.066083689, 0.14406787, 0.27240426, 0.24161087), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[3, ], c(0.13321164, 0.19096794, 0.29528894, 0.30979546), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x), NA))) expect_output(print(x)$show()) invisible(capture.output(expect_error(summary(x), NA))) expect_output(summary(x)$show()) xCodeBased <- eval(parse(text = getObjectRCode(x, stringWrapParagraphWidth = NULL))) expect_equal(xCodeBased$iterations, x$iterations, tolerance = 1e-05) expect_equal(xCodeBased$rejectAtLeastOne, x$rejectAtLeastOne, tolerance = 1e-05) expect_equal(xCodeBased$rejectedArmsPerStage, x$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$futilityStop, x$futilityStop, tolerance = 1e-05) expect_equal(xCodeBased$futilityPerStage, x$futilityPerStage, tolerance = 1e-05) expect_equal(xCodeBased$earlyStop, x$earlyStop, tolerance = 1e-05) expect_equal(xCodeBased$successPerStage, x$successPerStage, tolerance = 1e-05) expect_equal(xCodeBased$selectedArms, x$selectedArms, tolerance = 1e-05) expect_equal(xCodeBased$numberOfActiveArms, x$numberOfActiveArms, tolerance = 1e-05) expect_equal(xCodeBased$expectedNumberOfEvents, x$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(xCodeBased$eventsPerStage, x$eventsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$singleNumberOfEventsPerStage, x$singleNumberOfEventsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$conditionalPowerAchieved, x$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x), "character") df <- as.data.frame(x) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationMultiArmSurvival': comparison of base and multi-arm, inverse normal design", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmSurvival} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmSurvivalCholeskyTransformation} # @refFS[Formula]{fs:SimulationMultiArmSurvivalCorrMatrix} # @refFS[Formula]{fs:SimulationMultiArmSurvivalEvents} # @refFS[Formula]{fs:SimulationMultiArmSurvivalLogRanks} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} allocationRatioPlanned <- 1 design <- getDesignInverseNormal(typeOfDesign = "WT", deltaWT = 0.05, futilityBounds = c(-0.5,0.5), informationRates = c(0.2, 0.8, 1)) x <- getSimulationMultiArmSurvival(design, activeArms = 1, omegaMaxVector = 1/seq(1, 1.8, 0.4), plannedEvents = c(20, 40, 60), conditionalPower = 0.99, maxNumberOfEventsPerStage = c(NA, 100, 100), minNumberOfEventsPerStage = c(NA, 10, 10), #thetaH1 = 2, maxNumberOfIterations = 100, directionUpper = FALSE, allocationRatioPlanned = allocationRatioPlanned, seed = 1234) y <- getSimulationSurvival(design, pi2 = 0.2, hazardRatio = 1/seq(1, 1.8, 0.4), plannedEvents = c(20, 40, 60), maxNumberOfSubjects = 500, conditionalPower = 0.99, maxNumberOfEventsPerStage = c(NA, 100, 100), minNumberOfEventsPerStage = c(NA, 10, 10), #thetaH1 = 2, maxNumberOfIterations = 100, directionUpper = FALSE, allocation1 = 1, allocation2 = 1, seed = 1234) comp1 <- y$overallReject - x$rejectAtLeastOne ## Comparison of the results of numeric object 'comp1' with expected results expect_equal(comp1, c(-0.02, 0.01, 0.06), tolerance = 1e-07) comp2 <- y$rejectPerStage - x$rejectedArmsPerStage[, , 1] ## Comparison of the results of matrixarray object 'comp2' with expected results expect_equal(comp2[1, ], c(0, 0, 0)) expect_equal(comp2[2, ], c(-0.02, 0.02, 0.03), tolerance = 1e-07) expect_equal(comp2[3, ], c(0, -0.01, 0.03), tolerance = 1e-07) comp3 <- y$futilityPerStage - x$futilityPerStage ## Comparison of the results of matrixarray object 'comp3' with expected results expect_equal(comp3[1, ], c(-0.06, -0.02, -0.03), tolerance = 1e-07) expect_equal(comp3[2, ], c(0.08, 0.06, 0), tolerance = 1e-07) comp4 <- round(y$eventsPerStage - x$eventsPerStage[, , 1], 1) ## Comparison of the results of matrixarray object 'comp4' with expected results expect_equal(comp4[1, ], c(0, 0, 0)) expect_equal(comp4[2, ], c(1.2, -0.4, 1), tolerance = 1e-07) expect_equal(comp4[3, ], c(1.7, -0.8, 1), tolerance = 1e-07) comp5 <- round(y$expectedNumberOfEvents - x$expectedNumberOfEvents, 1) ## Comparison of the results of numeric object 'comp5' with expected results expect_equal(comp5, c(6.9, -4.7, 3.6), tolerance = 1e-07) comp6 <- x$earlyStop - y$earlyStop ## Comparison of the results of matrixarray object 'comp6' with expected results expect_equal(comp6[1, ], c(-0.43, -0.73, -0.52), tolerance = 1e-07) expect_equal(comp6[2, ], c(-0.13, -0.32, -0.04), tolerance = 1e-07) }) test_that("'getSimulationMultiArmSurvival': comparison of base and multi-arm, Fisher design", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmSurvival} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmSurvivalCholeskyTransformation} # @refFS[Formula]{fs:SimulationMultiArmSurvivalCorrMatrix} # @refFS[Formula]{fs:SimulationMultiArmSurvivalEvents} # @refFS[Formula]{fs:SimulationMultiArmSurvivalLogRanks} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} allocationRatioPlanned <- 1 design <- getDesignFisher(alpha0Vec = c(0.6, 0.4), informationRates = c(0.5, 0.6, 1)) x <- getSimulationMultiArmSurvival(design, activeArms = 1, omegaMaxVector = 1/seq(1, 1.8, 0.4), plannedEvents = c(20, 40, 60), conditionalPower = 0.99, maxNumberOfEventsPerStage = c(NA, 100, 100), minNumberOfEventsPerStage = c(NA, 10, 10), #thetaH1 = 2, maxNumberOfIterations = 100, directionUpper = FALSE, allocationRatioPlanned = allocationRatioPlanned, seed = 1234) y <- getSimulationSurvival(design, pi2 = 0.2, hazardRatio = 1/seq(1, 1.8, 0.4), plannedEvents = c(20, 40, 60), maxNumberOfSubjects = 500, conditionalPower = 0.99, maxNumberOfEventsPerStage = c(NA, 100, 100), minNumberOfEventsPerStage = c(NA, 10, 10), #thetaH1 = 2, maxNumberOfIterations = 100, directionUpper = FALSE, allocation1 = 1, allocation2 = 1, seed = 1234) comp1 <- y$overallReject - x$rejectAtLeastOne ## Comparison of the results of numeric object 'comp1' with expected results expect_equal(comp1, c(-0.02, -0.01, 0.02), tolerance = 1e-07) comp2 <- y$rejectPerStage - x$rejectedArmsPerStage[, , 1] ## Comparison of the results of matrixarray object 'comp2' with expected results expect_equal(comp2[1, ], c(-0.02, 0.01, -0.01), tolerance = 1e-07) expect_equal(comp2[2, ], c(0, -0.03, 0.01), tolerance = 1e-07) expect_equal(comp2[3, ], c(0, 0.01, 0.02), tolerance = 1e-07) comp3 <- y$futilityPerStage - x$futilityPerStage ## Comparison of the results of matrixarray object 'comp3' with expected results expect_equal(comp3[1, ], c(-0.03, 0.01, -0.01), tolerance = 1e-07) expect_equal(comp3[2, ], c(0.05, 0.05, -0.01), tolerance = 1e-07) comp4 <- round(y$eventsPerStage - x$eventsPerStage[, , 1], 1) ## Comparison of the results of matrixarray object 'comp4' with expected results expect_equal(comp4[1, ], c(0, 0, 0)) expect_equal(comp4[2, ], c(-0.6, 0.8, -0.3), tolerance = 1e-07) expect_equal(comp4[3, ], c(-0.6, 0.8, -0.3), tolerance = 1e-07) comp5 <- round(y$expectedNumberOfEvents - x$expectedNumberOfEvents, 1) ## Comparison of the results of numeric object 'comp5' with expected results expect_equal(comp5, c(4.7, -5.3, 3.6), tolerance = 1e-07) comp6 <- x$earlyStop - y$earlyStop ## Comparison of the results of matrixarray object 'comp6' with expected results expect_equal(comp6[1, ], c(-0.27, -0.42, -0.29), tolerance = 1e-07) expect_equal(comp6[2, ], c(-0.22, -0.54, -0.18), tolerance = 1e-07) }) test_that("'getSimulationMultiArmSurvival': comparison of base and multi-arm, inverse normal design with user alpha spending", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmSurvival} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmSurvivalCholeskyTransformation} # @refFS[Formula]{fs:SimulationMultiArmSurvivalCorrMatrix} # @refFS[Formula]{fs:SimulationMultiArmSurvivalEvents} # @refFS[Formula]{fs:SimulationMultiArmSurvivalLogRanks} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} allocationRatioPlanned <- 1 design <- getDesignInverseNormal(typeOfDesign = "asUser", userAlphaSpending = c(0,0,0.025), informationRates = c(0.2, 0.8, 1)) x <- getSimulationMultiArmSurvival(design, activeArms = 1, omegaMaxVector = 1/seq(1, 1.8, 0.4), plannedEvents = c(20, 40, 60), conditionalPower = 0.99, maxNumberOfEventsPerStage = c(NA, 100, 100), minNumberOfEventsPerStage = c(NA, 10, 10), #thetaH1 = 2, maxNumberOfIterations = 100, directionUpper = FALSE, allocationRatioPlanned = allocationRatioPlanned, seed = 1234) y <- getSimulationSurvival(design, pi2 = 0.2, hazardRatio = 1/seq(1, 1.8, 0.4), plannedEvents = c(20, 40, 60), maxNumberOfSubjects = 500, conditionalPower = 0.99, maxNumberOfEventsPerStage = c(NA, 100, 100), minNumberOfEventsPerStage = c(NA, 10, 10), #thetaH1 = 2, maxNumberOfIterations = 100, directionUpper = FALSE, allocation1 = 1, allocation2 = 1, seed = 1234) comp1 <- y$overallReject - x$rejectAtLeastOne ## Comparison of the results of numeric object 'comp1' with expected results expect_equal(comp1, c(-0.01, 0.02, 0.01), tolerance = 1e-07) comp2 <- y$rejectPerStage - x$rejectedArmsPerStage[, , 1] ## Comparison of the results of matrixarray object 'comp2' with expected results expect_equal(comp2[1, ], c(0, 0, 0)) expect_equal(comp2[2, ], c(0, 0, 0)) expect_equal(comp2[3, ], c(-0.01, 0.02, 0.01), tolerance = 1e-07) comp3 <- y$futilityPerStage - x$futilityPerStage ## Comparison of the results of matrixarray object 'comp3' with expected results expect_equal(comp3[1, ], c(0, 0, 0)) expect_equal(comp3[2, ], c(0, 0, 0)) comp4 <- round(y$eventsPerStage - x$eventsPerStage[, , 1], 1) ## Comparison of the results of matrixarray object 'comp4' with expected results expect_equal(comp4[1, ], c(0, 0, 0)) expect_equal(comp4[2, ], c(0, 0, 0)) expect_equal(comp4[3, ], c(-0.2, -3.5, 0.6), tolerance = 1e-07) comp5 <- round(y$expectedNumberOfEvents - x$expectedNumberOfEvents, 1) ## Comparison of the results of numeric object 'comp5' with expected results expect_equal(comp5, c(-0.2, -3.5, 0.6), tolerance = 1e-07) comp6 <- x$earlyStop - y$earlyStop ## Comparison of the results of matrixarray object 'comp6' with expected results expect_equal(comp6[1, ], c(0, 0, 0)) expect_equal(comp6[2, ], c(0, 0, 0)) }) rpact/tests/testthat/test-f_analysis_multiarm_means.R0000644000175000017500000007606414154142422023060 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_analysis_multiarm_means.R ## | Creation date: 08 December 2021, 09:06:01 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing the Analysis Means Functionality for Three or More Treatments") test_that("'getAnalysisResultsMultiArm' with dataset of means", { design1 <- getDesignInverseNormal(kMax = 4, alpha = 0.02, futilityBounds = c(-0.5,0,0.5), bindingFutility = FALSE, typeOfDesign = "asKD", gammaA = 1.2, informationRates = c(0.15,0.4,0.7,1)) design2 <- getDesignFisher(kMax = 4, alpha = 0.02, alpha0Vec = c(0.7,0.5,0.3), method = "equalAlpha", bindingFutility = TRUE, informationRates = c(0.15,0.4,0.7,1)) design3 <- getDesignConditionalDunnett(alpha = 0.02, informationAtInterim = 0.4, secondStageConditioning = TRUE) # directionUpper = TRUE dataExample1 <- getDataset( n1 = c(13, 25), n2 = c(15, NA), n3 = c(14, 27), n4 = c(12, 29), means1 = c(24.2, 22.2), means2 = c(18.8, NA), means3 = c(26.7, 27.7), means4 = c(9.2, 12.2), stDevs1 = c(24.4, 22.1), stDevs2 = c(21.2, NA), stDevs3 = c(25.6, 23.2), stDevs4 = c(21.5, 22.7)) # directionUpper = FALSE dataExample2 <- getDataset( n1 = c(13, 25), n2 = c(15, NA), n3 = c(14, 27), n4 = c(12, 29), means1 = -c(24.2, 22.2), means2 = -c(18.8, NA), means3 = -c(26.7, 27.7), means4 = -c(9.2, 12.2), stDevs1 = c(24.4, 22.1), stDevs2 = c(21.2, NA), stDevs3 = c(25.6, 23.2), stDevs4 = c(21.5, 22.7)) # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} results1 <- getAnalysisResults(design = design1, dataInput = dataExample1, intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results1' with expected results expect_equal(results1$thetaH1[1, ], 11.562259, tolerance = 1e-05) expect_equal(results1$thetaH1[2, ], NA_real_) expect_equal(results1$thetaH1[3, ], 16.036585, tolerance = 1e-05) expect_equal(results1$assumedStDevs[1, ], 22.357668, tolerance = 1e-05) expect_equal(results1$assumedStDevs[2, ], NA_real_) expect_equal(results1$assumedStDevs[3, ], 22.943518, tolerance = 1e-05) expect_equal(results1$conditionalRejectionProbabilities[1, ], c(0.04074021, 0.14372404, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$conditionalRejectionProbabilities[2, ], c(0.033856263, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$conditionalRejectionProbabilities[3, ], c(0.049414261, 0.33374326, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42712247, 0.6790579), tolerance = 1e-05) expect_equal(results1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(results1$conditionalPower[3, ], c(NA_real_, NA_real_, 0.82244694, 0.94484021), tolerance = 1e-05) expect_equal(results1$repeatedConfidenceIntervalLowerBounds[1, ], c(-16.567569, -4.6627981, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.940706, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedConfidenceIntervalLowerBounds[3, ], c(-13.521691, 0.049006945, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedConfidenceIntervalUpperBounds[1, ], c(46.567569, 28.528695, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedConfidenceIntervalUpperBounds[2, ], c(40.140706, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedConfidenceIntervalUpperBounds[3, ], c(48.521691, 32.491814, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedPValues[1, ], c(0.5, 0.08542716, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedPValues[3, ], c(0.5, 0.017966281, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results1), NA))) expect_output(print(results1)$show()) invisible(capture.output(expect_error(summary(results1), NA))) expect_output(summary(results1)$show()) results1CodeBased <- eval(parse(text = getObjectRCode(results1, stringWrapParagraphWidth = NULL))) expect_equal(results1CodeBased$thetaH1, results1$thetaH1, tolerance = 1e-05) expect_equal(results1CodeBased$assumedStDevs, results1$assumedStDevs, tolerance = 1e-05) expect_equal(results1CodeBased$conditionalRejectionProbabilities, results1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results1CodeBased$conditionalPower, results1$conditionalPower, tolerance = 1e-05) expect_equal(results1CodeBased$repeatedConfidenceIntervalLowerBounds, results1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results1CodeBased$repeatedConfidenceIntervalUpperBounds, results1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results1CodeBased$repeatedPValues, results1$repeatedPValues, tolerance = 1e-05) expect_type(names(results1), "character") df <- as.data.frame(results1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} results2 <- getAnalysisResults(design = design2, dataInput = dataExample1, intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results2' with expected results expect_equal(results2$thetaH1[1, ], 11.562259, tolerance = 1e-05) expect_equal(results2$thetaH1[2, ], NA_real_) expect_equal(results2$thetaH1[3, ], 16.036585, tolerance = 1e-05) expect_equal(results2$assumedStDevs[1, ], 22.357668, tolerance = 1e-05) expect_equal(results2$assumedStDevs[2, ], NA_real_) expect_equal(results2$assumedStDevs[3, ], 22.943518, tolerance = 1e-05) expect_equal(results2$conditionalRejectionProbabilities[1, ], c(0.024748593, 0.053966892, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$conditionalRejectionProbabilities[2, ], c(0.021915713, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$conditionalRejectionProbabilities[3, ], c(0.0267758, 1, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.38015, -4.0770639, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedConfidenceIntervalLowerBounds[2, ], c(-13.116502, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedConfidenceIntervalLowerBounds[3, ], c(-8.2525514, 0.41959343, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedConfidenceIntervalUpperBounds[1, ], c(40.38015, 26.720108, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedConfidenceIntervalUpperBounds[2, ], c(32.316502, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedConfidenceIntervalUpperBounds[3, ], c(43.252551, 31.62149, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedPValues[1, ], c(0.17335289, 0.062127989, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedPValues[2, ], c(0.20285189, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedPValues[3, ], c(0.15638134, 0.015781417, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.277, 0.453), tolerance = 1e-05) expect_equal(results2$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(results2$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results2), NA))) expect_output(print(results2)$show()) invisible(capture.output(expect_error(summary(results2), NA))) expect_output(summary(results2)$show()) results2CodeBased <- eval(parse(text = getObjectRCode(results2, stringWrapParagraphWidth = NULL))) expect_equal(results2CodeBased$thetaH1, results2$thetaH1, tolerance = 1e-05) expect_equal(results2CodeBased$assumedStDevs, results2$assumedStDevs, tolerance = 1e-05) expect_equal(results2CodeBased$conditionalRejectionProbabilities, results2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results2CodeBased$repeatedConfidenceIntervalLowerBounds, results2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results2CodeBased$repeatedConfidenceIntervalUpperBounds, results2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results2CodeBased$repeatedPValues, results2$repeatedPValues, tolerance = 1e-05) expect_equal(results2CodeBased$conditionalPowerSimulated, results2$conditionalPowerSimulated, tolerance = 1e-05) expect_type(names(results2), "character") df <- as.data.frame(results2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} results3 <- getAnalysisResults(design = design3, dataInput = dataExample1, intersectionTest = "Dunnett", varianceOption = "overallPooled", normalApproximation = TRUE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsConditionalDunnett object 'results3' with expected results expect_equal(results3$thetaH1[1, ], 11.562259, tolerance = 3e-04) expect_equal(results3$thetaH1[2, ], NA_real_) expect_equal(results3$thetaH1[3, ], 16.036585, tolerance = 3e-04) expect_equal(results3$assumedStDevs[1, ], 22.357668, tolerance = 3e-04) expect_equal(results3$assumedStDevs[2, ], NA_real_) expect_equal(results3$assumedStDevs[3, ], 22.943518, tolerance = 3e-04) expect_equal(results3$conditionalRejectionProbabilities[1, ], c(NA_real_, 0.061352393), tolerance = 3e-04) expect_equal(results3$conditionalRejectionProbabilities[2, ], c(NA_real_, 0.037447419), tolerance = 3e-04) expect_equal(results3$conditionalRejectionProbabilities[3, ], c(NA_real_, 0.08651207), tolerance = 3e-04) expect_equal(results3$conditionalPower[1, ], c(NA_real_, NA_real_)) expect_equal(results3$conditionalPower[2, ], c(NA_real_, NA_real_)) expect_equal(results3$conditionalPower[3, ], c(NA_real_, NA_real_)) expect_equal(results3$repeatedConfidenceIntervalLowerBounds[1, ], c(NA_real_, -0.72440621), tolerance = 3e-04) expect_equal(results3$repeatedConfidenceIntervalLowerBounds[2, ], c(NA_real_, NA_real_)) expect_equal(results3$repeatedConfidenceIntervalLowerBounds[3, ], c(NA_real_, 3.9389233), tolerance = 3e-04) expect_equal(results3$repeatedConfidenceIntervalUpperBounds[1, ], c(NA_real_, 22.538721), tolerance = 3e-04) expect_equal(results3$repeatedConfidenceIntervalUpperBounds[2, ], c(NA_real_, NA_real_)) expect_equal(results3$repeatedConfidenceIntervalUpperBounds[3, ], c(NA_real_, 26.753524), tolerance = 3e-04) expect_equal(results3$repeatedPValues[1, ], c(NA_real_, 0.017445576), tolerance = 3e-04) expect_equal(results3$repeatedPValues[2, ], c(NA_real_, NA_real_)) expect_equal(results3$repeatedPValues[3, ], c(NA_real_, 0.0019493527), tolerance = 3e-04) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results3), NA))) expect_output(print(results3)$show()) invisible(capture.output(expect_error(summary(results3), NA))) expect_output(summary(results3)$show()) results3CodeBased <- eval(parse(text = getObjectRCode(results3, stringWrapParagraphWidth = NULL))) expect_equal(results3CodeBased$thetaH1, results3$thetaH1, tolerance = 1e-05) expect_equal(results3CodeBased$assumedStDevs, results3$assumedStDevs, tolerance = 1e-05) expect_equal(results3CodeBased$conditionalRejectionProbabilities, results3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results3CodeBased$conditionalPower, results3$conditionalPower, tolerance = 1e-05) expect_equal(results3CodeBased$repeatedConfidenceIntervalLowerBounds, results3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results3CodeBased$repeatedConfidenceIntervalUpperBounds, results3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results3CodeBased$repeatedPValues, results3$repeatedPValues, tolerance = 1e-05) expect_type(names(results3), "character") df <- as.data.frame(results3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} results4 <- getAnalysisResults(design = design1, dataInput = dataExample2, intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results4' with expected results expect_equal(results4$thetaH1[1, ], -11.562259, tolerance = 1e-05) expect_equal(results4$thetaH1[2, ], NA_real_) expect_equal(results4$thetaH1[3, ], -16.036585, tolerance = 1e-05) expect_equal(results4$assumedStDevs[1, ], 22.357668, tolerance = 1e-05) expect_equal(results4$assumedStDevs[2, ], NA_real_) expect_equal(results4$assumedStDevs[3, ], 22.943518, tolerance = 1e-05) expect_equal(results4$conditionalRejectionProbabilities[1, ], c(0.042394596, 0.15198144, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$conditionalRejectionProbabilities[3, ], c(0.049947129, 0.35588619, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$conditionalPower[1, ], c(NA_real_, NA_real_, 0.44302928, 0.69082025), tolerance = 1e-05) expect_equal(results4$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(results4$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83889182, 0.95069292), tolerance = 1e-05) expect_equal(results4$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.802158, -28.113845, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedConfidenceIntervalLowerBounds[2, ], c(-38.432721, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedConfidenceIntervalLowerBounds[3, ], c(-46.786808, -32.10754, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedConfidenceIntervalUpperBounds[1, ], c(14.802158, 4.2854678, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedConfidenceIntervalUpperBounds[2, ], c(19.232721, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedConfidenceIntervalUpperBounds[3, ], c(11.786808, -0.41764222, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedPValues[1, ], c(0.5, 0.078823932, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedPValues[3, ], c(0.5, 0.015272156, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results4), NA))) expect_output(print(results4)$show()) invisible(capture.output(expect_error(summary(results4), NA))) expect_output(summary(results4)$show()) results4CodeBased <- eval(parse(text = getObjectRCode(results4, stringWrapParagraphWidth = NULL))) expect_equal(results4CodeBased$thetaH1, results4$thetaH1, tolerance = 1e-05) expect_equal(results4CodeBased$assumedStDevs, results4$assumedStDevs, tolerance = 1e-05) expect_equal(results4CodeBased$conditionalRejectionProbabilities, results4$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results4CodeBased$conditionalPower, results4$conditionalPower, tolerance = 1e-05) expect_equal(results4CodeBased$repeatedConfidenceIntervalLowerBounds, results4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results4CodeBased$repeatedConfidenceIntervalUpperBounds, results4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results4CodeBased$repeatedPValues, results4$repeatedPValues, tolerance = 1e-05) expect_type(names(results4), "character") df <- as.data.frame(results4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} results5 <- getAnalysisResults(design = design2, dataInput = dataExample2, intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results5' with expected results expect_equal(results5$thetaH1[1, ], -11.562259, tolerance = 1e-05) expect_equal(results5$thetaH1[2, ], NA_real_) expect_equal(results5$thetaH1[3, ], -16.036585, tolerance = 1e-05) expect_equal(results5$assumedStDevs[1, ], 22.357668, tolerance = 1e-05) expect_equal(results5$assumedStDevs[2, ], NA_real_) expect_equal(results5$assumedStDevs[3, ], 22.943518, tolerance = 1e-05) expect_equal(results5$conditionalRejectionProbabilities[1, ], c(0.02248882, 0.047009108, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results5$conditionalRejectionProbabilities[2, ], c(0.021309255, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results5$conditionalRejectionProbabilities[3, ], c(0.027044989, 1, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results5$repeatedConfidenceIntervalLowerBounds[1, ], c(-42.972232, -27.481288, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results5$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.436237, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results5$repeatedConfidenceIntervalLowerBounds[3, ], c(-45.763994, -32.295837, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results5$repeatedConfidenceIntervalUpperBounds[1, ], c(12.972232, 4.7692163, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results5$repeatedConfidenceIntervalUpperBounds[2, ], c(15.236237, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results5$repeatedConfidenceIntervalUpperBounds[3, ], c(10.763995, 0.22335705, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results5$repeatedPValues[1, ], c(0.19623626, 0.071653269, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results5$repeatedPValues[2, ], c(0.21026955, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results5$repeatedPValues[3, ], c(0.15433667, 0.019180306, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results5$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.431), tolerance = 1e-05) expect_equal(results5$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(results5$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results5), NA))) expect_output(print(results5)$show()) invisible(capture.output(expect_error(summary(results5), NA))) expect_output(summary(results5)$show()) results5CodeBased <- eval(parse(text = getObjectRCode(results5, stringWrapParagraphWidth = NULL))) expect_equal(results5CodeBased$thetaH1, results5$thetaH1, tolerance = 1e-05) expect_equal(results5CodeBased$assumedStDevs, results5$assumedStDevs, tolerance = 1e-05) expect_equal(results5CodeBased$conditionalRejectionProbabilities, results5$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results5CodeBased$repeatedConfidenceIntervalLowerBounds, results5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results5CodeBased$repeatedConfidenceIntervalUpperBounds, results5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results5CodeBased$repeatedPValues, results5$repeatedPValues, tolerance = 1e-05) expect_equal(results5CodeBased$conditionalPowerSimulated, results5$conditionalPowerSimulated, tolerance = 1e-05) expect_type(names(results5), "character") df <- as.data.frame(results5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} results6 <- getAnalysisResults(design = design3, dataInput = dataExample2, intersectionTest = "Dunnett", varianceOption = "overallPooled", normalApproximation = TRUE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsConditionalDunnett object 'results6' with expected results expect_equal(results6$thetaH1[1, ], -11.562259, tolerance = 3e-04) expect_equal(results6$thetaH1[2, ], NA_real_) expect_equal(results6$thetaH1[3, ], -16.036585, tolerance = 3e-04) expect_equal(results6$assumedStDevs[1, ], 22.357668, tolerance = 3e-04) expect_equal(results6$assumedStDevs[2, ], NA_real_) expect_equal(results6$assumedStDevs[3, ], 22.943518, tolerance = 3e-04) expect_equal(results6$conditionalRejectionProbabilities[1, ], c(NA_real_, 0.061352393), tolerance = 3e-04) expect_equal(results6$conditionalRejectionProbabilities[2, ], c(NA_real_, 0.037447419), tolerance = 3e-04) expect_equal(results6$conditionalRejectionProbabilities[3, ], c(NA_real_, 0.08651207), tolerance = 3e-04) expect_equal(results6$conditionalPower[1, ], c(NA_real_, NA_real_)) expect_equal(results6$conditionalPower[2, ], c(NA_real_, NA_real_)) expect_equal(results6$conditionalPower[3, ], c(NA_real_, NA_real_)) expect_equal(results6$repeatedConfidenceIntervalLowerBounds[1, ], c(NA_real_, -22.538721), tolerance = 3e-04) expect_equal(results6$repeatedConfidenceIntervalLowerBounds[2, ], c(NA_real_, NA_real_)) expect_equal(results6$repeatedConfidenceIntervalLowerBounds[3, ], c(NA_real_, -26.753524), tolerance = 3e-04) expect_equal(results6$repeatedConfidenceIntervalUpperBounds[1, ], c(NA_real_, 0.72440621), tolerance = 3e-04) expect_equal(results6$repeatedConfidenceIntervalUpperBounds[2, ], c(NA_real_, NA_real_)) expect_equal(results6$repeatedConfidenceIntervalUpperBounds[3, ], c(NA_real_, -3.9389233), tolerance = 3e-04) expect_equal(results6$repeatedPValues[1, ], c(NA_real_, 0.017445576), tolerance = 3e-04) expect_equal(results6$repeatedPValues[2, ], c(NA_real_, NA_real_)) expect_equal(results6$repeatedPValues[3, ], c(NA_real_, 0.0019493527), tolerance = 3e-04) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results6), NA))) expect_output(print(results6)$show()) invisible(capture.output(expect_error(summary(results6), NA))) expect_output(summary(results6)$show()) results6CodeBased <- eval(parse(text = getObjectRCode(results6, stringWrapParagraphWidth = NULL))) expect_equal(results6CodeBased$thetaH1, results6$thetaH1, tolerance = 1e-05) expect_equal(results6CodeBased$assumedStDevs, results6$assumedStDevs, tolerance = 1e-05) expect_equal(results6CodeBased$conditionalRejectionProbabilities, results6$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results6CodeBased$conditionalPower, results6$conditionalPower, tolerance = 1e-05) expect_equal(results6CodeBased$repeatedConfidenceIntervalLowerBounds, results6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results6CodeBased$repeatedConfidenceIntervalUpperBounds, results6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results6CodeBased$repeatedPValues, results6$repeatedPValues, tolerance = 1e-05) expect_type(names(results6), "character") df <- as.data.frame(results6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) rpact/tests/testthat/test-f_analysis_multiarm_rates.R0000644000175000017500000012631014154142422023061 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_analysis_multiarm_rates.R ## | Creation date: 08 December 2021, 09:06:52 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing the Analysis Rates Functionality for Three or More Treatments") test_that("'getAnalysisResultsMultiArm' with dataset of rates", { design1 <- getDesignInverseNormal(kMax = 4, alpha = 0.02, futilityBounds = c(-0.5,0,0.5), bindingFutility = FALSE, typeOfDesign = "asKD", gammaA = 1.2, informationRates = c(0.15,0.4,0.7,1)) design2 <- getDesignFisher(kMax = 4, alpha = 0.02, alpha0Vec = c(0.7,0.5,0.3), method = "equalAlpha", bindingFutility = TRUE, informationRates = c(0.15,0.4,0.7,1)) design3 <- getDesignConditionalDunnett(alpha = 0.02, informationAtInterim = 0.4, secondStageConditioning = TRUE) # directionUpper = TRUE dataExample1 <- getDataset( n1 = c(23, 25), n2 = c(25, NA), n3 = c(22, 29), events1 = c(15, 12), events2 = c(19, NA), events3 = c(12, 13)) # directionUpper = FALSE dataExample2 <- getDataset( n1 = c(23, 25), n2 = c(25, NA), n3 = c(22, 29), events1 = c(15, 12), events2 = c(19, NA), events3 = c(21, 25)) # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmRates} results1 <- getAnalysisResults(design = design1, dataInput = dataExample1, intersectionTest = "Simes", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results1' with expected results expect_equal(results1$piTreatments[1, ], 0.5625, tolerance = 1e-05) expect_equal(results1$piTreatments[2, ], NA_real_) expect_equal(results1$piControl[1, ], 0.49019608, tolerance = 1e-05) expect_equal(results1$conditionalRejectionProbabilities[1, ], c(0.015420568, 0.003193865, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$conditionalRejectionProbabilities[2, ], c(0.024462749, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.0010766875, 0.011284718), tolerance = 1e-05) expect_equal(results1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(results1$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.32184855, -0.20584893, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.20645626, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedConfidenceIntervalUpperBounds[1, ], c(0.50115862, 0.32866179, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedConfidenceIntervalUpperBounds[2, ], c(0.57764371, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedPValues[1, ], c(0.5, 0.5, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results1$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results1), NA))) expect_output(print(results1)$show()) invisible(capture.output(expect_error(summary(results1), NA))) expect_output(summary(results1)$show()) results1CodeBased <- eval(parse(text = getObjectRCode(results1, stringWrapParagraphWidth = NULL))) expect_equal(results1CodeBased$piTreatments, results1$piTreatments, tolerance = 1e-05) expect_equal(results1CodeBased$piControl, results1$piControl, tolerance = 1e-05) expect_equal(results1CodeBased$conditionalRejectionProbabilities, results1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results1CodeBased$conditionalPower, results1$conditionalPower, tolerance = 1e-05) expect_equal(results1CodeBased$repeatedConfidenceIntervalLowerBounds, results1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results1CodeBased$repeatedConfidenceIntervalUpperBounds, results1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results1CodeBased$repeatedPValues, results1$repeatedPValues, tolerance = 1e-05) expect_type(names(results1), "character") df <- as.data.frame(results1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmRates} results2 <- getAnalysisResults(design = design1, dataInput = dataExample1, intersectionTest = "Dunnett", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results2' with expected results expect_equal(results2$piTreatments[1, ], 0.5625, tolerance = 1e-05) expect_equal(results2$piTreatments[2, ], NA_real_) expect_equal(results2$piControl[1, ], 0.49019608, tolerance = 1e-05) expect_equal(results2$conditionalRejectionProbabilities[1, ], c(0.022712676, 0.0087985229, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$conditionalRejectionProbabilities[2, ], c(0.043097832, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$conditionalPower[1, ], c(NA_real_, NA_real_, 0.004624756, 0.026737358), tolerance = 1e-05) expect_equal(results2$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(results2$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.32069398, -0.20381973, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.20524167, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedConfidenceIntervalUpperBounds[1, ], c(0.50018754, 0.32441792, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedConfidenceIntervalUpperBounds[2, ], c(0.57677218, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedPValues[1, ], c(0.5, 0.5, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results2$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results2), NA))) expect_output(print(results2)$show()) invisible(capture.output(expect_error(summary(results2), NA))) expect_output(summary(results2)$show()) results2CodeBased <- eval(parse(text = getObjectRCode(results2, stringWrapParagraphWidth = NULL))) expect_equal(results2CodeBased$piTreatments, results2$piTreatments, tolerance = 1e-05) expect_equal(results2CodeBased$piControl, results2$piControl, tolerance = 1e-05) expect_equal(results2CodeBased$conditionalRejectionProbabilities, results2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results2CodeBased$conditionalPower, results2$conditionalPower, tolerance = 1e-05) expect_equal(results2CodeBased$repeatedConfidenceIntervalLowerBounds, results2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results2CodeBased$repeatedConfidenceIntervalUpperBounds, results2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results2CodeBased$repeatedPValues, results2$repeatedPValues, tolerance = 1e-05) expect_type(names(results2), "character") df <- as.data.frame(results2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmRates} results3 <- getAnalysisResults(design = design2, dataInput = dataExample1, intersectionTest = "Simes", nPlanned = c(20, 20), seed = 123, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results3' with expected results expect_equal(results3$piTreatments[1, ], 0.5625, tolerance = 1e-05) expect_equal(results3$piTreatments[2, ], NA_real_) expect_equal(results3$piControl[1, ], 0.49019608, tolerance = 1e-05) expect_equal(results3$conditionalRejectionProbabilities[1, ], c(0.011503611, 0, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results3$conditionalRejectionProbabilities[2, ], c(0.015301846, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results3$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.26319109, -0.20678373, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results3$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.14541584, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results3$repeatedConfidenceIntervalUpperBounds[1, ], c(0.45121457, 0.32319296, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results3$repeatedConfidenceIntervalUpperBounds[2, ], c(0.53261778, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results3$repeatedPValues[1, ], c(0.4416362, 0.4416362, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results3$repeatedPValues[2, ], c(0.31730879, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results3$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0, 0)) expect_equal(results3$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results3), NA))) expect_output(print(results3)$show()) invisible(capture.output(expect_error(summary(results3), NA))) expect_output(summary(results3)$show()) results3CodeBased <- eval(parse(text = getObjectRCode(results3, stringWrapParagraphWidth = NULL))) expect_equal(results3CodeBased$piTreatments, results3$piTreatments, tolerance = 1e-05) expect_equal(results3CodeBased$piControl, results3$piControl, tolerance = 1e-05) expect_equal(results3CodeBased$conditionalRejectionProbabilities, results3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results3CodeBased$repeatedConfidenceIntervalLowerBounds, results3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results3CodeBased$repeatedConfidenceIntervalUpperBounds, results3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results3CodeBased$repeatedPValues, results3$repeatedPValues, tolerance = 1e-05) expect_equal(results3CodeBased$conditionalPowerSimulated, results3$conditionalPowerSimulated, tolerance = 1e-05) expect_type(names(results3), "character") df <- as.data.frame(results3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmRates} results4 <- getAnalysisResults(design = design2, dataInput = dataExample1, intersectionTest = "Dunnett", nPlanned = c(20, 20), seed = 123, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results4' with expected results expect_equal(results4$piTreatments[1, ], 0.5625, tolerance = 1e-05) expect_equal(results4$piTreatments[2, ], NA_real_) expect_equal(results4$piControl[1, ], 0.49019608, tolerance = 1e-05) expect_equal(results4$conditionalRejectionProbabilities[1, ], c(0.014541388, 0.0059378141, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$conditionalRejectionProbabilities[2, ], c(0.024268969, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.26076213, -0.20472006, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.14291708, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedConfidenceIntervalUpperBounds[1, ], c(0.44911894, 0.31972469, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedConfidenceIntervalUpperBounds[2, ], c(0.53072029, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedPValues[1, ], c(0.3372539, 0.3372539, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$repeatedPValues[2, ], c(0.17782371, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results4$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.011, 0.018), tolerance = 1e-05) expect_equal(results4$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results4), NA))) expect_output(print(results4)$show()) invisible(capture.output(expect_error(summary(results4), NA))) expect_output(summary(results4)$show()) results4CodeBased <- eval(parse(text = getObjectRCode(results4, stringWrapParagraphWidth = NULL))) expect_equal(results4CodeBased$piTreatments, results4$piTreatments, tolerance = 1e-05) expect_equal(results4CodeBased$piControl, results4$piControl, tolerance = 1e-05) expect_equal(results4CodeBased$conditionalRejectionProbabilities, results4$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results4CodeBased$repeatedConfidenceIntervalLowerBounds, results4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results4CodeBased$repeatedConfidenceIntervalUpperBounds, results4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results4CodeBased$repeatedPValues, results4$repeatedPValues, tolerance = 1e-05) expect_equal(results4CodeBased$conditionalPowerSimulated, results4$conditionalPowerSimulated, tolerance = 1e-05) expect_type(names(results4), "character") df <- as.data.frame(results4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmRates} results5 <- getAnalysisResults(design = design3, dataInput = dataExample1, intersectionTest = "Dunnett", normalApproximation = TRUE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsConditionalDunnett object 'results5' with expected results expect_equal(results5$piTreatments[1, ], 0.5625, tolerance = 1e-05) expect_equal(results5$piTreatments[2, ], NA_real_) expect_equal(results5$piControl[1, ], 0.49019608, tolerance = 1e-05) expect_equal(results5$conditionalRejectionProbabilities[1, ], c(NA_real_, 0.019942093), tolerance = 1e-05) expect_equal(results5$conditionalRejectionProbabilities[2, ], c(NA_real_, 0.049973806), tolerance = 1e-05) expect_equal(results5$conditionalPower[1, ], c(NA_real_, NA_real_)) expect_equal(results5$conditionalPower[2, ], c(NA_real_, NA_real_)) expect_equal(results5$repeatedConfidenceIntervalLowerBounds[1, ], c(NA_real_, -0.10423565), tolerance = 1e-05) expect_equal(results5$repeatedConfidenceIntervalLowerBounds[2, ], c(NA_real_, NA_real_)) expect_equal(results5$repeatedConfidenceIntervalUpperBounds[1, ], c(NA_real_, 0.28064632), tolerance = 1e-05) expect_equal(results5$repeatedConfidenceIntervalUpperBounds[2, ], c(NA_real_, NA_real_)) expect_equal(results5$repeatedPValues[1, ], c(NA_real_, 0.26025152), tolerance = 1e-05) expect_equal(results5$repeatedPValues[2, ], c(NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results5), NA))) expect_output(print(results5)$show()) invisible(capture.output(expect_error(summary(results5), NA))) expect_output(summary(results5)$show()) results5CodeBased <- eval(parse(text = getObjectRCode(results5, stringWrapParagraphWidth = NULL))) expect_equal(results5CodeBased$piTreatments, results5$piTreatments, tolerance = 1e-05) expect_equal(results5CodeBased$piControl, results5$piControl, tolerance = 1e-05) expect_equal(results5CodeBased$conditionalRejectionProbabilities, results5$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results5CodeBased$conditionalPower, results5$conditionalPower, tolerance = 1e-05) expect_equal(results5CodeBased$repeatedConfidenceIntervalLowerBounds, results5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results5CodeBased$repeatedConfidenceIntervalUpperBounds, results5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results5CodeBased$repeatedPValues, results5$repeatedPValues, tolerance = 1e-05) expect_type(names(results5), "character") df <- as.data.frame(results5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmRates} results6 <- getAnalysisResults(design = design1, dataInput = dataExample2, intersectionTest = "Simes", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results6' with expected results expect_equal(results6$piTreatments[1, ], 0.5625, tolerance = 1e-05) expect_equal(results6$piTreatments[2, ], NA_real_) expect_equal(results6$piControl[1, ], 0.90196078, tolerance = 1e-05) expect_equal(results6$conditionalRejectionProbabilities[1, ], c(0.13434137, 0.80112393, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results6$conditionalRejectionProbabilities[2, ], c(0.086909033, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results6$conditionalPower[1, ], c(NA_real_, NA_real_, 0.99558173, 0.99935678), tolerance = 1e-05) expect_equal(results6$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(results6$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.62349631, -0.55900271, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results6$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.51524953, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results6$repeatedConfidenceIntervalUpperBounds[1, ], c(0.080410537, -0.10884678, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results6$repeatedConfidenceIntervalUpperBounds[2, ], c(0.16732347, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results6$repeatedPValues[1, ], c(0.10960848, 0.00033097065, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results6$repeatedPValues[2, ], c(0.30001108, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results6), NA))) expect_output(print(results6)$show()) invisible(capture.output(expect_error(summary(results6), NA))) expect_output(summary(results6)$show()) results6CodeBased <- eval(parse(text = getObjectRCode(results6, stringWrapParagraphWidth = NULL))) expect_equal(results6CodeBased$piTreatments, results6$piTreatments, tolerance = 1e-05) expect_equal(results6CodeBased$piControl, results6$piControl, tolerance = 1e-05) expect_equal(results6CodeBased$conditionalRejectionProbabilities, results6$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results6CodeBased$conditionalPower, results6$conditionalPower, tolerance = 1e-05) expect_equal(results6CodeBased$repeatedConfidenceIntervalLowerBounds, results6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results6CodeBased$repeatedConfidenceIntervalUpperBounds, results6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results6CodeBased$repeatedPValues, results6$repeatedPValues, tolerance = 1e-05) expect_type(names(results6), "character") df <- as.data.frame(results6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmRates} results7 <- getAnalysisResults(design = design1, dataInput = dataExample2, intersectionTest = "Dunnett", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results7' with expected results expect_equal(results7$piTreatments[1, ], 0.5625, tolerance = 1e-05) expect_equal(results7$piTreatments[2, ], NA_real_) expect_equal(results7$piControl[1, ], 0.90196078, tolerance = 1e-05) expect_equal(results7$conditionalRejectionProbabilities[1, ], c(0.13739667, 0.80531488, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results7$conditionalRejectionProbabilities[2, ], c(0.086909033, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results7$conditionalPower[1, ], c(NA_real_, NA_real_, 0.99579217, 0.99938978), tolerance = 1e-05) expect_equal(results7$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(results7$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.62267686, -0.55784932, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results7$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.51432244, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results7$repeatedConfidenceIntervalUpperBounds[1, ], c(0.079006881, -0.11253618, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results7$repeatedConfidenceIntervalUpperBounds[2, ], c(0.1659763, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results7$repeatedPValues[1, ], c(0.10337051, 0.00031285088, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results7$repeatedPValues[2, ], c(0.30001108, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results7), NA))) expect_output(print(results7)$show()) invisible(capture.output(expect_error(summary(results7), NA))) expect_output(summary(results7)$show()) results7CodeBased <- eval(parse(text = getObjectRCode(results7, stringWrapParagraphWidth = NULL))) expect_equal(results7CodeBased$piTreatments, results7$piTreatments, tolerance = 1e-05) expect_equal(results7CodeBased$piControl, results7$piControl, tolerance = 1e-05) expect_equal(results7CodeBased$conditionalRejectionProbabilities, results7$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results7CodeBased$conditionalPower, results7$conditionalPower, tolerance = 1e-05) expect_equal(results7CodeBased$repeatedConfidenceIntervalLowerBounds, results7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results7CodeBased$repeatedConfidenceIntervalUpperBounds, results7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results7CodeBased$repeatedPValues, results7$repeatedPValues, tolerance = 1e-05) expect_type(names(results7), "character") df <- as.data.frame(results7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmRates} results8 <- getAnalysisResults(design = design2, dataInput = dataExample2, intersectionTest = "Simes", nPlanned = c(20, 20), seed = 123, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results8' with expected results expect_equal(results8$piTreatments[1, ], 0.5625, tolerance = 1e-05) expect_equal(results8$piTreatments[2, ], NA_real_) expect_equal(results8$piControl[1, ], 0.90196078, tolerance = 1e-05) expect_equal(results8$conditionalRejectionProbabilities[1, ], c(0.10173644, 1, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results8$conditionalRejectionProbabilities[2, ], c(0.053203298, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results8$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.58125932, -0.55861966, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results8$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.46821261, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results8$repeatedConfidenceIntervalUpperBounds[1, ], c(0.011590857, -0.11157179, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results8$repeatedConfidenceIntervalUpperBounds[2, ], c(0.10089066, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results8$repeatedPValues[1, ], c(0.024755475, 0.00046257745, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results8$repeatedPValues[2, ], c(0.061679763, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results8$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 1, 1)) expect_equal(results8$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results8), NA))) expect_output(print(results8)$show()) invisible(capture.output(expect_error(summary(results8), NA))) expect_output(summary(results8)$show()) results8CodeBased <- eval(parse(text = getObjectRCode(results8, stringWrapParagraphWidth = NULL))) expect_equal(results8CodeBased$piTreatments, results8$piTreatments, tolerance = 1e-05) expect_equal(results8CodeBased$piControl, results8$piControl, tolerance = 1e-05) expect_equal(results8CodeBased$conditionalRejectionProbabilities, results8$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results8CodeBased$repeatedConfidenceIntervalLowerBounds, results8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results8CodeBased$repeatedConfidenceIntervalUpperBounds, results8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results8CodeBased$repeatedPValues, results8$repeatedPValues, tolerance = 1e-05) expect_equal(results8CodeBased$conditionalPowerSimulated, results8$conditionalPowerSimulated, tolerance = 1e-05) expect_type(names(results8), "character") df <- as.data.frame(results8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmRates} results9 <- getAnalysisResults(design = design2, dataInput = dataExample2, intersectionTest = "Dunnett", nPlanned = c(20, 20), seed = 123, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results9' with expected results expect_equal(results9$piTreatments[1, ], 0.5625, tolerance = 1e-05) expect_equal(results9$piTreatments[2, ], NA_real_) expect_equal(results9$piControl[1, ], 0.90196078, tolerance = 1e-05) expect_equal(results9$conditionalRejectionProbabilities[1, ], c(0.10565624, 1, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results9$conditionalRejectionProbabilities[2, ], c(0.053203298, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results9$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.57948552, -0.55733034, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results9$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.4662704, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results9$repeatedConfidenceIntervalUpperBounds[1, ], c(0.0088609184, -0.11474637, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results9$repeatedConfidenceIntervalUpperBounds[2, ], c(0.098238963, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results9$repeatedPValues[1, ], c(0.023456573, 0.000443504, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results9$repeatedPValues[2, ], c(0.061679763, NA_real_, NA_real_, NA_real_), tolerance = 1e-05) expect_equal(results9$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 1, 1)) expect_equal(results9$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results9), NA))) expect_output(print(results9)$show()) invisible(capture.output(expect_error(summary(results9), NA))) expect_output(summary(results9)$show()) results9CodeBased <- eval(parse(text = getObjectRCode(results9, stringWrapParagraphWidth = NULL))) expect_equal(results9CodeBased$piTreatments, results9$piTreatments, tolerance = 1e-05) expect_equal(results9CodeBased$piControl, results9$piControl, tolerance = 1e-05) expect_equal(results9CodeBased$conditionalRejectionProbabilities, results9$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results9CodeBased$repeatedConfidenceIntervalLowerBounds, results9$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results9CodeBased$repeatedConfidenceIntervalUpperBounds, results9$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results9CodeBased$repeatedPValues, results9$repeatedPValues, tolerance = 1e-05) expect_equal(results9CodeBased$conditionalPowerSimulated, results9$conditionalPowerSimulated, tolerance = 1e-05) expect_type(names(results9), "character") df <- as.data.frame(results9) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results9) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} # @refFS[Formula]{fs:conditionalPowerMultiArm} # @refFS[Formula]{fs:conditionalRejectionProbability} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} # @refFS[Formula]{fs:adjustedPValueForRCISidak} # @refFS[Formula]{fs:computeRCIsMultiArm} # @refFS[Formula]{fs:testStatisticMultiArmRates} results10 <- getAnalysisResults(design = design3, dataInput = dataExample2, intersectionTest = "Dunnett", normalApproximation = TRUE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsConditionalDunnett object 'results10' with expected results expect_equal(results10$piTreatments[1, ], 0.5625, tolerance = 1e-05) expect_equal(results10$piTreatments[2, ], NA_real_) expect_equal(results10$piControl[1, ], 0.90196078, tolerance = 1e-05) expect_equal(results10$conditionalRejectionProbabilities[1, ], c(NA_real_, 0.21935683), tolerance = 1e-05) expect_equal(results10$conditionalRejectionProbabilities[2, ], c(NA_real_, 0.13026808), tolerance = 1e-05) expect_equal(results10$conditionalPower[1, ], c(NA_real_, NA_real_)) expect_equal(results10$conditionalPower[2, ], c(NA_real_, NA_real_)) expect_equal(results10$repeatedConfidenceIntervalLowerBounds[1, ], c(NA_real_, -0.46994305), tolerance = 1e-05) expect_equal(results10$repeatedConfidenceIntervalLowerBounds[2, ], c(NA_real_, NA_real_)) expect_equal(results10$repeatedConfidenceIntervalUpperBounds[1, ], c(NA_real_, -0.15490055), tolerance = 1e-05) expect_equal(results10$repeatedConfidenceIntervalUpperBounds[2, ], c(NA_real_, NA_real_)) expect_equal(results10$repeatedPValues[1, ], c(NA_real_, 7.2525431e-05), tolerance = 1e-05) expect_equal(results10$repeatedPValues[2, ], c(NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(results10), NA))) expect_output(print(results10)$show()) invisible(capture.output(expect_error(summary(results10), NA))) expect_output(summary(results10)$show()) results10CodeBased <- eval(parse(text = getObjectRCode(results10, stringWrapParagraphWidth = NULL))) expect_equal(results10CodeBased$piTreatments, results10$piTreatments, tolerance = 1e-05) expect_equal(results10CodeBased$piControl, results10$piControl, tolerance = 1e-05) expect_equal(results10CodeBased$conditionalRejectionProbabilities, results10$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(results10CodeBased$conditionalPower, results10$conditionalPower, tolerance = 1e-05) expect_equal(results10CodeBased$repeatedConfidenceIntervalLowerBounds, results10$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(results10CodeBased$repeatedConfidenceIntervalUpperBounds, results10$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(results10CodeBased$repeatedPValues, results10$repeatedPValues, tolerance = 1e-05) expect_type(names(results10), "character") df <- as.data.frame(results10) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(results10) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) rpact/tests/testthat/test-f_simulation_base_rates.R0000644000175000017500000012571314154142422022510 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_simulation_base_rates.R ## | Creation date: 08 December 2021, 09:09:30 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Simulation Rates Function") test_that("'getSimulationRates': check several configurations", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationRates} # @refFS[Formula]{fs:SimulationOneArmRatesGenerate} # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} # @refFS[Formula]{fs:SimulationTwoArmRatesGenerate} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} # @refFS[Formula]{fs:pValuesTwoRatesApproximationAlternativeGreater} # @refFS[Formula]{fs:pValuesTwoRatesApproximationAlternativeSmaller} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} seed <- 99123 maxNumberOfIterations <- 100 options(width = 180) maxNumberOfSubjects <- 90 informationRates <- (1:3) / 3 plannedSubjects <- round(informationRates * maxNumberOfSubjects) x1 <- getSimulationRates(design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = informationRates), groups = 2, riskRatio = TRUE, thetaH0 = 0.8, plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, allocationRatioPlanned = 3, seed = seed) ## Comparison of the results of SimulationResultsRates object 'x1' with expected results expect_equal(x1$effect, c(0.2, 0.7, 1.2, 1.7), tolerance = 1e-07) expect_equal(x1$iterations[1, ], c(100, 100, 100, 100)) expect_equal(x1$iterations[2, ], c(78, 93, 99, 96)) expect_equal(x1$iterations[3, ], c(41, 68, 56, 40)) expect_equal(x1$overallReject, c(0.05, 0.23, 0.74, 0.88), tolerance = 1e-07) expect_equal(x1$rejectPerStage[1, ], c(0, 0, 0, 0.04), tolerance = 1e-07) expect_equal(x1$rejectPerStage[2, ], c(0.02, 0.04, 0.34, 0.54), tolerance = 1e-07) expect_equal(x1$rejectPerStage[3, ], c(0.03, 0.19, 0.4, 0.3), tolerance = 1e-07) expect_equal(x1$futilityStop, c(0.57, 0.28, 0.1, 0.02), tolerance = 1e-07) expect_equal(x1$futilityPerStage[1, ], c(0.22, 0.07, 0.01, 0), tolerance = 1e-07) expect_equal(x1$futilityPerStage[2, ], c(0.35, 0.21, 0.09, 0.02), tolerance = 1e-07) expect_equal(x1$earlyStop, c(0.59, 0.32, 0.44, 0.6), tolerance = 1e-07) expect_equal(x1$expectedNumberOfSubjects, c(65.7, 78.3, 76.5, 70.8), tolerance = 1e-07) expect_equal(x1$sampleSizes[1, ], c(30, 30, 30, 30)) expect_equal(x1$sampleSizes[2, ], c(30, 30, 30, 30)) expect_equal(x1$sampleSizes[3, ], c(30, 30, 30, 30)) expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$conditionalPowerAchieved[2, ], c(0.090943215, 0.15808459, 0.48521663, 0.52642331), tolerance = 1e-07) expect_equal(x1$conditionalPowerAchieved[3, ], c(0.22475932, 0.38294099, 0.60961381, 0.67377136), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$effect, x1$effect, tolerance = 1e-05) expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-05) expect_equal(x1CodeBased$overallReject, x1$overallReject, tolerance = 1e-05) expect_equal(x1CodeBased$rejectPerStage, x1$rejectPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$futilityStop, x1$futilityStop, tolerance = 1e-05) expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-05) expect_equal(x1CodeBased$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x1CodeBased$sampleSizes, x1$sampleSizes, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x2 <- getSimulationRates(design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = informationRates), groups = 2, riskRatio = FALSE, thetaH0 = -0.1, plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, allocationRatioPlanned = 3, seed = seed) ## Comparison of the results of SimulationResultsRates object 'x2' with expected results expect_equal(x2$effect, c(0.1, 0.2, 0.3, 0.4), tolerance = 1e-07) expect_equal(x2$iterations[1, ], c(100, 100, 100, 100)) expect_equal(x2$iterations[2, ], c(84, 95, 100, 97)) expect_equal(x2$iterations[3, ], c(55, 73, 64, 42)) expect_equal(x2$overallReject, c(0.08, 0.39, 0.81, 0.88), tolerance = 1e-07) expect_equal(x2$rejectPerStage[1, ], c(0, 0, 0, 0.03), tolerance = 1e-07) expect_equal(x2$rejectPerStage[2, ], c(0.02, 0.09, 0.33, 0.53), tolerance = 1e-07) expect_equal(x2$rejectPerStage[3, ], c(0.06, 0.3, 0.48, 0.32), tolerance = 1e-07) expect_equal(x2$futilityStop, c(0.43, 0.18, 0.03, 0.02), tolerance = 1e-07) expect_equal(x2$futilityPerStage[1, ], c(0.16, 0.05, 0, 0), tolerance = 1e-07) expect_equal(x2$futilityPerStage[2, ], c(0.27, 0.13, 0.03, 0.02), tolerance = 1e-07) expect_equal(x2$earlyStop, c(0.45, 0.27, 0.36, 0.58), tolerance = 1e-07) expect_equal(x2$expectedNumberOfSubjects, c(71.7, 80.4, 79.2, 71.7), tolerance = 1e-07) expect_equal(x2$sampleSizes[1, ], c(30, 30, 30, 30)) expect_equal(x2$sampleSizes[2, ], c(30, 30, 30, 30)) expect_equal(x2$sampleSizes[3, ], c(30, 30, 30, 30)) expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x2$conditionalPowerAchieved[2, ], c(0.10237911, 0.25306891, 0.43740091, 0.54067879), tolerance = 1e-07) expect_equal(x2$conditionalPowerAchieved[3, ], c(0.30171473, 0.4623858, 0.59071853, 0.68245332), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$effect, x2$effect, tolerance = 1e-05) expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-05) expect_equal(x2CodeBased$overallReject, x2$overallReject, tolerance = 1e-05) expect_equal(x2CodeBased$rejectPerStage, x2$rejectPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$futilityStop, x2$futilityStop, tolerance = 1e-05) expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-05) expect_equal(x2CodeBased$expectedNumberOfSubjects, x2$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() x3 <- getSimulationRates(design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = informationRates), groups = 1, thetaH0 = 0.2, pi1 = seq(0.2, 0.4, 0.05), plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, seed = seed) ## Comparison of the results of SimulationResultsRates object 'x3' with expected results expect_equal(x3$effect, c(0, 0.05, 0.1, 0.15, 0.2), tolerance = 1e-07) expect_equal(x3$iterations[1, ], c(100, 100, 100, 100, 100)) expect_equal(x3$iterations[2, ], c(78, 91, 96, 90, 72)) expect_equal(x3$iterations[3, ], c(32, 65, 62, 37, 6)) expect_equal(x3$overallReject, c(0.03, 0.3, 0.6, 0.93, 0.99), tolerance = 1e-07) expect_equal(x3$rejectPerStage[1, ], c(0, 0.02, 0.04, 0.1, 0.28), tolerance = 1e-07) expect_equal(x3$rejectPerStage[2, ], c(0.01, 0.06, 0.28, 0.53, 0.66), tolerance = 1e-07) expect_equal(x3$rejectPerStage[3, ], c(0.02, 0.22, 0.28, 0.3, 0.05), tolerance = 1e-07) expect_equal(x3$futilityStop, c(0.67, 0.27, 0.06, 0, 0), tolerance = 1e-07) expect_equal(x3$futilityPerStage[1, ], c(0.22, 0.07, 0, 0, 0), tolerance = 1e-07) expect_equal(x3$futilityPerStage[2, ], c(0.45, 0.2, 0.06, 0, 0), tolerance = 1e-07) expect_equal(x3$earlyStop, c(0.68, 0.35, 0.38, 0.63, 0.94), tolerance = 1e-07) expect_equal(x3$expectedNumberOfSubjects, c(63, 76.8, 77.4, 68.1, 53.4), tolerance = 1e-07) expect_equal(x3$sampleSizes[1, ], c(30, 30, 30, 30, 30)) expect_equal(x3$sampleSizes[2, ], c(30, 30, 30, 30, 30)) expect_equal(x3$sampleSizes[3, ], c(30, 30, 30, 30, 30)) expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$conditionalPowerAchieved[2, ], c(0.12773913, 0.18983473, 0.36146118, 0.53982038, 0.7268178), tolerance = 1e-07) expect_equal(x3$conditionalPowerAchieved[3, ], c(0.32676971, 0.35596086, 0.46114911, 0.56126649, 0.75350644), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$effect, x3$effect, tolerance = 1e-05) expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-05) expect_equal(x3CodeBased$overallReject, x3$overallReject, tolerance = 1e-05) expect_equal(x3CodeBased$rejectPerStage, x3$rejectPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$futilityStop, x3$futilityStop, tolerance = 1e-05) expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-05) expect_equal(x3CodeBased$expectedNumberOfSubjects, x3$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x3CodeBased$sampleSizes, x3$sampleSizes, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x4 <- getSimulationRates(design = getDesignInverseNormal(futilityBounds = c(0.5, 0.5), informationRates = informationRates), groups = 2, riskRatio = TRUE, thetaH0 = 1.5, pi1 = seq(0.05,0.25,0.05), plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, directionUpper = FALSE, allocationRatioPlanned = 3, seed = seed) ## Comparison of the results of SimulationResultsRates object 'x4' with expected results expect_equal(x4$effect, c(-1.25, -1, -0.75, -0.5, -0.25), tolerance = 1e-07) expect_equal(x4$iterations[1, ], c(100, 100, 100, 100, 100)) expect_equal(x4$iterations[2, ], c(74, 64, 47, 36, 39)) expect_equal(x4$iterations[3, ], c(28, 28, 30, 20, 25)) expect_equal(x4$overallReject, c(0.66, 0.51, 0.19, 0.08, 0.1), tolerance = 1e-07) expect_equal(x4$rejectPerStage[1, ], c(0.06, 0.05, 0.02, 0, 0), tolerance = 1e-07) expect_equal(x4$rejectPerStage[2, ], c(0.43, 0.29, 0.09, 0.04, 0.04), tolerance = 1e-07) expect_equal(x4$rejectPerStage[3, ], c(0.17, 0.17, 0.08, 0.04, 0.06), tolerance = 1e-07) expect_equal(x4$futilityStop, c(0.23, 0.38, 0.59, 0.76, 0.71), tolerance = 1e-07) expect_equal(x4$futilityPerStage[1, ], c(0.2, 0.31, 0.51, 0.64, 0.61), tolerance = 1e-07) expect_equal(x4$futilityPerStage[2, ], c(0.03, 0.07, 0.08, 0.12, 0.1), tolerance = 1e-07) expect_equal(x4$earlyStop, c(0.72, 0.72, 0.7, 0.8, 0.75), tolerance = 1e-07) expect_equal(x4$expectedNumberOfSubjects, c(60.6, 57.6, 53.1, 46.8, 49.2), tolerance = 1e-07) expect_equal(x4$sampleSizes[1, ], c(30, 30, 30, 30, 30)) expect_equal(x4$sampleSizes[2, ], c(30, 30, 30, 30, 30)) expect_equal(x4$sampleSizes[3, ], c(30, 30, 30, 30, 30)) expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x4$conditionalPowerAchieved[2, ], c(0.65569733, 0.50411153, 0.40992455, 0.37112776, 0.28877148), tolerance = 1e-07) expect_equal(x4$conditionalPowerAchieved[3, ], c(0.52876953, 0.55375049, 0.46252843, 0.37280654, 0.34687207), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$effect, x4$effect, tolerance = 1e-05) expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-05) expect_equal(x4CodeBased$overallReject, x4$overallReject, tolerance = 1e-05) expect_equal(x4CodeBased$rejectPerStage, x4$rejectPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$futilityStop, x4$futilityStop, tolerance = 1e-05) expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-05) expect_equal(x4CodeBased$expectedNumberOfSubjects, x4$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x4CodeBased$sampleSizes, x4$sampleSizes, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x5 <- getSimulationRates(design = getDesignInverseNormal(futilityBounds = c(0.5, 0.5), informationRates = informationRates), groups = 2, riskRatio = FALSE, thetaH0 = 0.1, plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, allocationRatioPlanned = 3, directionUpper = FALSE, seed = seed) ## Comparison of the results of SimulationResultsRates object 'x5' with expected results expect_equal(x5$effect, c(-0.1, 2.7755576e-17, 0.1, 0.2), tolerance = 1e-07) expect_equal(x5$iterations[1, ], c(100, 100, 100, 100)) expect_equal(x5$iterations[2, ], c(50, 41, 12, 2)) expect_equal(x5$iterations[3, ], c(34, 29, 3, 0)) expect_equal(x5$overallReject, c(0.22, 0.03, 0, 0), tolerance = 1e-07) expect_equal(x5$rejectPerStage[1, ], c(0.01, 0, 0, 0), tolerance = 1e-07) expect_equal(x5$rejectPerStage[2, ], c(0.09, 0.02, 0, 0), tolerance = 1e-07) expect_equal(x5$rejectPerStage[3, ], c(0.12, 0.01, 0, 0), tolerance = 1e-07) expect_equal(x5$futilityStop, c(0.56, 0.69, 0.97, 1), tolerance = 1e-07) expect_equal(x5$futilityPerStage[1, ], c(0.49, 0.59, 0.88, 0.98), tolerance = 1e-07) expect_equal(x5$futilityPerStage[2, ], c(0.07, 0.1, 0.09, 0.02), tolerance = 1e-07) expect_equal(x5$earlyStop, c(0.66, 0.71, 0.97, 1), tolerance = 1e-07) expect_equal(x5$expectedNumberOfSubjects, c(55.2, 51, 34.5, 30.6), tolerance = 1e-07) expect_equal(x5$sampleSizes[1, ], c(30, 30, 30, 30)) expect_equal(x5$sampleSizes[2, ], c(30, 30, 30, 30)) expect_equal(x5$sampleSizes[3, ], c(30, 30, 30, 0)) expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x5$conditionalPowerAchieved[2, ], c(0.36523014, 0.20927326, 0.16995311, 0.25129054), tolerance = 1e-07) expect_equal(x5$conditionalPowerAchieved[3, ], c(0.43064609, 0.32068397, 0.041565592, NaN), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x5), NA))) expect_output(print(x5)$show()) invisible(capture.output(expect_error(summary(x5), NA))) expect_output(summary(x5)$show()) x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) expect_equal(x5CodeBased$effect, x5$effect, tolerance = 1e-05) expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-05) expect_equal(x5CodeBased$overallReject, x5$overallReject, tolerance = 1e-05) expect_equal(x5CodeBased$rejectPerStage, x5$rejectPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$futilityStop, x5$futilityStop, tolerance = 1e-05) expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-05) expect_equal(x5CodeBased$expectedNumberOfSubjects, x5$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x5CodeBased$sampleSizes, x5$sampleSizes, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x5), "character") df <- as.data.frame(x5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x6 <- getSimulationRates(design = getDesignInverseNormal(futilityBounds = c(0.5, 0.5), informationRates = informationRates), groups = 1, thetaH0 = 0.4, pi1 = seq(0.2, 0.4, 0.05), plannedSubjects = plannedSubjects, directionUpper = FALSE, maxNumberOfIterations = maxNumberOfIterations, seed = seed) ## Comparison of the results of SimulationResultsRates object 'x6' with expected results expect_equal(x6$effect, c(-0.2, -0.15, -0.1, -0.05, 0), tolerance = 1e-07) expect_equal(x6$iterations[1, ], c(100, 100, 100, 100, 100)) expect_equal(x6$iterations[2, ], c(91, 89, 66, 56, 39)) expect_equal(x6$iterations[3, ], c(19, 49, 51, 48, 24)) expect_equal(x6$overallReject, c(0.92, 0.78, 0.4, 0.15, 0.03), tolerance = 1e-07) expect_equal(x6$rejectPerStage[1, ], c(0.03, 0.01, 0, 0, 0), tolerance = 1e-07) expect_equal(x6$rejectPerStage[2, ], c(0.72, 0.4, 0.14, 0.01, 0.01), tolerance = 1e-07) expect_equal(x6$rejectPerStage[3, ], c(0.17, 0.37, 0.26, 0.14, 0.02), tolerance = 1e-07) expect_equal(x6$futilityStop, c(0.06, 0.1, 0.35, 0.51, 0.75), tolerance = 1e-07) expect_equal(x6$futilityPerStage[1, ], c(0.06, 0.1, 0.34, 0.44, 0.61), tolerance = 1e-07) expect_equal(x6$futilityPerStage[2, ], c(0, 0, 0.01, 0.07, 0.14), tolerance = 1e-07) expect_equal(x6$earlyStop, c(0.81, 0.51, 0.49, 0.52, 0.76), tolerance = 1e-07) expect_equal(x6$expectedNumberOfSubjects, c(63, 71.4, 65.1, 61.2, 48.9), tolerance = 1e-07) expect_equal(x6$sampleSizes[1, ], c(30, 30, 30, 30, 30)) expect_equal(x6$sampleSizes[2, ], c(30, 30, 30, 30, 30)) expect_equal(x6$sampleSizes[3, ], c(30, 30, 30, 30, 30)) expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x6$conditionalPowerAchieved[2, ], c(0.72335875, 0.55247274, 0.3843863, 0.29482523, 0.18598438), tolerance = 1e-07) expect_equal(x6$conditionalPowerAchieved[3, ], c(0.71459365, 0.68392316, 0.54740245, 0.39208559, 0.15519282), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x6), NA))) expect_output(print(x6)$show()) invisible(capture.output(expect_error(summary(x6), NA))) expect_output(summary(x6)$show()) x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) expect_equal(x6CodeBased$effect, x6$effect, tolerance = 1e-05) expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-05) expect_equal(x6CodeBased$overallReject, x6$overallReject, tolerance = 1e-05) expect_equal(x6CodeBased$rejectPerStage, x6$rejectPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$futilityStop, x6$futilityStop, tolerance = 1e-05) expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-05) expect_equal(x6CodeBased$expectedNumberOfSubjects, x6$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x6CodeBased$sampleSizes, x6$sampleSizes, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x6), "character") df <- as.data.frame(x6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x7 <- getSimulationRates(design = getDesignInverseNormal(futilityBounds = c(0.5), typeOfDesign = "P"), thetaH0 = 0.3, groups = 1, plannedSubjects = c(30,60), pi1 = seq(0.3,0.5,0.05),maxNumberOfIterations = maxNumberOfIterations, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(30, 30), maxNumberOfSubjectsPerStage = 5 * c(NA, 30), directionUpper = TRUE, seed = seed) ## Comparison of the results of SimulationResultsRates object 'x7' with expected results expect_equal(x7$effect, c(0, 0.05, 0.1, 0.15, 0.2), tolerance = 1e-07) expect_equal(x7$iterations[1, ], c(100, 100, 100, 100, 100)) expect_equal(x7$iterations[2, ], c(25, 41, 53, 50, 35)) expect_equal(x7$overallReject, c(0.05, 0.18, 0.47, 0.77, 0.91), tolerance = 1e-07) expect_equal(x7$rejectPerStage[1, ], c(0.02, 0.06, 0.15, 0.36, 0.59), tolerance = 1e-07) expect_equal(x7$rejectPerStage[2, ], c(0.03, 0.12, 0.32, 0.41, 0.32), tolerance = 1e-07) expect_equal(x7$futilityPerStage[1, ], c(0.73, 0.53, 0.32, 0.14, 0.06), tolerance = 1e-07) expect_equal(x7$earlyStop, c(0.75, 0.59, 0.47, 0.5, 0.65), tolerance = 1e-07) expect_equal(x7$expectedNumberOfSubjects, c(58.56, 77.43, 83.21, 80.96, 58.83), tolerance = 1e-07) expect_equal(x7$sampleSizes[1, ], c(30, 30, 30, 30, 30)) expect_equal(x7$sampleSizes[2, ], c(114.24, 115.68293, 100.39623, 101.92, 82.371429), tolerance = 1e-07) expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x7$conditionalPowerAchieved[2, ], c(0.60107965, 0.60407724, 0.68409402, 0.68536207, 0.68807468), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x7), NA))) expect_output(print(x7)$show()) invisible(capture.output(expect_error(summary(x7), NA))) expect_output(summary(x7)$show()) x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) expect_equal(x7CodeBased$effect, x7$effect, tolerance = 1e-05) expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-05) expect_equal(x7CodeBased$overallReject, x7$overallReject, tolerance = 1e-05) expect_equal(x7CodeBased$rejectPerStage, x7$rejectPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-05) expect_equal(x7CodeBased$expectedNumberOfSubjects, x7$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x7CodeBased$sampleSizes, x7$sampleSizes, tolerance = 1e-05) expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x7), "character") df <- as.data.frame(x7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x8 <- getSimulationRates(design = getDesignGroupSequential( futilityBounds = c(0.5, 0.5), typeOfDesign = "P"), thetaH0 = 0.3, groups = 2, allocationRatioPlanned = 3, plannedSubjects = (1:3) * 100, pi1 = seq(0.2, 0.4, 0.05), pi2 = 0.2, maxNumberOfIterations = maxNumberOfIterations, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(100, 100, 100), maxNumberOfSubjectsPerStage = 5 * c(NA, 100, 100), directionUpper = FALSE, seed = seed) ## Comparison of the results of SimulationResultsRates object 'x8' with expected results expect_equal(x8$effect, c(-0.3, -0.25, -0.2, -0.15, -0.1), tolerance = 1e-07) expect_equal(x8$iterations[1, ], c(100, 100, 100, 100, 100)) expect_equal(x8$iterations[2, ], c(7, 23, 41, 52, 59)) expect_equal(x8$iterations[3, ], c(0, 1, 1, 11, 20)) expect_equal(x8$overallReject, c(1, 0.98, 0.95, 0.81, 0.61), tolerance = 1e-07) expect_equal(x8$rejectPerStage[1, ], c(0.93, 0.75, 0.54, 0.29, 0.1), tolerance = 1e-07) expect_equal(x8$rejectPerStage[2, ], c(0.07, 0.22, 0.4, 0.41, 0.37), tolerance = 1e-07) expect_equal(x8$rejectPerStage[3, ], c(0, 0.01, 0.01, 0.11, 0.14), tolerance = 1e-07) expect_equal(x8$futilityStop, c(0, 0.02, 0.05, 0.19, 0.33), tolerance = 1e-07) expect_equal(x8$futilityPerStage[1, ], c(0, 0.02, 0.05, 0.19, 0.31), tolerance = 1e-07) expect_equal(x8$futilityPerStage[2, ], c(0, 0, 0, 0, 0.02), tolerance = 1e-07) expect_equal(x8$earlyStop, c(1, 0.99, 0.99, 0.89, 0.8), tolerance = 1e-07) expect_equal(x8$expectedNumberOfSubjects, c(115.79, 135.33, 201.46, 331.88, 420.15), tolerance = 1e-07) expect_equal(x8$sampleSizes[1, ], c(100, 100, 100, 100, 100)) expect_equal(x8$sampleSizes[2, ], c(225.57143, 148.73913, 239.7561, 361.73077, 405.05085), tolerance = 1e-07) expect_equal(x8$sampleSizes[3, ], c(0, 112, 316, 398, 405.85), tolerance = 1e-07) expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x8$conditionalPowerAchieved[2, ], c(0.79294349, 0.80728899, 0.77763316, 0.64160567, 0.53147513), tolerance = 1e-07) expect_equal(x8$conditionalPowerAchieved[3, ], c(NaN, 0.80069037, 0.80071364, 0.56677072, 0.57523679), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x8), NA))) expect_output(print(x8)$show()) invisible(capture.output(expect_error(summary(x8), NA))) expect_output(summary(x8)$show()) x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) expect_equal(x8CodeBased$effect, x8$effect, tolerance = 1e-05) expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-05) expect_equal(x8CodeBased$overallReject, x8$overallReject, tolerance = 1e-05) expect_equal(x8CodeBased$rejectPerStage, x8$rejectPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$futilityStop, x8$futilityStop, tolerance = 1e-05) expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-05) expect_equal(x8CodeBased$expectedNumberOfSubjects, x8$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x8CodeBased$sampleSizes, x8$sampleSizes, tolerance = 1e-05) expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x8), "character") df <- as.data.frame(x8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x9 <- getSimulationRates(design = getDesignGroupSequential( futilityBounds = c(0), typeOfDesign = "P"), thetaH0 = 0.8, groups = 2, riskRatio = TRUE, allocationRatioPlanned = 3, maxNumberOfIterations = maxNumberOfIterations, plannedSubjects = c(100,200), pi1 = seq(0.15, 0.4, 0.05), pi2 = 0.2, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(100, 100), maxNumberOfSubjectsPerStage = 5*c(NA, 100), directionUpper = TRUE, seed = seed) ## Comparison of the results of SimulationResultsRates object 'x9' with expected results expect_equal(x9$effect, c(-0.05, 0.2, 0.45, 0.7, 0.95, 1.2), tolerance = 1e-07) expect_equal(x9$iterations[1, ], c(100, 100, 100, 100, 100, 100)) expect_equal(x9$iterations[2, ], c(48, 66, 75, 74, 57, 35)) expect_equal(x9$overallReject, c(0.01, 0.07, 0.45, 0.86, 0.92, 1), tolerance = 1e-07) expect_equal(x9$rejectPerStage[1, ], c(0.01, 0.02, 0.11, 0.24, 0.41, 0.65), tolerance = 1e-07) expect_equal(x9$rejectPerStage[2, ], c(0, 0.05, 0.34, 0.62, 0.51, 0.35), tolerance = 1e-07) expect_equal(x9$futilityPerStage[1, ], c(0.51, 0.32, 0.14, 0.02, 0.02, 0), tolerance = 1e-07) expect_equal(x9$earlyStop, c(0.52, 0.34, 0.25, 0.26, 0.43, 0.65), tolerance = 1e-07) expect_equal(x9$expectedNumberOfSubjects, c(323.82, 368.88, 387.13, 364.4, 246.27, 193.96), tolerance = 1e-07) expect_equal(x9$sampleSizes[1, ], c(100, 100, 100, 100, 100, 100)) expect_equal(x9$sampleSizes[2, ], c(466.29167, 407.39394, 382.84, 357.2973, 256.61404, 268.45714), tolerance = 1e-07) expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x9$conditionalPowerAchieved[2, ], c(0.32248415, 0.49314797, 0.522945, 0.55888112, 0.72047998, 0.75410423), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x9), NA))) expect_output(print(x9)$show()) invisible(capture.output(expect_error(summary(x9), NA))) expect_output(summary(x9)$show()) x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) expect_equal(x9CodeBased$effect, x9$effect, tolerance = 1e-05) expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-05) expect_equal(x9CodeBased$overallReject, x9$overallReject, tolerance = 1e-05) expect_equal(x9CodeBased$rejectPerStage, x9$rejectPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-05) expect_equal(x9CodeBased$expectedNumberOfSubjects, x9$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x9CodeBased$sampleSizes, x9$sampleSizes, tolerance = 1e-05) expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x9), "character") df <- as.data.frame(x9) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x9) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } calcSubjectsFunctionSimulationBaseRates <- function(...,stage, plannedSubjects, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage, conditionalPower, conditionalCriticalValue, overallRate) { if (overallRate[1] - overallRate[2] < 0.1) { return(plannedSubjects[stage] - plannedSubjects[stage - 1]) } else { rateUnderH0 <- (overallRate[1] + overallRate[2])/2 stageSubjects <- 2 * (max(0, conditionalCriticalValue * sqrt(2 * rateUnderH0 * (1 - rateUnderH0)) + stats::qnorm(conditionalPower) * sqrt(overallRate[1] * (1 - overallRate[1]) + overallRate[2] * (1 - overallRate[2]))))^2 / (max(1e-12, (overallRate[1] - overallRate[2])))^2 stageSubjects <- ceiling(min(max(minNumberOfSubjectsPerStage[stage], stageSubjects), maxNumberOfSubjectsPerStage[stage])) return(stageSubjects) } } x10 <- getSimulationRates(design = getDesignInverseNormal(kMax = 2), pi1 = seq(0.3,0.6,0.1), pi2 = 0.3, plannedSubjects = c(40, 80), minNumberOfSubjectsPerStage = c(40, 20), maxNumberOfSubjectsPerStage = c(40, 160), conditionalPower = 0.8, calcSubjectsFunction = calcSubjectsFunctionSimulationBaseRates, maxNumberOfIterations = maxNumberOfIterations, seed = seed) ## Comparison of the results of SimulationResultsRates object 'x10' with expected results expect_equal(x10$effect, c(0, 0.1, 0.2, 0.3), tolerance = 1e-07) expect_equal(x10$iterations[1, ], c(100, 100, 100, 100)) expect_equal(x10$iterations[2, ], c(100, 99, 95, 75)) expect_equal(x10$overallReject, c(0.02, 0.2, 0.52, 0.89), tolerance = 1e-07) expect_equal(x10$rejectPerStage[1, ], c(0, 0.01, 0.05, 0.25), tolerance = 1e-07) expect_equal(x10$rejectPerStage[2, ], c(0.02, 0.19, 0.47, 0.64), tolerance = 1e-07) expect_equal(x10$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x10$earlyStop, c(0, 0.01, 0.05, 0.25), tolerance = 1e-07) expect_equal(x10$expectedNumberOfSubjects, c(104.34, 113.7, 101.87, 83.69), tolerance = 1e-07) expect_equal(x10$sampleSizes[1, ], c(40, 40, 40, 40)) expect_equal(x10$sampleSizes[2, ], c(64.34, 74.444444, 65.126316, 58.253333), tolerance = 1e-07) expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x10$conditionalPowerAchieved[2, ], c(0.20349537, 0.39194633, 0.57556995, 0.71162895), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x10), NA))) expect_output(print(x10)$show()) invisible(capture.output(expect_error(summary(x10), NA))) expect_output(summary(x10)$show()) x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) expect_equal(x10CodeBased$effect, x10$effect, tolerance = 1e-05) expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-05) expect_equal(x10CodeBased$overallReject, x10$overallReject, tolerance = 1e-05) expect_equal(x10CodeBased$rejectPerStage, x10$rejectPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-05) expect_equal(x10CodeBased$expectedNumberOfSubjects, x10$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x10CodeBased$sampleSizes, x10$sampleSizes, tolerance = 1e-05) expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x10), "character") df <- as.data.frame(x10) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x10) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationRates': comparison with getPowerRates() results for a inverse normal design", { .skipTestIfNotX64() .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationRates} # @refFS[Formula]{fs:SimulationOneArmRatesGenerate} # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} # @refFS[Formula]{fs:SimulationTwoArmRatesGenerate} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} # @refFS[Formula]{fs:pValuesTwoRatesApproximationAlternativeGreater} # @refFS[Formula]{fs:pValuesTwoRatesApproximationAlternativeSmaller} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} design <- getDesignInverseNormal(futilityBounds = c(-1), informationRates = c(0.5, 1), typeOfDesign = "P") x <- getSimulationRates(design, thetaH0 = 0.4, groups = 1, plannedSubjects = c(150, 300), pi1 = seq(0.3, 0.4, 0.02), maxNumberOfIterations = 1000, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA_real_, 100), maxNumberOfSubjectsPerStage = c(NA_real_, 500), directionUpper = FALSE, seed = 123) y <- getPowerRates(design, thetaH0 = 0.4, groups = 1, pi1 = seq(0.3, 0.4, 0.02), directionUpper = FALSE, maxNumberOfSubjects = 300) expectedNumberOfSubjectsDiff <- round((x$expectedNumberOfSubjects - y$expectedNumberOfSubjects) / 300, 4) ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results expect_equal(expectedNumberOfSubjectsDiff, c(0.2203, 0.4265, 0.625, 0.8158, 0.9639, 0.9543), tolerance = 1e-07) overallRejectDiff <- round(x$overallReject - y$overallReject, 4) ## Comparison of the results of numeric object 'overallRejectDiff' with expected results expect_equal(overallRejectDiff, c(0.052, 0.1567, 0.2226, 0.1407, 0.0249, -0.008), tolerance = 1e-07) rejectPerStageDiff <- round(x$rejectPerStage - y$rejectPerStage, 4) ## Comparison of the results of matrixarray object 'rejectPerStageDiff' with expected results expect_equal(rejectPerStageDiff[1, ], c(-0.0439, -0.0644, -0.027, -0.0138, 0.0042, -0.0067), tolerance = 1e-07) expect_equal(rejectPerStageDiff[2, ], c(0.0959, 0.2211, 0.2497, 0.1545, 0.0207, -0.0013), tolerance = 1e-07) futilityPerStageDiff <- round(x$futilityPerStage - y$futilityPerStage, 4) ## Comparison of the results of matrixarray object 'futilityPerStageDiff' with expected results expect_equal(futilityPerStageDiff[1, ], c(-2e-04, 0.0018, -0.0011, -0.0092, -0.0279, -0.0147), tolerance = 1e-07) }) test_that("'getSimulationRates': comparison with getPowerRates() results for a group sequential design", { .skipTestIfNotX64() .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationRates} # @refFS[Formula]{fs:SimulationTwoArmRatesGenerate} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} # @refFS[Formula]{fs:pValuesTwoRatesApproximationAlternativeGreater} # @refFS[Formula]{fs:pValuesTwoRatesApproximationAlternativeSmaller} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} design <- getDesignGroupSequential(futilityBounds = c(-1,1), typeOfDesign = "P") x <- getSimulationRates(design, thetaH0 = 0.3, groups = 2, allocationRatioPlanned = 2, plannedSubjects = (1:3)*100, pi1 = seq(0.2, 0.4, 0.05), pi2 = 0.1, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(100, 100, 100), maxNumberOfSubjectsPerStage = 1*c(100, 100, 100), directionUpper = FALSE, seed = 123) y <- getPowerRates(design, thetaH0 = 0.3, groups = 2, allocationRatioPlanned = 2, pi1 = seq(0.2, 0.4, 0.05), pi2 = 0.1, directionUpper = FALSE, maxNumberOfSubjects = 300) expectedNumberOfSubjectsDiff <- round((x$expectedNumberOfSubjects - y$expectedNumberOfSubjects) / 300, 4) ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results expect_equal(expectedNumberOfSubjectsDiff, c(-0.0076, -0.0264, -0.0251, -0.0066, -0.0023), tolerance = 1e-07) overallRejectDiff <- round(x$overallReject - y$overallReject, 4) ## Comparison of the results of numeric object 'overallRejectDiff' with expected results expect_equal(overallRejectDiff, c(9e-04, 0.0072, 0.0177, -9e-04, -6e-04), tolerance = 1e-07) rejectPerStageDiff <- round(x$rejectPerStage - y$rejectPerStage, 4) ## Comparison of the results of matrixarray object 'rejectPerStageDiff' with expected results expect_equal(rejectPerStageDiff[1, ], c(0.0121, 0.0444, 0.0355, 0.0081, 0.001), tolerance = 1e-07) expect_equal(rejectPerStageDiff[2, ], c(-0.0032, -0.0171, 0.009, -0.0062, -0.0019), tolerance = 1e-07) expect_equal(rejectPerStageDiff[3, ], c(-0.008, -0.02, -0.0268, -0.0028, 3e-04), tolerance = 1e-07) futilityPerStageDiff <- round(x$futilityPerStage - y$futilityPerStage, 4) ## Comparison of the results of matrixarray object 'futilityPerStageDiff' with expected results expect_equal(futilityPerStageDiff[1, ], c(-1e-04, 0, 0.0049, 0.0058, 0.0053), tolerance = 1e-07) expect_equal(futilityPerStageDiff[2, ], c(0.0018, 0.0077, -0.0146, -0.0016, -0.0038), tolerance = 1e-07) ##-- x2 <- getSimulationRates(design = getDesignGroupSequential(futilityBounds = c(-1, 1), typeOfDesign = "P"), thetaH0 = 0.8, groups = 2, riskRatio = TRUE, allocationRatioPlanned = 2, plannedSubjects = c(100, 200, 300), pi1 = seq(0.15,0.4,0.05), pi2 = 0.2, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA_real_, 150, 300), maxNumberOfSubjectsPerStage = c(NA_real_, 200, 300), directionUpper = TRUE, maxNumberOfIterations = 1000, seed = 123) y2 <- getPowerRates(design = getDesignGroupSequential(futilityBounds = c(-1, 1), typeOfDesign = "P"), thetaH0 = 0.8, groups = 2, riskRatio = TRUE, allocationRatioPlanned = 2, pi1 = seq(0.15, 0.4, 0.05), pi2 = 0.2, maxNumberOfSubjects = 300, directionUpper = TRUE) expectedNumberOfSubjectsDiff2 <- round((x2$expectedNumberOfSubjects - y2$expectedNumberOfSubjects) / 300, 4) ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff2' with expected results expect_equal(expectedNumberOfSubjectsDiff2, c(0.336, 0.5853, 0.5882, 0.3089, 0.1411, 0.079), tolerance = 1e-07) overallRejectDiff2 <- round(x2$overallReject - y2$overallReject, 4) ## Comparison of the results of numeric object 'overallRejectDiff2' with expected results expect_equal(overallRejectDiff2, c(0.0032, 0.0559, 0.2444, 0.1617, 0.0401, 0.0038), tolerance = 1e-07) rejectPerStageDiff2 <- round(x2$rejectPerStage - y2$rejectPerStage, 4) ## Comparison of the results of matrixarray object 'rejectPerStageDiff2' with expected results expect_equal(rejectPerStageDiff2[1, ], c(6e-04, -0.0126, -0.0203, -0.0149, -0.0029, -0.0228), tolerance = 1e-07) expect_equal(rejectPerStageDiff2[2, ], c(0.0025, 0.0084, 0.104, 0.1808, 0.1029, 0.0508), tolerance = 1e-07) expect_equal(rejectPerStageDiff2[3, ], c(1e-04, 0.0601, 0.1607, -0.0041, -0.06, -0.0242), tolerance = 1e-07) futilityPerStageDiff2 <- round(x2$futilityPerStage - y2$futilityPerStage, 4) ## Comparison of the results of matrixarray object 'futilityPerStageDiff2' with expected results expect_equal(futilityPerStageDiff2[1, ], c(-0.0028, -0.016, -0.0034, -3e-04, -5e-04, -1e-04), tolerance = 1e-07) expect_equal(futilityPerStageDiff2[2, ], c(-0.0068, -0.0474, -0.0917, -0.0386, -0.0101, -0.0011), tolerance = 1e-07) }) rpact/tests/testthat/helper-f_analysis_base_means.R0000644000175000017500000000317114145656365022445 0ustar nileshnilesh## | ## | *Unit tests helper functions* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | testGetStageResultsPlotData <- function(x, ..., nPlanned, stage = NA_integer_, allocationRatioPlanned = 1) { if (x$getDataInput()$isDatasetMeans()) { assumedStDev <- .getOptionalArgument("assumedStDev", ...) if (is.null(assumedStDev)) { assumedStDev <- x$assumedStDev return(.getConditionalPowerPlot(stageResults = x, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, assumedStDev = assumedStDev, ...)) } } else if (x$getDataInput()$isDatasetRates()) { pi2 <- .getOptionalArgument("pi2", ...) if (is.null(pi2)) { pi2 <- x$pi2 return(.getConditionalPowerPlot(stageResults = x, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, pi2 = pi2, ...)) } } return(.getConditionalPowerPlot(stageResults = x, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ...)) }rpact/tests/testthat/test-f_core_output_formats.R0000644000175000017500000001066214154142422022233 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_core_output_formats.R ## | Creation date: 08 December 2021, 09:08:44 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing the Output Format Functions") test_that("'.formatPValues'", { # @refFS[Sec.]{fs:sec:outputFormats} # @refFS[Tab.]{fs:tab:outputFormats} x <- .formatPValues(0.0000234) ## Comparison of the results of character object 'x' with expected results expect_equal(x, "<0.0001") x <- .formatPValues(c(0.0000234, 0.0000134, 0.1234)) ## Comparison of the results of character object 'x' with expected results expect_equal(x, c("<0.0001", "<0.0001", "0.1234")) x <- .formatPValues(c(0.0002345678, 0.0000134, 0.1234, 0.000000000001, .00000009999)) ## Comparison of the results of character object 'x' with expected results expect_equal(x, c("0.0002346", "0.0000134", "0.1234000", "<0.000001", "<0.000001")) x <- .formatPValues(c(0.00234, 0.000013, 0.1234, 0.000000000001, .00000009999)) ## Comparison of the results of character object 'x' with expected results expect_equal(x, c("0.00234", "<0.0001", "0.12340", "<0.0001", "<0.0001")) x <- .formatPValues(c(6.244e-05, 4.906e-02, 1.446e-02, NA_real_)) ## Comparison of the results of character object 'x' with expected results expect_equal(x, c("<0.0001", "0.04906", "0.01446", "NA")) x <- .formatPValues(c(6.24408201934656e-05, 7.55449751868031e-05, 1.23207030919836e-05, NA_real_)) ## Comparison of the results of character object 'x' with expected results expect_equal(x, c("<0.0001", "<0.0001", "<0.0001", "NA")) }) test_that("'.formatRepeatedPValues'", { # @refFS[Sec.]{fs:sec:outputFormats} # @refFS[Tab.]{fs:tab:outputFormats} x <- .formatRepeatedPValues(c(0.0000234, 0.0000134, 0.1234)) ## Comparison of the results of character object 'x' with expected results expect_equal(x, c("<0.0001", "<0.0001", "0.1234")) x <- .formatRepeatedPValues(c(0.0000234, 0.0000134, 0.5234)) ## Comparison of the results of character object 'x' with expected results expect_equal(x, c("<0.0001", "<0.0001", ">0.5")) x <- .formatRepeatedPValues(c(0.0000234, 0.0000134, 0.5234, NA_real_)) ## Comparison of the results of character object 'x' with expected results expect_equal(x, c("<0.0001", "<0.0001", ">0.5", "NA")) }) test_that("'.formatConditionalPower'", { # @refFS[Sec.]{fs:sec:outputFormats} # @refFS[Tab.]{fs:tab:outputFormats} x <- .formatConditionalPower(c(0.0000234, 0.0000134, 0.5234, NA_real_)) ## Comparison of the results of character object 'x' with expected results expect_equal(x, c("0", "0", "0.5234", "NA")) x <- .formatConditionalPower(c(0.234, 0.123456, 0.6, 0.000001)) ## Comparison of the results of character object 'x' with expected results expect_equal(x, c("0.2340", "0.1235", "0.6000", "0")) }) test_that("'.formatProbabilities'", { # @refFS[Sec.]{fs:sec:outputFormats} # @refFS[Tab.]{fs:tab:outputFormats} x <- .formatProbabilities(c(NA_real_, NA_real_, 0.4536623, 0.7713048)) ## Comparison of the results of character object 'x' with expected results expect_equal(x, c("NA", "NA", "0.4537", "0.7713")) }) test_that("'.getDecimalPlaces'", { # @refFS[Sec.]{fs:sec:outputFormats} # @refFS[Tab.]{fs:tab:outputFormats} x <- .getDecimalPlaces(NA) ## Comparison of the results of integer object 'x' with expected results expect_equal(x, 0) x <- .getDecimalPlaces(12.123) ## Comparison of the results of integer object 'x' with expected results expect_equal(x, 3) x <- .getDecimalPlaces(c(6.661338e-16, 8.000000e-01, NA_real_)) ## Comparison of the results of integer object 'x' with expected results expect_equal(x, c(15, 1, 0)) x <- .getDecimalPlaces(c(6.661338e-16, 8.12300000e-02)) ## Comparison of the results of integer object 'x' with expected results expect_equal(x, c(15, 5)) }) rpact/tests/testthat/test-generic_functions.R0000644000175000017500000001340414154142422021324 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-generic_functions.R ## | Creation date: 08 December 2021, 09:10:13 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Class 'SummaryFactory'") test_that("Testing 'summary.ParameterSet': no errors occur", { .skipTestIfDisabled() design <- getDesignGroupSequential(alpha = 0.05, kMax = 4, sided = 1, typeOfDesign = "WT", deltaWT = 0.1) designFisher <- getDesignFisher(kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.5, 0.8, 1), alpha0Vec = rep(0.4, 3)) designCharacteristics <- getDesignCharacteristics(design) powerAndASN <- getPowerAndAverageSampleNumber(design, theta = 1, nMax = 100) designSet <- getDesignSet(design = design, deltaWT = c(0.3, 0.4)) dataset <- getDataset( n1 = c(22, 11, 22, 11), n2 = c(22, 13, 22, 13), means1 = c(1, 1.1, 1, 1), means2 = c(1.4, 1.5, 3, 2.5), stDevs1 = c(1, 2, 2, 1.3), stDevs2 = c(1, 2, 2, 1.3) ) stageResults <- getStageResults(design, dataset) suppressWarnings(designPlan <- getSampleSizeMeans(design)) simulationResults <- getSimulationSurvival(design, maxNumberOfSubjects = 1200, plannedEvents = c(50, 100, 150, 200), seed = 12345) piecewiseSurvivalTime <- getPiecewiseSurvivalTime(list( "0 - <6" = 0.025, "6 - <9" = 0.04, "9 - <15" = 0.015, "15 - <21" = 0.01, ">=21" = 0.007), hazardRatio = 0.8) accrualTime <- getAccrualTime(list( "0 - <12" = 15, "12 - <13" = 21, "13 - <14" = 27, "14 - <15" = 33, "15 - <16" = 39, ">=16" = 45), maxNumberOfSubjects = 1400) expect_vector(names(design)) expect_vector(names(designFisher)) expect_vector(names(designCharacteristics)) expect_vector(names(powerAndASN)) expect_vector(names(designSet)) expect_vector(names(dataset)) expect_vector(names(stageResults)) expect_vector(names(designPlan)) expect_vector(names(simulationResults)) expect_vector(names(piecewiseSurvivalTime)) expect_vector(names(accrualTime)) expect_output(print(design)) expect_output(print(designFisher)) expect_output(print(designCharacteristics)) expect_output(print(powerAndASN)) expect_output(print(designSet)) expect_output(print(dataset)) expect_output(print(stageResults)) expect_output(print(designPlan)) expect_output(print(simulationResults)) expect_output(print(piecewiseSurvivalTime)) expect_output(print(accrualTime)) expect_output(summary(design)$show()) expect_output(summary(designFisher)$show()) expect_output(summary(designCharacteristics)$show()) expect_output(summary(powerAndASN)) expect_output(print(summary(designSet))) expect_output(summary(dataset)$show()) expect_output(summary(stageResults)) expect_output(summary(designPlan)$show()) expect_output(summary(simulationResults)$show()) expect_output(summary(piecewiseSurvivalTime)) expect_output(summary(accrualTime)) expect_named(as.data.frame(design)) expect_named(as.data.frame(designFisher)) expect_named(as.data.frame(designCharacteristics)) expect_named(as.data.frame(powerAndASN)) expect_named(as.data.frame(designSet)) expect_named(as.data.frame(dataset)) expect_named(as.data.frame(stageResults)) expect_named(as.data.frame(designPlan)) expect_named(as.data.frame(simulationResults)) expect_named(as.data.frame(piecewiseSurvivalTime)) expect_named(as.data.frame(accrualTime)) expect_is(as.data.frame(design, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(designFisher, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(designCharacteristics, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(powerAndASN, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(designSet, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(dataset, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(stageResults, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(designPlan, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(simulationResults, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(piecewiseSurvivalTime, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(accrualTime, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.matrix(design), "matrix") expect_is(as.matrix(designFisher), "matrix") expect_is(as.matrix(designCharacteristics), "matrix") expect_is(as.matrix(powerAndASN), "matrix") expect_is(as.matrix(designSet), "matrix") expect_is(as.matrix(dataset), "matrix") expect_is(as.matrix(stageResults), "matrix") expect_is(as.matrix(designPlan), "matrix") expect_is(as.matrix(simulationResults), "matrix") expect_is(as.matrix(piecewiseSurvivalTime), "matrix") expect_is(as.matrix(accrualTime), "matrix") suppressWarnings(analysisResults <- getAnalysisResults(design, dataset)) expect_vector(names(analysisResults)) expect_output(print(analysisResults)) expect_output(summary(analysisResults)$show()) expect_named(as.data.frame(analysisResults)) expect_is(as.data.frame(analysisResults, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.matrix(analysisResults), "matrix") }) rpact/tests/testthat/helper-f_core_assertions.R0000644000175000017500000000374314145656365021654 0ustar nileshnilesh## | ## | *Unit tests helper functions* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | getAssertionTestDesign <- function(..., kMax = NA_integer_, informationRates = NA_real_, futilityBounds = NA_real_, designClass = C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL) { if (designClass == C_CLASS_NAME_TRIAL_DESIGN_FISHER) { return(TrialDesignFisher( kMax = kMax, alpha = C_ALPHA_DEFAULT, method = C_FISHER_METHOD_DEFAULT, alpha0Vec = futilityBounds, informationRates = informationRates, tolerance = C_ANALYSIS_TOLERANCE_FISHER_DEFAULT, iterations = 0, seed = 9498485 )) } return(.createDesign( designClass = designClass, kMax = kMax, alpha = C_ALPHA_DEFAULT, beta = C_BETA_DEFAULT, sided = 1, informationRates = informationRates, futilityBounds = futilityBounds, typeOfDesign = C_DEFAULT_TYPE_OF_DESIGN, delta = 0, optimizationCriterion = C_OPTIMIZATION_CRITERION_DEFAULT, gammaA = 1, typeBetaSpending = C_TYPE_OF_DESIGN_BS_NONE, userAlphaSpending = NA_real_, userBetaSpending = NA_real_, gammaB = 1, tolerance = 1e-06)) } rpact/tests/testthat/test-f_analysis_base_survival.R0000644000175000017500000016414114154142422022702 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_analysis_base_survival.R ## | Creation date: 08 December 2021, 09:02:44 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing the Analysis Survival Functionality for the Group Sequential Design") test_that("'getAnalysisResults' for a two-stage group sequential design and survival data", { design0 <- getDesignGroupSequential(kMax = 2, alpha = 0.025, informationRates = c(0.4, 1), bindingFutility = TRUE, typeOfDesign = "WT", deltaWT = 0.25, futilityBounds = c(0)) dataExample0 <- getDataset( overallEvents = c(8, 20), overallLogRanks = c(1.92, 2.1) ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticSurvival} # @refFS[Formula]{fs:pValuesSurvivalAlternativeGreater} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:finalCISurvival} # @refFS[Formula]{fs:medianUnbiasedEstimate} x0 <- getAnalysisResults(design0, dataExample0, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x0' with expected results expect_equal(x0$thetaH1, 2.5578027, tolerance = 1e-06) expect_equal(x0$testActions, c("continue", "reject")) expect_equal(x0$conditionalRejectionProbabilities, c(0.15200046, NA_real_), tolerance = 1e-06) expect_equal(x0$conditionalPower, c(NA_real_, NA_real_)) expect_equal(x0$repeatedConfidenceIntervalLowerBounds, c(0.65051922, 1.04083), tolerance = 1e-06) expect_equal(x0$repeatedConfidenceIntervalUpperBounds, c(23.22605, 6.2857086), tolerance = 1e-06) expect_equal(x0$repeatedPValues, c(0.074184316, 0.019962317), tolerance = 1e-06) expect_equal(x0$finalStage, 2) expect_equal(x0$finalPValues, c(NA_real_, 0.021122043), tolerance = 1e-06) expect_equal(x0$finalConfidenceIntervalLowerBounds, c(NA_real_, 1.0341796), tolerance = 1e-06) expect_equal(x0$finalConfidenceIntervalUpperBounds, c(NA_real_, 6.2409205), tolerance = 1e-06) expect_equal(x0$medianUnbiasedEstimates, c(NA_real_, 2.5476534), tolerance = 1e-06) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x0), NA))) expect_output(print(x0)$show()) invisible(capture.output(expect_error(summary(x0), NA))) expect_output(summary(x0)$show()) x0CodeBased <- eval(parse(text = getObjectRCode(x0, stringWrapParagraphWidth = NULL))) expect_equal(x0CodeBased$thetaH1, x0$thetaH1, tolerance = 1e-05) expect_equal(x0CodeBased$testActions, x0$testActions, tolerance = 1e-05) expect_equal(x0CodeBased$conditionalRejectionProbabilities, x0$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x0CodeBased$conditionalPower, x0$conditionalPower, tolerance = 1e-05) expect_equal(x0CodeBased$repeatedConfidenceIntervalLowerBounds, x0$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x0CodeBased$repeatedConfidenceIntervalUpperBounds, x0$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x0CodeBased$repeatedPValues, x0$repeatedPValues, tolerance = 1e-05) expect_equal(x0CodeBased$finalStage, x0$finalStage, tolerance = 1e-05) expect_equal(x0CodeBased$finalPValues, x0$finalPValues, tolerance = 1e-05) expect_equal(x0CodeBased$finalConfidenceIntervalLowerBounds, x0$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x0CodeBased$finalConfidenceIntervalUpperBounds, x0$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x0CodeBased$medianUnbiasedEstimates, x0$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x0), "character") df <- as.data.frame(x0) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x0) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults' for a three-stage group sequential design and survival data", { .skipTestIfDisabled() design1 <- getDesignGroupSequential(kMax = 3, alpha = 0.025, informationRates = c(0.2, 0.4, 1), bindingFutility = FALSE, typeOfDesign = "WT", deltaWT = 0.25, futilityBounds = c(0, 0)) dataExample1 <- getDataset( overallEvents = c(8, 15, 38), overallAllocationRatios = c(1, 1, 1), overallLogRanks = c(1.52, 1.38, 2.9) ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticSurvival} # @refFS[Formula]{fs:pValuesSurvivalAlternativeGreater} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x1 <- getAnalysisResults(design1, dataExample1, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results expect_equal(x1$thetaH1, 2.5622461, tolerance = 1e-07) expect_equal(x1$testActions, c("continue", "continue", "reject")) expect_equal(x1$conditionalRejectionProbabilities, c(0.076909306, 0.067473058, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.34217973, 0.54553509, 1.325822), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(25.078822, 7.6235796, 4.9517237), tolerance = 1e-07) expect_equal(x1$repeatedPValues, c(0.22249182, 0.19345822, 0.0019646115), tolerance = 1e-07) expect_equal(x1$finalStage, 3) expect_equal(x1$finalPValues, c(NA_real_, NA_real_, 0.0074535505), tolerance = 1e-07) expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 1.222663), tolerance = 1e-07) expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 4.752454), tolerance = 1e-07) expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, 2.4764002), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$thetaH1, x1$thetaH1, tolerance = 1e-05) expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-05) expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticSurvival} # @refFS[Formula]{fs:pValuesSurvivalAlternativeGreater} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x2 <- getAnalysisResults(design1, dataExample1, stage = 2, nPlanned = 40, allocationRatioPlanned = 2, thetaH1 = 2, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results expect_equal(x2$testActions, c("continue", "continue", NA_character_)) expect_equal(x2$conditionalRejectionProbabilities, c(0.076909306, 0.067473058, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, 0.70906065), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.34217973, 0.54553509, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(25.078822, 7.6235796, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues, c(0.22249182, 0.19345822, NA_real_), tolerance = 1e-07) expect_equal(x2$finalStage, NA_integer_) expect_equal(x2$finalPValues, c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-05) expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData1 <- testGetAnalysisResultsPlotData(x2, thetaRange = seq(1, 2.5, 0.05)) ## Comparison of the results of list object 'plotData1' with expected results expect_equal(plotData1$xValues, c(1, 1.05, 1.1, 1.15, 1.2, 1.25, 1.3, 1.35, 1.4, 1.45, 1.5, 1.55, 1.6, 1.65, 1.7, 1.75, 1.8, 1.85, 1.9, 1.95, 2, 2.05, 2.1, 2.15, 2.2, 2.25, 2.3, 2.35, 2.4, 2.45, 2.5), tolerance = 1e-07) expect_equal(plotData1$condPowerValues, c(0.06476941, 0.085271856, 0.10901882, 0.13583313, 0.16543943, 0.19748538, 0.23156461, 0.26723929, 0.30406079, 0.34158746, 0.37939899, 0.41710731, 0.45436408, 0.49086519, 0.52635279, 0.5606151, 0.59348472, 0.62483573, 0.65458006, 0.68266335, 0.70906065, 0.73377215, 0.75681902, 0.77823954, 0.79808559, 0.81641944, 0.83331101, 0.84883539, 0.86307085, 0.87609709, 0.88799385), tolerance = 1e-07) expect_equal(plotData1$likelihoodValues, c(0.38589113, 0.43767503, 0.48942229, 0.54046191, 0.59019718, 0.63811141, 0.6837696, 0.72681695, 0.76697506, 0.8040366, 0.83785893, 0.86835727, 0.89549763, 0.91928996, 0.93978142, 0.95705021, 0.97119988, 0.98235405, 0.99065189, 0.99624395, 0.99928862, 0.99994909, 0.9983907, 0.99477877, 0.98927675, 0.98204476, 0.97323838, 0.96300773, 0.95149676, 0.93884271, 0.92517582), tolerance = 1e-07) expect_equal(plotData1$main, "Conditional Power with Likelihood") expect_equal(plotData1$xlab, "Hazard ratio") expect_equal(plotData1$ylab, "Conditional power / Likelihood") expect_equal(plotData1$sub, "Stage = 2, maximum number of remaining events = 40, allocation ratio = 2") # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticSurvival} # @refFS[Formula]{fs:pValuesSurvivalAlternativeGreater} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x3 <- getAnalysisResults(design1, dataExample1, thetaH0 = 0.95, stage = 2, nPlanned = 40, allocationRatioPlanned = 2, thetaH1 = 2, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x3' with expected results expect_equal(x3$testActions, c("continue", "continue", NA_character_)) expect_equal(x3$conditionalRejectionProbabilities, c(0.083820262, 0.07871372, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.78366367), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.34217973, 0.54553509, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(25.078822, 7.6235796, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues, c(0.20477831, 0.16773576, NA_real_), tolerance = 1e-07) expect_equal(x3$finalStage, NA_integer_) expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-05) expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData2 <- testGetAnalysisResultsPlotData(x3, thetaRange = seq(1, 2.5, 0.05)) ## Comparison of the results of list object 'plotData2' with expected results expect_equal(plotData2$xValues, c(1, 1.05, 1.1, 1.15, 1.2, 1.25, 1.3, 1.35, 1.4, 1.45, 1.5, 1.55, 1.6, 1.65, 1.7, 1.75, 1.8, 1.85, 1.9, 1.95, 2, 2.05, 2.1, 2.15, 2.2, 2.25, 2.3, 2.35, 2.4, 2.45, 2.5), tolerance = 1e-07) expect_equal(plotData2$condPowerValues, c(0.099931978, 0.12787889, 0.15919322, 0.19345089, 0.23014743, 0.26873157, 0.30863607, 0.34930399, 0.39020957, 0.43087349, 0.47087287, 0.50984669, 0.54749733, 0.58358921, 0.61794519, 0.65044149, 0.6810018, 0.70959089, 0.73620831, 0.7608822, 0.78366367, 0.80462154, 0.82383789, 0.841404, 0.85741704, 0.87197725, 0.88518567, 0.8971423, 0.90794467, 0.91768682, 0.92645845), tolerance = 1e-07) expect_equal(plotData2$likelihoodValues, c(0.38589113, 0.43767503, 0.48942229, 0.54046191, 0.59019718, 0.63811141, 0.6837696, 0.72681695, 0.76697506, 0.8040366, 0.83785893, 0.86835727, 0.89549763, 0.91928996, 0.93978142, 0.95705021, 0.97119988, 0.98235405, 0.99065189, 0.99624395, 0.99928862, 0.99994909, 0.9983907, 0.99477877, 0.98927675, 0.98204476, 0.97323838, 0.96300773, 0.95149676, 0.93884271, 0.92517582), tolerance = 1e-07) expect_equal(plotData2$main, "Conditional Power with Likelihood") expect_equal(plotData2$xlab, "Hazard ratio") expect_equal(plotData2$ylab, "Conditional power / Likelihood") expect_equal(plotData2$sub, "Stage = 2, maximum number of remaining events = 40, allocation ratio = 2") }) test_that("'getAnalysisResults' for a three-stage ggroup sequential design and survival data ('directionUpper' reversed)", { .skipTestIfDisabled() design2 <- getDesignGroupSequential(kMax = 3, alpha = 0.025, informationRates = c(0.2, 0.4, 1), bindingFutility = FALSE, typeOfDesign = "WT", deltaWT = 0.25, futilityBounds = c(0, 0)) dataExample2 <- getDataset( overallEvents = c(8, 15, 40), overallAllocationRatios = c(1, 1, 1), overallLogRanks = -c(1.52, 1.38, 2.9) ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticSurvival} # @refFS[Formula]{fs:pValuesSurvivalAlternativeSmaller} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x1 <- getAnalysisResults(design2, dataExample2, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results expect_equal(x1$thetaH1, 0.3996922, tolerance = 1e-07) expect_equal(x1$testActions, c("continue", "continue", "reject")) expect_equal(x1$conditionalRejectionProbabilities, c(0.076909306, 0.067473058, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.039874281, 0.13117197, 0.21029804), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(2.9224407, 1.8330627, 0.75965452), tolerance = 1e-07) expect_equal(x1$repeatedPValues, c(0.22249182, 0.19345822, 0.0019646115), tolerance = 1e-07) expect_equal(x1$finalStage, 3) expect_equal(x1$finalPValues, c(NA_real_, NA_real_, 0.0074535505), tolerance = 1e-07) expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.21888803), tolerance = 1e-07) expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.82206073), tolerance = 1e-07) expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.41319107), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$thetaH1, x1$thetaH1, tolerance = 1e-05) expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-05) expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticSurvival} # @refFS[Formula]{fs:pValuesSurvivalAlternativeSmaller} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x2 <- getAnalysisResults(design2, dataExample2, thetaH0 = 1.1, stage = 2, nPlanned = 40, allocationRatioPlanned = 0.5, thetaH1 = 0.5, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results expect_equal(x2$testActions, c("continue", "continue", NA_character_)) expect_equal(x2$conditionalRejectionProbabilities, c(0.090220506, 0.08944509, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, 0.83779047), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.039874281, 0.13117197, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(2.9224407, 1.8330627, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues, c(0.19034734, 0.14768766, NA_real_), tolerance = 1e-07) expect_equal(x2$finalStage, NA_integer_) expect_equal(x2$finalPValues, c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-05) expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData1 <- testGetAnalysisResultsPlotData(x2, thetaRange = seq(0.4, 1, 0.05)) ## Comparison of the results of list object 'plotData1' with expected results expect_equal(plotData1$xValues, c(0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 1), tolerance = 1e-07) expect_equal(plotData1$condPowerValues, c(0.95060038, 0.90312097, 0.83779047, 0.7584288, 0.67069735, 0.58050999, 0.49291957, 0.41159422, 0.33875526, 0.27538378, 0.22153368, 0.17664644, 0.1398156), tolerance = 1e-07) expect_equal(plotData1$likelihoodValues, c(0.92517582, 0.98626675, 0.99928862, 0.9755955, 0.92648393, 0.86161675, 0.78854281, 0.71277663, 0.63811141, 0.56698955, 0.50084781, 0.44040564, 0.38589113), tolerance = 1e-07) expect_equal(plotData1$main, "Conditional Power with Likelihood") expect_equal(plotData1$xlab, "Hazard ratio") expect_equal(plotData1$ylab, "Conditional power / Likelihood") expect_equal(plotData1$sub, "Stage = 2, maximum number of remaining events = 40, allocation ratio = 0.5") }) context("Testing the Analysis Survival Functionality for the Inverse Normal Design") test_that("'getAnalysisResults' for a three-stage inverse normal design and survival data", { .skipTestIfDisabled() design3 <- getDesignInverseNormal(kMax = 3, alpha = 0.025, informationRates = c(0.4, 0.6, 1), bindingFutility = FALSE, typeOfDesign = "WT", deltaWT = 0.25, futilityBounds = c(0.2, 0.2)) dataExample3 <- getDataset( overallEvents = c(8, 15, 29), overallAllocationRatios = c(1, 1, 1), overallLogRanks = c(1.52, 1.38, 2.9) ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticSurvival} # @refFS[Formula]{fs:pValuesSurvivalAlternativeGreater} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x1 <- getAnalysisResults(design3, dataExample3, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsInverseNormal object 'x1' with expected results expect_equal(x1$thetaH1, 2.9359555, tolerance = 1e-07) expect_equal(x1$testActions, c("continue", "continue", "reject")) expect_equal(x1$conditionalRejectionProbabilities, c(0.088442162, 0.068047477, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.46058716, 0.62720212, 1.3462647), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(18.631576, 7.3754243, 6.4004419), tolerance = 1e-07) expect_equal(x1$repeatedPValues, c(0.16451426, 0.14162994, 0.0024185596), tolerance = 1e-07) expect_equal(x1$finalStage, 3) expect_equal(x1$finalPValues, c(NA_real_, NA_real_, 0.012073682), tolerance = 1e-07) expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 1.1608546), tolerance = 1e-07) expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 5.9479756), tolerance = 1e-07) expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, 2.7535435), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$thetaH1, x1$thetaH1, tolerance = 1e-05) expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-05) expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticSurvival} # @refFS[Formula]{fs:pValuesSurvivalAlternativeGreater} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x2 <- getAnalysisResults(design3, stage = 1, nPlanned = c(20, 40), allocationRatioPlanned = 2, thetaH1 = 2, dataExample3, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsInverseNormal object 'x2' with expected results expect_equal(x2$testActions, c("continue", NA_character_, NA_character_)) expect_equal(x2$conditionalRejectionProbabilities, c(0.088442162, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower, c(NA_real_, 0.31420758, 0.86797577), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.46058716, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(18.631576, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues, c(0.16451426, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$finalStage, NA_integer_) expect_equal(x2$finalPValues, c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-05) expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData1 <- testGetAnalysisResultsPlotData(x2, thetaRange = seq(1, 2.5, 0.05)) ## Comparison of the results of list object 'plotData1' with expected results expect_equal(plotData1$xValues, c(1, 1.05, 1.1, 1.15, 1.2, 1.25, 1.3, 1.35, 1.4, 1.45, 1.5, 1.55, 1.6, 1.65, 1.7, 1.75, 1.8, 1.85, 1.9, 1.95, 2, 2.05, 2.1, 2.15, 2.2, 2.25, 2.3, 2.35, 2.4, 2.45, 2.5), tolerance = 1e-07) expect_equal(plotData1$condPowerValues, c(0.088421701, 0.1185973, 0.15385139, 0.19371622, 0.23749985, 0.28435066, 0.33332759, 0.38346727, 0.43384172, 0.48360335, 0.53201578, 0.57847144, 0.62249749, 0.66375267, 0.70201741, 0.73717966, 0.7692185, 0.79818706, 0.82419601, 0.84739829, 0.86797577, 0.88612785, 0.90206209, 0.91598687, 0.92810573, 0.93861331, 0.9476925, 0.95551278, 0.96222928, 0.96798255, 0.97289882), tolerance = 1e-07) expect_equal(plotData1$likelihoodValues, c(0.31499453, 0.34899387, 0.38312084, 0.41715372, 0.4508945, 0.48416833, 0.51682261, 0.54872573, 0.57976566, 0.60984848, 0.63889683, 0.66684839, 0.69365439, 0.71927824, 0.74369416, 0.76688598, 0.78884594, 0.80957369, 0.82907527, 0.84736227, 0.86445102, 0.88036187, 0.89511858, 0.90874767, 0.92127801, 0.93274029, 0.94316663, 0.95259025, 0.96104517, 0.96856586, 0.97518711), tolerance = 1e-07) expect_equal(plotData1$main, "Conditional Power with Likelihood") expect_equal(plotData1$xlab, "Hazard ratio") expect_equal(plotData1$ylab, "Conditional power / Likelihood") expect_equal(plotData1$sub, "Stage = 1, maximum number of remaining events = 60, allocation ratio = 2") # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticSurvival} # @refFS[Formula]{fs:pValuesSurvivalAlternativeGreater} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x3 <- getAnalysisResults(design3, dataExample3, thetaH0 = 0.95, stage = 2, nPlanned = 40, allocationRatioPlanned = 2, thetaH1 = 2, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsInverseNormal object 'x3' with expected results expect_equal(x3$testActions, c("continue", "continue", NA_character_)) expect_equal(x3$conditionalRejectionProbabilities, c(0.1007598, 0.085347867, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.80220427), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.46058716, 0.62720212, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(18.631576, 7.3754243, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues, c(0.14859365, 0.12054424, NA_real_), tolerance = 1e-07) expect_equal(x3$finalStage, NA_integer_) expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-05) expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData2 <- testGetAnalysisResultsPlotData(x3, thetaRange = seq(1, 2.5, 0.05)) ## Comparison of the results of list object 'plotData2' with expected results expect_equal(plotData2$xValues, c(1, 1.05, 1.1, 1.15, 1.2, 1.25, 1.3, 1.35, 1.4, 1.45, 1.5, 1.55, 1.6, 1.65, 1.7, 1.75, 1.8, 1.85, 1.9, 1.95, 2, 2.05, 2.1, 2.15, 2.2, 2.25, 2.3, 2.35, 2.4, 2.45, 2.5), tolerance = 1e-07) expect_equal(plotData2$condPowerValues, c(0.11179361, 0.14195425, 0.17543978, 0.21175256, 0.25032518, 0.2905567, 0.33184453, 0.37361059, 0.415321, 0.45649966, 0.49673619, 0.53568916, 0.57308562, 0.60871782, 0.642438, 0.67415198, 0.70381218, 0.73141052, 0.75697152, 0.7805458, 0.80220427, 0.8220329, 0.84012825, 0.8565936, 0.87153581, 0.88506274, 0.89728115, 0.90829517, 0.91820505, 0.92710634, 0.93508929), tolerance = 1e-07) expect_equal(plotData2$likelihoodValues, c(0.38589113, 0.43767503, 0.48942229, 0.54046191, 0.59019718, 0.63811141, 0.6837696, 0.72681695, 0.76697506, 0.8040366, 0.83785893, 0.86835727, 0.89549763, 0.91928996, 0.93978142, 0.95705021, 0.97119988, 0.98235405, 0.99065189, 0.99624395, 0.99928862, 0.99994909, 0.9983907, 0.99477877, 0.98927675, 0.98204476, 0.97323838, 0.96300773, 0.95149676, 0.93884271, 0.92517582), tolerance = 1e-07) expect_equal(plotData2$main, "Conditional Power with Likelihood") expect_equal(plotData2$xlab, "Hazard ratio") expect_equal(plotData2$ylab, "Conditional power / Likelihood") expect_equal(plotData2$sub, "Stage = 2, maximum number of remaining events = 40, allocation ratio = 2") }) test_that("'getAnalysisResults' for a three-stage inverse normal design and survival data ('directionUpper' reversed)", { .skipTestIfDisabled() design4 <- getDesignInverseNormal(kMax = 3, alpha = 0.025, informationRates = c(0.4, 0.6, 1), bindingFutility = FALSE, typeOfDesign = "WT", deltaWT = 0.25, futilityBounds = c(0.2, 0.2)) dataExample4 <- getDataset( overallEvents = c(8, 15, 29), overallAllocationRatios = c(1, 1, 1), overallLogRanks = -c(1.52, 1.38, 2.9) ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticSurvival} # @refFS[Formula]{fs:pValuesSurvivalAlternativeSmaller} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x1 <- getAnalysisResults(design4, dataExample4, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsInverseNormal object 'x1' with expected results expect_equal(x1$thetaH1, 0.34060461, tolerance = 1e-07) expect_equal(x1$testActions, c("continue", "continue", "reject")) expect_equal(x1$conditionalRejectionProbabilities, c(0.088442162, 0.068047477, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.053672215, 0.13558542, 0.1562393), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(2.1711417, 1.5943825, 0.74279586), tolerance = 1e-07) expect_equal(x1$repeatedPValues, c(0.16451426, 0.14162994, 0.0024185596), tolerance = 1e-07) expect_equal(x1$finalStage, 3) expect_equal(x1$finalPValues, c(NA_real_, NA_real_, 0.012073682), tolerance = 1e-07) expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.16812443), tolerance = 1e-07) expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.86143434), tolerance = 1e-07) expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.3631684), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$thetaH1, x1$thetaH1, tolerance = 1e-05) expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-05) expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticSurvival} # @refFS[Formula]{fs:pValuesSurvivalAlternativeSmaller} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x2 <- getAnalysisResults(design4, dataExample4, thetaH0 = 1.1, stage = 2, nPlanned = 40, allocationRatioPlanned = 0.5, thetaH1 = 0.5, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsInverseNormal object 'x2' with expected results expect_equal(x2$testActions, c("continue", "continue", NA_character_)) expect_equal(x2$conditionalRejectionProbabilities, c(0.11248903, 0.10265841, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, 0.8608569), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.053672215, 0.13558542, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(2.1711417, 1.5943825, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues, c(0.13581063, 0.1043566, NA_real_), tolerance = 1e-07) expect_equal(x2$finalStage, NA_integer_) expect_equal(x2$finalPValues, c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-05) expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData1 <- testGetAnalysisResultsPlotData(x2, thetaRange = seq(0.4, 1, 0.05)) ## Comparison of the results of list object 'plotData1' with expected results expect_equal(plotData1$xValues, c(0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 1), tolerance = 1e-07) expect_equal(plotData1$condPowerValues, c(0.95989447, 0.91898875, 0.8608569, 0.78814959, 0.70560814, 0.61865802, 0.53228335, 0.45038602, 0.37558279, 0.3092947, 0.25198255, 0.20342172, 0.16295428), tolerance = 1e-07) expect_equal(plotData1$likelihoodValues, c(0.92517582, 0.98626675, 0.99928862, 0.9755955, 0.92648393, 0.86161675, 0.78854281, 0.71277663, 0.63811141, 0.56698955, 0.50084781, 0.44040564, 0.38589113), tolerance = 1e-07) expect_equal(plotData1$main, "Conditional Power with Likelihood") expect_equal(plotData1$xlab, "Hazard ratio") expect_equal(plotData1$ylab, "Conditional power / Likelihood") expect_equal(plotData1$sub, "Stage = 2, maximum number of remaining events = 40, allocation ratio = 0.5") }) context("Testing the Analysis Survival Functionality for the Fisher Design") test_that("'getAnalysisResults' for a three-stage Fisher design and 'bindingFutility = TRUE'", { .skipTestIfDisabled() design5 <- getDesignFisher(kMax = 3, alpha = 0.025, informationRates = c(0.4, 0.6, 1), alpha0Vec = c(0.5,0.4), bindingFutility = TRUE) dataExample5 <- getDataset( overallEvents = c(8, 15), overallAllocationRatios = c(1, 1), overallLogRanks = c(1.52, 2) ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticSurvival} # @refFS[Formula]{fs:pValuesSurvivalAlternativeGreater} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} x1 <- getAnalysisResults(design5, dataExample5, thetaH1 = 2, allocationRatioPlanned = 2, nPlanned = 50, directionUpper = TRUE, seed = 123456789) ## Comparison of the results of AnalysisResultsFisher object 'x1' with expected results expect_equal(x1$testActions, c("continue", "continue", NA_character_)) expect_equal(x1$conditionalRejectionProbabilities, c(0.043454839, 0.062873928, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, 0.78212896), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.63614226, 0.82191364, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(13.489852, 9.7381024, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues, c(0.094302989, 0.05707734, NA_real_), tolerance = 1e-07) expect_equal(x1$finalStage, NA_integer_) expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-05) expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults' for a three-stage Fisher design and 'bindingFutility = TRUE' ('directionUpper' reversed)", { .skipTestIfDisabled() design6 <- getDesignFisher(kMax = 3, alpha = 0.025, informationRates = c(0.4, 0.6, 1), alpha0Vec = c(0.5,0.4), bindingFutility = TRUE) dataExample6 <- getDataset( overallEvents = c(8, 15), overallAllocationRatios = c(1, 1), overallLogRanks = -c(1.52, 2) ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticSurvival} # @refFS[Formula]{fs:pValuesSurvivalAlternativeSmaller} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} x1 <- getAnalysisResults(design6, dataExample6, thetaH1 = 0.5, allocationRatioPlanned = 0.5, nPlanned = 50, directionUpper = FALSE, seed = 123456789) ## Comparison of the results of AnalysisResultsFisher object 'x1' with expected results expect_equal(x1$testActions, c("continue", "continue", NA_character_)) expect_equal(x1$conditionalRejectionProbabilities, c(0.043454839, 0.062873928, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, 0.78212896), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.074129584, 0.10268931, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(1.5719754, 1.2166725, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues, c(0.094302989, 0.05707734, NA_real_), tolerance = 1e-07) expect_equal(x1$finalStage, NA_integer_) expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-05) expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults' with a dataset of survival data and without defining a design", { .skipTestIfDisabled() data <- getDataset( overallEvents = c(38), overallAllocationRatios = c(1), overallLogRanks = -c(1.72) ) # @refFS[Formula]{fs:testStatisticSurvival} # @refFS[Formula]{fs:pValuesSurvivalAlternativeGreater} analysisResults1 <- getAnalysisResults(data, alpha = 0.05, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsInverseNormal object 'analysisResults1' with expected results expect_equal(analysisResults1$thetaH1, 0.57232877, tolerance = 1e-07) expect_equal(analysisResults1$testActions, "reject") expect_equal(analysisResults1$repeatedConfidenceIntervalLowerBounds, 0.33564434, tolerance = 1e-07) expect_equal(analysisResults1$repeatedConfidenceIntervalUpperBounds, 0.97591411, tolerance = 1e-07) expect_equal(analysisResults1$repeatedPValues, 0.042716221, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(analysisResults1), NA))) expect_output(print(analysisResults1)$show()) invisible(capture.output(expect_error(summary(analysisResults1), NA))) expect_output(summary(analysisResults1)$show()) analysisResults1CodeBased <- eval(parse(text = getObjectRCode(analysisResults1, stringWrapParagraphWidth = NULL))) expect_equal(analysisResults1CodeBased$thetaH1, analysisResults1$thetaH1, tolerance = 1e-05) expect_equal(analysisResults1CodeBased$testActions, analysisResults1$testActions, tolerance = 1e-05) expect_equal(analysisResults1CodeBased$repeatedConfidenceIntervalLowerBounds, analysisResults1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(analysisResults1CodeBased$repeatedConfidenceIntervalUpperBounds, analysisResults1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(analysisResults1CodeBased$repeatedPValues, analysisResults1$repeatedPValues, tolerance = 1e-05) expect_type(names(analysisResults1), "character") df <- as.data.frame(analysisResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(analysisResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:testStatisticSurvival} # @refFS[Formula]{fs:pValuesSurvivalAlternativeGreater} analysisResults2 <- getAnalysisResults(data, alpha = 0.05, sided = 2) ## Comparison of the results of AnalysisResultsInverseNormal object 'analysisResults2' with expected results expect_equal(analysisResults2$thetaH1, 0.57232877, tolerance = 1e-07) expect_equal(analysisResults2$testActions, "accept") expect_equal(analysisResults2$repeatedConfidenceIntervalLowerBounds, 0.3030255, tolerance = 1e-07) expect_equal(analysisResults2$repeatedConfidenceIntervalUpperBounds, 1.0809654, tolerance = 1e-07) expect_equal(analysisResults2$repeatedPValues, 0.085432442, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(analysisResults2), NA))) expect_output(print(analysisResults2)$show()) invisible(capture.output(expect_error(summary(analysisResults2), NA))) expect_output(summary(analysisResults2)$show()) analysisResults2CodeBased <- eval(parse(text = getObjectRCode(analysisResults2, stringWrapParagraphWidth = NULL))) expect_equal(analysisResults2CodeBased$thetaH1, analysisResults2$thetaH1, tolerance = 1e-05) expect_equal(analysisResults2CodeBased$testActions, analysisResults2$testActions, tolerance = 1e-05) expect_equal(analysisResults2CodeBased$repeatedConfidenceIntervalLowerBounds, analysisResults2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(analysisResults2CodeBased$repeatedConfidenceIntervalUpperBounds, analysisResults2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(analysisResults2CodeBased$repeatedPValues, analysisResults2$repeatedPValues, tolerance = 1e-05) expect_type(names(analysisResults2), "character") df <- as.data.frame(analysisResults2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(analysisResults2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) rpact/tests/testthat/helper-f_analysis_base_survival.R0000644000175000017500000000360214145656365023214 0ustar nileshnilesh## | ## | *Unit tests helper functions* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | testGetAnalysisResultsPlotData <- function(x, ..., nPlanned = NA_real_, stage = NA_integer_, allocationRatioPlanned = NA_real_) { plotArgs <- .getAnalysisResultsPlotArguments(x = x, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned) if (x$getDataInput()$isDatasetMeans()) { assumedStDev <- .getOptionalArgument("assumedStDev", ...) if (is.null(assumedStDev)) { assumedStDev <- x$assumedStDev return(.getConditionalPowerPlot(stageResults = plotArgs$stageResults, nPlanned = plotArgs$nPlanned, allocationRatioPlanned = plotArgs$allocationRatioPlanned, assumedStDev = assumedStDev, ...)) } } else if (x$getDataInput()$isDatasetRates()) { pi2 <- .getOptionalArgument("pi2", ...) if (is.null(pi2)) { pi2 <- x$pi2 return(.getConditionalPowerPlot(stageResults = plotArgs$stageResults, nPlanned = plotArgs$nPlanned, allocationRatioPlanned = plotArgs$allocationRatioPlanned, pi2 = pi2, ...)) } } return(.getConditionalPowerPlot(stageResults = plotArgs$stageResults, nPlanned = plotArgs$nPlanned, allocationRatioPlanned = plotArgs$allocationRatioPlanned, ...)) } rpact/tests/testthat/test-f_simulation_enrichment_means.R0000644000175000017500000014020114156371262023714 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_simulation_enrichment_means.R ## | Creation date: 14 December 2021, 13:06:20 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Simulation Enrichment Means Function") test_that("'getSimulationEnrichmentMeans': gMax = 2", { options(warn = -1) # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:enrichmentDesigns} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:subsec:adaptiveClosedTestProcedureEnrichment} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:sec:simulationFunctions} # @refFS[Sec.]{fs:sec:simulatingEnrichmentDesigns} # @refFS[Sec.]{fs:sec:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:stratifiedtTestEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichment} # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:simulationEnrichmentMeansGenerate} # @refFS[Formula]{fs:simulationEnrichmentSelections} # @refFS[Formula]{fs:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:enrichmentRejectionRule} effects <- matrix(c(0, 0, 0, 0.25, 0.25, 0.25, 0.5, 0.5, 0.5, 0, 0.25, 0.5, 0, 0.25, 0.5, 0, 0.25, 0.5), ncol = 2) effectList <- list(subGroups = c("S", "R"), prevalences = c(0.2, 0.8), stDevs = 0.8, effects = effects) design <- getDesignInverseNormal(informationRates = c(0.3, 1), typeOfDesign = "asUser", userAlphaSpending = c(0.01, 0.025)) suppressWarnings(simResult1 <- getSimulationEnrichmentMeans(design, populations = 2, plannedSubjects = c(60, 160), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 0.5, typeOfSelection = "epsilon", epsilonValue = 0.1, successCriterion = "atLeastOne", intersectionTest = "SpiessensDebois", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentMeans object 'simResult1' with expected results expect_equal(simResult1$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult1$iterations[2, ], c(98, 95, 78, 99, 86, 71, 94, 85, 50)) expect_equal(simResult1$rejectAtLeastOne, c(0.03, 0.16, 0.67, 0.18, 0.42, 0.74, 0.75, 0.75, 0.92), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$rejectedPopulationsPerStage)), c(0.01, 0.01, 0, 0, 0.02, 0.01, 0.01, 0.16, 0.02, 0.15, 0, 0.06, 0.05, 0.67, 0.05, 0.49, 0.08, 0.21, 0.01, 0, 0.05, 0.11, 0.22, 0.44, 0.01, 0.01, 0.13, 0.14, 0.29, 0.39, 0.01, 0.02, 0.13, 0.13, 0.49, 0.24), tolerance = 1e-07) expect_equal(simResult1$futilityPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult1$earlyStop[1, ], c(0.02, 0.05, 0.22, 0.01, 0.14, 0.29, 0.06, 0.15, 0.5), tolerance = 1e-07) expect_equal(simResult1$successPerStage[1, ], c(0.02, 0.05, 0.22, 0.01, 0.14, 0.29, 0.06, 0.15, 0.5), tolerance = 1e-07) expect_equal(simResult1$successPerStage[2, ], c(0.01, 0.11, 0.45, 0.17, 0.28, 0.45, 0.69, 0.6, 0.42), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$selectedPopulations)), c(1, 0.52, 1, 0.37, 1, 0.23, 1, 0.7, 1, 0.5, 1, 0.34, 1, 0.82, 1, 0.66, 1, 0.31, 1, 0.65, 1, 0.7, 1, 0.67, 1, 0.41, 1, 0.52, 1, 0.51, 1, 0.18, 1, 0.37, 1, 0.29), tolerance = 1e-07) expect_equal(simResult1$numberOfPopulations[1, ], c(2, 2, 2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult1$numberOfPopulations[2, ], c(1.1938776, 1.1263158, 1.1538462, 1.1212121, 1.1860465, 1.1971831, 1.0638298, 1.2117647, 1.2), tolerance = 1e-07) expect_equal(simResult1$expectedNumberOfSubjects, c(158, 155, 138, 159, 146, 131, 154, 145, 110)) expect_equal(unlist(as.list(simResult1$sampleSizes)), c(12, 46.938776, 12, 41.052632, 12, 31.282051, 12, 66.868687, 12, 51.627907, 12, 42.535211, 12, 84.680851, 12, 65.176471, 12, 53.6, 48, 53.061224, 48, 58.947368, 48, 68.717949, 48, 33.131313, 48, 48.372093, 48, 57.464789, 48, 15.319149, 48, 34.823529, 48, 46.4), tolerance = 1e-07) expect_equal(simResult1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult1$conditionalPowerAchieved[2, ], c(0.047488291, 0.14634991, 0.18288786, 0.12148547, 0.21896362, 0.33298102, 0.17634955, 0.32251361, 0.45476897), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult1), NA))) expect_output(print(simResult1)$show()) invisible(capture.output(expect_error(summary(simResult1), NA))) expect_output(summary(simResult1)$show()) simResult1CodeBased <- eval(parse(text = getObjectRCode(simResult1, stringWrapParagraphWidth = NULL))) expect_equal(simResult1CodeBased$iterations, simResult1$iterations, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectAtLeastOne, simResult1$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectedPopulationsPerStage, simResult1$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$futilityPerStage, simResult1$futilityPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$earlyStop, simResult1$earlyStop, tolerance = 1e-05) expect_equal(simResult1CodeBased$successPerStage, simResult1$successPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$selectedPopulations, simResult1$selectedPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$numberOfPopulations, simResult1$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$expectedNumberOfSubjects, simResult1$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult1CodeBased$sampleSizes, simResult1$sampleSizes, tolerance = 1e-05) expect_equal(simResult1CodeBased$conditionalPowerAchieved, simResult1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult1), "character") df <- as.data.frame(simResult1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult2 <- getSimulationEnrichmentMeans(design, populations = 2, plannedSubjects = c(60, 160), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 0.5, typeOfSelection = "rBest", rValue = 2, successCriterion = "atLeastOne", intersectionTest = "Simes", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentMeans object 'simResult2' with expected results expect_equal(simResult2$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult2$iterations[2, ], c(100, 100, 77, 98, 89, 75, 92, 87, 56)) expect_equal(simResult2$rejectAtLeastOne, c(0.01, 0.13, 0.7, 0.05, 0.41, 0.78, 0.24, 0.49, 0.94), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$rejectedPopulationsPerStage)), c(0, 0, 0, 0.03, 0.01, 0.04, 0.01, 0.02, 0.04, 0.03, 0.02, 0.05, 0.07, 0.15, 0.07, 0.22, 0.04, 0.17, 0, 0.01, 0, 0.13, 0.23, 0.47, 0.01, 0.01, 0.08, 0.29, 0.25, 0.53, 0.01, 0.04, 0.09, 0.33, 0.44, 0.5), tolerance = 1e-07) expect_equal(simResult2$futilityPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult2$earlyStop[1, ], c(0, 0, 0.23, 0.02, 0.11, 0.25, 0.08, 0.13, 0.44), tolerance = 1e-07) expect_equal(simResult2$successPerStage[1, ], c(0, 0, 0.23, 0.02, 0.11, 0.25, 0.08, 0.13, 0.44), tolerance = 1e-07) expect_equal(simResult2$successPerStage[2, ], c(0.01, 0.13, 0.47, 0.03, 0.3, 0.53, 0.16, 0.36, 0.5), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$selectedPopulations)), c(1, 1, 1, 1, 1, 0.77, 1, 0.98, 1, 0.89, 1, 0.75, 1, 0.92, 1, 0.87, 1, 0.56, 1, 1, 1, 1, 1, 0.77, 1, 0.98, 1, 0.89, 1, 0.75, 1, 0.92, 1, 0.87, 1, 0.56), tolerance = 1e-07) expect_equal(simResult2$numberOfPopulations[1, ], c(2, 2, 2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult2$numberOfPopulations[2, ], c(2, 2, 2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult2$expectedNumberOfSubjects, c(160, 160, 137, 158, 149, 135, 152, 147, 116), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$sampleSizes)), c(12, 20, 12, 20, 12, 20, 12, 20, 12, 20, 12, 20, 12, 20, 12, 20, 12, 20, 48, 80, 48, 80, 48, 80, 48, 80, 48, 80, 48, 80, 48, 80, 48, 80, 48, 80)) expect_equal(simResult2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult2$conditionalPowerAchieved[2, ], c(0.068305544, 0.20988473, 0.20468607, 0.13306892, 0.26809268, 0.3042488, 0.16765633, 0.35488797, 0.3840908), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult2), NA))) expect_output(print(simResult2)$show()) invisible(capture.output(expect_error(summary(simResult2), NA))) expect_output(summary(simResult2)$show()) simResult2CodeBased <- eval(parse(text = getObjectRCode(simResult2, stringWrapParagraphWidth = NULL))) expect_equal(simResult2CodeBased$iterations, simResult2$iterations, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectAtLeastOne, simResult2$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectedPopulationsPerStage, simResult2$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$futilityPerStage, simResult2$futilityPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$earlyStop, simResult2$earlyStop, tolerance = 1e-05) expect_equal(simResult2CodeBased$successPerStage, simResult2$successPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$selectedPopulations, simResult2$selectedPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$numberOfPopulations, simResult2$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$expectedNumberOfSubjects, simResult2$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult2CodeBased$sampleSizes, simResult2$sampleSizes, tolerance = 1e-05) expect_equal(simResult2CodeBased$conditionalPowerAchieved, simResult2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult2), "character") df <- as.data.frame(simResult2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult3 <- getSimulationEnrichmentMeans(design, populations = 2, plannedSubjects = c(60, 160), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 0.5, typeOfSelection = "all", successCriterion = "atLeastOne", intersectionTest = "Sidak", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentMeans object 'simResult3' with expected results expect_equal(simResult3$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult3$iterations[2, ], c(100, 100, 76, 98, 90, 76, 92, 88, 56)) expect_equal(simResult3$rejectAtLeastOne, c(0, 0.13, 0.7, 0.05, 0.41, 0.79, 0.24, 0.48, 0.94), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$rejectedPopulationsPerStage)), c(0, 0, 0, 0.03, 0.01, 0.04, 0.01, 0.02, 0.03, 0.04, 0.01, 0.06, 0.07, 0.15, 0.06, 0.23, 0.04, 0.17, 0, 0, 0, 0.13, 0.24, 0.46, 0.01, 0.01, 0.07, 0.3, 0.24, 0.55, 0.01, 0.04, 0.08, 0.33, 0.44, 0.5), tolerance = 1e-07) expect_equal(simResult3$futilityPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(simResult3$earlyStop[1, ], c(0, 0, 0.24, 0.02, 0.1, 0.24, 0.08, 0.12, 0.44), tolerance = 1e-07) expect_equal(simResult3$successPerStage[1, ], c(0, 0, 0.24, 0.02, 0.1, 0.24, 0.08, 0.12, 0.44), tolerance = 1e-07) expect_equal(simResult3$successPerStage[2, ], c(0, 0.13, 0.46, 0.03, 0.31, 0.55, 0.16, 0.36, 0.5), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$selectedPopulations)), c(1, 1, 1, 1, 1, 0.76, 1, 0.98, 1, 0.9, 1, 0.76, 1, 0.92, 1, 0.88, 1, 0.56, 1, 1, 1, 1, 1, 0.76, 1, 0.98, 1, 0.9, 1, 0.76, 1, 0.92, 1, 0.88, 1, 0.56), tolerance = 1e-07) expect_equal(simResult3$numberOfPopulations[1, ], c(2, 2, 2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult3$numberOfPopulations[2, ], c(2, 2, 2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult3$expectedNumberOfSubjects, c(160, 160, 136, 158, 150, 136, 152, 148, 116), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$sampleSizes)), c(12, 20, 12, 20, 12, 20, 12, 20, 12, 20, 12, 20, 12, 20, 12, 20, 12, 20, 48, 80, 48, 80, 48, 80, 48, 80, 48, 80, 48, 80, 48, 80, 48, 80, 48, 80)) expect_equal(simResult3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult3$conditionalPowerAchieved[2, ], c(0.068305544, 0.20988473, 0.2073793, 0.13306892, 0.27600384, 0.31320424, 0.16765633, 0.36196259, 0.3840908), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult3), NA))) expect_output(print(simResult3)$show()) invisible(capture.output(expect_error(summary(simResult3), NA))) expect_output(summary(simResult3)$show()) simResult3CodeBased <- eval(parse(text = getObjectRCode(simResult3, stringWrapParagraphWidth = NULL))) expect_equal(simResult3CodeBased$iterations, simResult3$iterations, tolerance = 1e-05) expect_equal(simResult3CodeBased$rejectAtLeastOne, simResult3$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult3CodeBased$rejectedPopulationsPerStage, simResult3$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$futilityPerStage, simResult3$futilityPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$earlyStop, simResult3$earlyStop, tolerance = 1e-05) expect_equal(simResult3CodeBased$successPerStage, simResult3$successPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$selectedPopulations, simResult3$selectedPopulations, tolerance = 1e-05) expect_equal(simResult3CodeBased$numberOfPopulations, simResult3$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult3CodeBased$expectedNumberOfSubjects, simResult3$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult3CodeBased$sampleSizes, simResult3$sampleSizes, tolerance = 1e-05) expect_equal(simResult3CodeBased$conditionalPowerAchieved, simResult3$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult3), "character") df <- as.data.frame(simResult3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult4 <- getSimulationEnrichmentMeans(design, populations = 2, plannedSubjects = c(60, 160), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 0.5, typeOfSelection = "epsilon", epsilonValue = 0.1, successCriterion = "all", intersectionTest = "Bonferroni", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentMeans object 'simResult4' with expected results expect_equal(simResult4$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100, 100, 100)) expect_equal(simResult4$iterations[2, ], c(62, 86, 95, 80, 91, 98, 95, 93, 93)) expect_equal(simResult4$rejectAtLeastOne, c(0.01, 0.15, 0.63, 0.17, 0.39, 0.71, 0.69, 0.73, 0.9), tolerance = 1e-07) expect_equal(unlist(as.list(simResult4$rejectedPopulationsPerStage)), c(0, 0, 0, 0, 0.02, 0, 0.01, 0.16, 0.02, 0.19, 0, 0.07, 0.05, 0.62, 0.05, 0.52, 0.08, 0.36, 0.01, 0, 0.05, 0.1, 0.22, 0.41, 0.01, 0, 0.12, 0.11, 0.29, 0.37, 0.01, 0.02, 0.13, 0.12, 0.49, 0.23), tolerance = 1e-07) expect_equal(simResult4$futilityPerStage[1, ], c(0.38, 0.14, 0.03, 0.19, 0.08, 0.02, 0.05, 0.04, 0), tolerance = 1e-07) expect_equal(simResult4$earlyStop[1, ], c(0.38, 0.14, 0.05, 0.2, 0.09, 0.02, 0.05, 0.07, 0.07), tolerance = 1e-07) expect_equal(simResult4$successPerStage[1, ], c(0, 0, 0.02, 0.01, 0.01, 0, 0, 0.03, 0.07), tolerance = 1e-07) expect_equal(simResult4$successPerStage[2, ], c(0, 0.13, 0.53, 0.16, 0.3, 0.57, 0.68, 0.61, 0.76), tolerance = 1e-07) expect_equal(unlist(as.list(simResult4$selectedPopulations)), c(1, 0.43, 1, 0.34, 1, 0.26, 1, 0.65, 1, 0.55, 1, 0.41, 1, 0.84, 1, 0.75, 1, 0.51, 1, 0.3, 1, 0.62, 1, 0.8, 1, 0.23, 1, 0.54, 1, 0.75, 1, 0.15, 1, 0.4, 1, 0.59), tolerance = 1e-07) expect_equal(simResult4$numberOfPopulations[1, ], c(2, 2, 2, 2, 2, 2, 2, 2, 2)) expect_equal(simResult4$numberOfPopulations[2, ], c(1.1774194, 1.1162791, 1.1157895, 1.1, 1.1978022, 1.1836735, 1.0421053, 1.2365591, 1.1827957), tolerance = 1e-07) expect_equal(simResult4$expectedNumberOfSubjects, c(122, 146, 155, 140, 151, 158, 155, 153, 153)) expect_equal(unlist(as.list(simResult4$sampleSizes)), c(12, 61.290323, 12, 42.325581, 12, 32.631579, 12, 77, 12, 52.527473, 12, 38.77551, 12, 87.368421, 12, 65.591398, 12, 49.247312, 48, 38.709677, 48, 57.674419, 48, 67.368421, 48, 23, 48, 47.472527, 48, 61.22449, 48, 12.631579, 48, 34.408602, 48, 50.752688), tolerance = 1e-07) expect_equal(simResult4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult4$conditionalPowerAchieved[2, ], c(0.10066083, 0.19572583, 0.27485551, 0.15033827, 0.32882422, 0.47317914, 0.22494724, 0.41529639, 0.62724251), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult4), NA))) expect_output(print(simResult4)$show()) invisible(capture.output(expect_error(summary(simResult4), NA))) expect_output(summary(simResult4)$show()) simResult4CodeBased <- eval(parse(text = getObjectRCode(simResult4, stringWrapParagraphWidth = NULL))) expect_equal(simResult4CodeBased$iterations, simResult4$iterations, tolerance = 1e-05) expect_equal(simResult4CodeBased$rejectAtLeastOne, simResult4$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult4CodeBased$rejectedPopulationsPerStage, simResult4$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$futilityPerStage, simResult4$futilityPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$earlyStop, simResult4$earlyStop, tolerance = 1e-05) expect_equal(simResult4CodeBased$successPerStage, simResult4$successPerStage, tolerance = 1e-05) expect_equal(simResult4CodeBased$selectedPopulations, simResult4$selectedPopulations, tolerance = 1e-05) expect_equal(simResult4CodeBased$numberOfPopulations, simResult4$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult4CodeBased$expectedNumberOfSubjects, simResult4$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult4CodeBased$sampleSizes, simResult4$sampleSizes, tolerance = 1e-05) expect_equal(simResult4CodeBased$conditionalPowerAchieved, simResult4$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult4), "character") df <- as.data.frame(simResult4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationEnrichmentMeans': gMax = 3", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:enrichmentDesigns} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:subsec:adaptiveClosedTestProcedureEnrichment} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:sec:simulationFunctions} # @refFS[Sec.]{fs:sec:simulatingEnrichmentDesigns} # @refFS[Sec.]{fs:sec:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:stratifiedtTestEnrichment} # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:simulationEnrichmentMeansGenerate} # @refFS[Formula]{fs:simulationEnrichmentSelections} # @refFS[Formula]{fs:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:enrichmentRejectionRule} .skipTestIfDisabled() effectList <- list( subGroups = c("S1", "S2", "S12", "R"), prevalences = c(0.05, 0.35, 0.15, 0.45), stDevs = c(2.2, 2.2, 2.2, 2.2), effects = matrix(c( 0.3, 1.1, 0.2, 1.2, 2.3, 3.1, 0.9, 1.2, 3.1, 3.4, 0.3, 0.2, 1.2, 2.4, 3.7, 2.1 ), byrow = TRUE, ncol = 4) ) design <- getDesignInverseNormal(informationRates = c(0.4, 0.8, 1), typeOfDesign = "noEarlyEfficacy") suppressWarnings(simResult1 <- getSimulationEnrichmentMeans(design, populations = 3, plannedSubjects = c(20, 40, 50), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 2, typeOfSelection = "rBest", rValue = 2, adaptations = c(TRUE, FALSE), intersectionTest = "Sidak", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentMeans object 'simResult1' with expected results expect_equal(simResult1$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simResult1$iterations[2, ], c(100, 100, 100, 100)) expect_equal(simResult1$iterations[3, ], c(100, 100, 100, 100)) expect_equal(simResult1$rejectAtLeastOne, c(0.13, 0.74, 0.67, 0.93), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$rejectedPopulationsPerStage)), c(0, 0, 0.01, 0, 0, 0.09, 0, 0, 0.09, 0, 0, 0.5, 0, 0, 0.04, 0, 0, 0.59, 0, 0, 0.59, 0, 0, 0.66, 0, 0, 0.11, 0, 0, 0.47, 0, 0, 0.31, 0, 0, 0.55), tolerance = 1e-07) expect_equal(simResult1$futilityStop, c(0, 0, 0, 0)) expect_equal(simResult1$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(simResult1$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(simResult1$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(simResult1$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(simResult1$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(simResult1$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(simResult1$successPerStage[3, ], c(0.03, 0.41, 0.32, 0.78), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$selectedPopulations)), c(1, 0.54, 0.54, 1, 0.41, 0.41, 1, 0.43, 0.43, 1, 0.64, 0.64, 1, 0.68, 0.68, 1, 0.91, 0.91, 1, 0.94, 0.94, 1, 0.74, 0.74, 1, 0.78, 0.78, 1, 0.68, 0.68, 1, 0.63, 0.63, 1, 0.62, 0.62), tolerance = 1e-07) expect_equal(simResult1$numberOfPopulations[1, ], c(3, 3, 3, 3)) expect_equal(simResult1$numberOfPopulations[2, ], c(2, 2, 2, 2)) expect_equal(simResult1$numberOfPopulations[3, ], c(2, 2, 2, 2)) expect_equal(simResult1$expectedNumberOfSubjects, c(50, 50, 50, 50), tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$sampleSizes)), c(1, 1.18, 0.59, 1, 1.2618182, 0.63090909, 1, 1.3027273, 0.65136364, 1, 1.3109091, 0.65545455, 7, 8.26, 4.13, 7, 8.8327273, 4.4163636, 7, 9.1190909, 4.5595455, 7, 9.1763636, 4.5881818, 3, 3.54, 1.77, 3, 3.7854545, 1.8927273, 3, 3.9081818, 1.9540909, 3, 3.9327273, 1.9663636, 9, 7.02, 3.51, 9, 6.12, 3.06, 9, 5.67, 2.835, 9, 5.58, 2.79), tolerance = 1e-07) expect_equal(simResult1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult1$conditionalPowerAchieved[2, ], c(0, 0, 0, 0)) expect_equal(simResult1$conditionalPowerAchieved[3, ], c(0.14187124, 0.68537367, 0.62195131, 0.87969185), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult1), NA))) expect_output(print(simResult1)$show()) invisible(capture.output(expect_error(summary(simResult1), NA))) expect_output(summary(simResult1)$show()) simResult1CodeBased <- eval(parse(text = getObjectRCode(simResult1, stringWrapParagraphWidth = NULL))) expect_equal(simResult1CodeBased$iterations, simResult1$iterations, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectAtLeastOne, simResult1$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectedPopulationsPerStage, simResult1$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$futilityStop, simResult1$futilityStop, tolerance = 1e-05) expect_equal(simResult1CodeBased$futilityPerStage, simResult1$futilityPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$earlyStop, simResult1$earlyStop, tolerance = 1e-05) expect_equal(simResult1CodeBased$successPerStage, simResult1$successPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$selectedPopulations, simResult1$selectedPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$numberOfPopulations, simResult1$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$expectedNumberOfSubjects, simResult1$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult1CodeBased$sampleSizes, simResult1$sampleSizes, tolerance = 1e-05) expect_equal(simResult1CodeBased$conditionalPowerAchieved, simResult1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult1), "character") df <- as.data.frame(simResult1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult2 <- getSimulationEnrichmentMeans(design, populations = 3, plannedSubjects = c(20, 40, 50), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 2, typeOfSelection = "best", intersectionTest = "Simes", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentMeans object 'simResult2' with expected results expect_equal(simResult2$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simResult2$iterations[2, ], c(100, 100, 100, 100)) expect_equal(simResult2$iterations[3, ], c(100, 100, 100, 100)) expect_equal(simResult2$rejectAtLeastOne, c(0.1, 0.86, 0.64, 0.95), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$rejectedPopulationsPerStage)), c(0, 0, 0, 0, 0, 0.11, 0, 0, 0.09, 0, 0, 0.45, 0, 0, 0.07, 0, 0, 0.52, 0, 0, 0.5, 0, 0, 0.36, 0, 0, 0.03, 0, 0, 0.23, 0, 0, 0.05, 0, 0, 0.14), tolerance = 1e-07) expect_equal(simResult2$futilityStop, c(0, 0, 0, 0)) expect_equal(simResult2$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(simResult2$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(simResult2$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(simResult2$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(simResult2$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(simResult2$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(simResult2$successPerStage[3, ], c(0.1, 0.86, 0.64, 0.95), tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$selectedPopulations)), c(1, 0.38, 0.38, 1, 0.15, 0.15, 1, 0.28, 0.28, 1, 0.46, 0.46, 1, 0.32, 0.32, 1, 0.6, 0.6, 1, 0.59, 0.59, 1, 0.37, 0.37, 1, 0.3, 0.3, 1, 0.25, 0.25, 1, 0.13, 0.13, 1, 0.17, 0.17), tolerance = 1e-07) expect_equal(simResult2$numberOfPopulations[1, ], c(3, 3, 3, 3)) expect_equal(simResult2$numberOfPopulations[2, ], c(1, 1, 1, 1)) expect_equal(simResult2$numberOfPopulations[3, ], c(1, 1, 1, 1)) expect_equal(simResult2$expectedNumberOfSubjects, c(50, 50, 50, 50)) expect_equal(unlist(as.list(simResult2$sampleSizes)), c(1, 2.2, 1.1, 1, 1, 0.5, 1, 1.53, 0.765, 1, 2.47, 1.235, 7, 6.58, 3.29, 7, 10.15, 5.075, 7, 9.17, 4.585, 7, 6.37, 3.185, 3, 8.52, 4.26, 3, 6.6, 3.3, 3, 8.13, 4.065, 3, 9.63, 4.815, 9, 2.7, 1.35, 9, 2.25, 1.125, 9, 1.17, 0.585, 9, 1.53, 0.765), tolerance = 1e-07) expect_equal(simResult2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult2$conditionalPowerAchieved[2, ], c(0, 0, 0, 0)) expect_equal(simResult2$conditionalPowerAchieved[3, ], c(0.17206547, 0.78936731, 0.62458631, 0.92480018), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult2), NA))) expect_output(print(simResult2)$show()) invisible(capture.output(expect_error(summary(simResult2), NA))) expect_output(summary(simResult2)$show()) simResult2CodeBased <- eval(parse(text = getObjectRCode(simResult2, stringWrapParagraphWidth = NULL))) expect_equal(simResult2CodeBased$iterations, simResult2$iterations, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectAtLeastOne, simResult2$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectedPopulationsPerStage, simResult2$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$futilityStop, simResult2$futilityStop, tolerance = 1e-05) expect_equal(simResult2CodeBased$futilityPerStage, simResult2$futilityPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$earlyStop, simResult2$earlyStop, tolerance = 1e-05) expect_equal(simResult2CodeBased$successPerStage, simResult2$successPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$selectedPopulations, simResult2$selectedPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$numberOfPopulations, simResult2$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$expectedNumberOfSubjects, simResult2$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult2CodeBased$sampleSizes, simResult2$sampleSizes, tolerance = 1e-05) expect_equal(simResult2CodeBased$conditionalPowerAchieved, simResult2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult2), "character") df <- as.data.frame(simResult2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult3 <- getSimulationEnrichmentMeans(design, populations = 3, plannedSubjects = c(20, 40, 50), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 2, typeOfSelection = "epsilon", epsilonValue = 0.1, intersectionTest = "Bonferroni", seed = 123 )) ## Comparison of the results of SimulationResultsEnrichmentMeans object 'simResult3' with expected results expect_equal(simResult3$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simResult3$iterations[2, ], c(75, 96, 91, 99)) expect_equal(simResult3$iterations[3, ], c(74, 96, 91, 99)) expect_equal(simResult3$rejectAtLeastOne, c(0.17, 0.71, 0.67, 0.96), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$rejectedPopulationsPerStage)), c(0, 0, 0.04, 0, 0, 0.07, 0, 0, 0.06, 0, 0, 0.49, 0, 0, 0.07, 0, 0, 0.44, 0, 0, 0.57, 0, 0, 0.32, 0, 0, 0.06, 0, 0, 0.2, 0, 0, 0.04, 0, 0, 0.16), tolerance = 1e-07) expect_equal(simResult3$futilityStop, c(0.26, 0.04, 0.09, 0.01), tolerance = 1e-07) expect_equal(simResult3$futilityPerStage[1, ], c(0.25, 0.04, 0.09, 0.01), tolerance = 1e-07) expect_equal(simResult3$futilityPerStage[2, ], c(0.01, 0, 0, 0), tolerance = 1e-07) expect_equal(simResult3$earlyStop[1, ], c(0.25, 0.04, 0.09, 0.01), tolerance = 1e-07) expect_equal(simResult3$earlyStop[2, ], c(0.01, 0, 0, 0), tolerance = 1e-07) expect_equal(simResult3$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(simResult3$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(simResult3$successPerStage[3, ], c(0.17, 0.71, 0.67, 0.96), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$selectedPopulations)), c(1, 0.26, 0.25, 1, 0.2, 0.19, 1, 0.21, 0.17, 1, 0.51, 0.5, 1, 0.27, 0.26, 1, 0.54, 0.51, 1, 0.65, 0.65, 1, 0.33, 0.33, 1, 0.28, 0.23, 1, 0.28, 0.26, 1, 0.13, 0.09, 1, 0.19, 0.17), tolerance = 1e-07) expect_equal(simResult3$numberOfPopulations[1, ], c(3, 3, 3, 3)) expect_equal(simResult3$numberOfPopulations[2, ], c(1.08, 1.0625, 1.0879121, 1.040404), tolerance = 1e-07) expect_equal(simResult3$numberOfPopulations[3, ], c(1, 1, 1, 1.010101), tolerance = 1e-07) expect_equal(simResult3$expectedNumberOfSubjects, c(42.4, 48.8, 47.3, 49.7), tolerance = 1e-07) expect_equal(unlist(as.list(simResult3$sampleSizes)), c(1, 2.0642424, 1, 1, 1.2481061, 0.63020833, 1, 1.1368631, 0.51648352, 1, 2.6023875, 1.3324151, 7, 6.7030303, 3.5472973, 7, 9.3200758, 4.6666667, 7, 10.342657, 5.3461538, 7, 5.9843893, 2.9279155, 3, 7.8727273, 4.0540541, 3, 6.8068182, 3.484375, 3, 7.2347652, 3.6923077, 3, 9.6859504, 4.9669421, 9, 3.36, 1.3986486, 9, 2.625, 1.21875, 9, 1.2857143, 0.44505495, 9, 1.7272727, 0.77272727), tolerance = 1e-07) expect_equal(simResult3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simResult3$conditionalPowerAchieved[2, ], c(0, 0, 0, 0)) expect_equal(simResult3$conditionalPowerAchieved[3, ], c(0.31528472, 0.78554805, 0.74702567, 0.96322954), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult3), NA))) expect_output(print(simResult3)$show()) invisible(capture.output(expect_error(summary(simResult3), NA))) expect_output(summary(simResult3)$show()) simResult3CodeBased <- eval(parse(text = getObjectRCode(simResult3, stringWrapParagraphWidth = NULL))) expect_equal(simResult3CodeBased$iterations, simResult3$iterations, tolerance = 1e-05) expect_equal(simResult3CodeBased$rejectAtLeastOne, simResult3$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult3CodeBased$rejectedPopulationsPerStage, simResult3$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$futilityStop, simResult3$futilityStop, tolerance = 1e-05) expect_equal(simResult3CodeBased$futilityPerStage, simResult3$futilityPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$earlyStop, simResult3$earlyStop, tolerance = 1e-05) expect_equal(simResult3CodeBased$successPerStage, simResult3$successPerStage, tolerance = 1e-05) expect_equal(simResult3CodeBased$selectedPopulations, simResult3$selectedPopulations, tolerance = 1e-05) expect_equal(simResult3CodeBased$numberOfPopulations, simResult3$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult3CodeBased$expectedNumberOfSubjects, simResult3$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult3CodeBased$sampleSizes, simResult3$sampleSizes, tolerance = 1e-05) expect_equal(simResult3CodeBased$conditionalPowerAchieved, simResult3$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult3), "character") df <- as.data.frame(simResult3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationEnrichmentMeans': gMax = 4", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:enrichmentDesigns} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:subsec:adaptiveClosedTestProcedureEnrichment} # @refFS[Sec.]{fs:subsec:intersectionTestsEnrichment} # @refFS[Sec.]{fs:sec:simulationFunctions} # @refFS[Sec.]{fs:sec:simulatingEnrichmentDesigns} # @refFS[Sec.]{fs:sec:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:stratifiedtTestEnrichment} # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:simulationEnrichmentMeansGenerate} # @refFS[Formula]{fs:simulationEnrichmentSelections} # @refFS[Formula]{fs:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:enrichmentRejectionRule} .skipTestIfDisabled() effects <- matrix(c(2.3, 3.1, 0.9, 1.2, 2.1, 3.4, 0.9, 0.2), byrow = TRUE, ncol = 8) effectList <- list(subGroups = c("S1", "S2", "S3", "S12", "S13", "S23", "S123", "R"), prevalences = c(0.1, 0.05, 0.1, 0.15, 0.1, 0.15, 0.3, 0.05), effects = effects, stDevs = c(rep(3.5, 4), rep(4.5, 4))) design <- getDesignInverseNormal(informationRates = c(0.4, 1), typeOfDesign = "noEarlyEfficacy") suppressWarnings(simResult1 <- getSimulationEnrichmentMeans(design, populations = 4, plannedSubjects = c(100, 200), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 2, seed = 123, typeOfSelection = "epsilon", epsilonValue = 0.15, adaptations = c(T), intersectionTest = "Bonferroni", stratifiedAnalysis = TRUE, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA, 50), maxNumberOfSubjectsPerStage = c(NA, 200), thetaH1 = 2, stDevH1 = 3 )) ## Comparison of the results of SimulationResultsEnrichmentMeans object 'simResult1' with expected results expect_equal(simResult1$iterations[1, ], 100) expect_equal(simResult1$iterations[2, ], 97) expect_equal(simResult1$rejectAtLeastOne, 0.54, tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$rejectedPopulationsPerStage)), c(0, 0.12, 0, 0.21, 0, 0.19, 0, 0.08), tolerance = 1e-07) expect_equal(simResult1$futilityPerStage[1, ], 0.03, tolerance = 1e-07) expect_equal(simResult1$earlyStop[1, ], 0.03, tolerance = 1e-07) expect_equal(simResult1$successPerStage[1, ], 0) expect_equal(simResult1$successPerStage[2, ], 0.5, tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$selectedPopulations)), c(1, 0.28, 1, 0.37, 1, 0.37, 1, 0.22), tolerance = 1e-07) expect_equal(simResult1$numberOfPopulations[1, ], 4) expect_equal(simResult1$numberOfPopulations[2, ], 1.2783505, tolerance = 1e-07) expect_equal(simResult1$expectedNumberOfSubjects, 165.08824, tolerance = 1e-07) expect_equal(unlist(as.list(simResult1$sampleSizes)), c(10, 3.9329768, 5, 2.3736653, 10, 5.1412409, 15, 9.6615922, 10, 6.744047, 15, 11.418006, 30, 26.843598, 5, 0.98615092), tolerance = 1e-07) expect_equal(simResult1$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simResult1$conditionalPowerAchieved[2, ], 0.87059965, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult1), NA))) expect_output(print(simResult1)$show()) invisible(capture.output(expect_error(summary(simResult1), NA))) expect_output(summary(simResult1)$show()) simResult1CodeBased <- eval(parse(text = getObjectRCode(simResult1, stringWrapParagraphWidth = NULL))) expect_equal(simResult1CodeBased$iterations, simResult1$iterations, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectAtLeastOne, simResult1$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult1CodeBased$rejectedPopulationsPerStage, simResult1$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$futilityPerStage, simResult1$futilityPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$earlyStop, simResult1$earlyStop, tolerance = 1e-05) expect_equal(simResult1CodeBased$successPerStage, simResult1$successPerStage, tolerance = 1e-05) expect_equal(simResult1CodeBased$selectedPopulations, simResult1$selectedPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$numberOfPopulations, simResult1$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult1CodeBased$expectedNumberOfSubjects, simResult1$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult1CodeBased$sampleSizes, simResult1$sampleSizes, tolerance = 1e-05) expect_equal(simResult1CodeBased$conditionalPowerAchieved, simResult1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult1), "character") df <- as.data.frame(simResult1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } suppressWarnings(simResult2 <- getSimulationEnrichmentMeans(design, populations = 4, plannedSubjects = c(100, 200), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 2, seed = 123, typeOfSelection = "rbest", rValue = 2, adaptations = c(T), intersectionTest = "Sidak", stratifiedAnalysis = TRUE, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA, 50), maxNumberOfSubjectsPerStage = c(NA, 200), thetaH1 = 2, stDevH1 = 3 )) ## Comparison of the results of SimulationResultsEnrichmentMeans object 'simResult2' with expected results expect_equal(simResult2$iterations[1, ], 100) expect_equal(simResult2$iterations[2, ], 100) expect_equal(simResult2$rejectAtLeastOne, 0.55, tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$rejectedPopulationsPerStage)), c(0, 0.19, 0, 0.2, 0, 0.25, 0, 0.28), tolerance = 1e-07) expect_equal(simResult2$futilityPerStage[1, ], 0) expect_equal(simResult2$earlyStop[1, ], 0) expect_equal(simResult2$successPerStage[1, ], 0) expect_equal(simResult2$successPerStage[2, ], 0.37, tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$selectedPopulations)), c(1, 0.41, 1, 0.49, 1, 0.54, 1, 0.56), tolerance = 1e-07) expect_equal(simResult2$numberOfPopulations[1, ], 4) expect_equal(simResult2$numberOfPopulations[2, ], 2) expect_equal(simResult2$expectedNumberOfSubjects, 174.9744, tolerance = 1e-07) expect_equal(unlist(as.list(simResult2$sampleSizes)), c(10, 6.8133223, 5, 3.3795954, 10, 6.9887063, 15, 11.878041, 10, 7.9186938, 15, 11.878041, 30, 23.756082, 5, 2.3619159), tolerance = 1e-07) expect_equal(simResult2$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simResult2$conditionalPowerAchieved[2, ], 0.81461286, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simResult2), NA))) expect_output(print(simResult2)$show()) invisible(capture.output(expect_error(summary(simResult2), NA))) expect_output(summary(simResult2)$show()) simResult2CodeBased <- eval(parse(text = getObjectRCode(simResult2, stringWrapParagraphWidth = NULL))) expect_equal(simResult2CodeBased$iterations, simResult2$iterations, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectAtLeastOne, simResult2$rejectAtLeastOne, tolerance = 1e-05) expect_equal(simResult2CodeBased$rejectedPopulationsPerStage, simResult2$rejectedPopulationsPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$futilityPerStage, simResult2$futilityPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$earlyStop, simResult2$earlyStop, tolerance = 1e-05) expect_equal(simResult2CodeBased$successPerStage, simResult2$successPerStage, tolerance = 1e-05) expect_equal(simResult2CodeBased$selectedPopulations, simResult2$selectedPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$numberOfPopulations, simResult2$numberOfPopulations, tolerance = 1e-05) expect_equal(simResult2CodeBased$expectedNumberOfSubjects, simResult2$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simResult2CodeBased$sampleSizes, simResult2$sampleSizes, tolerance = 1e-05) expect_equal(simResult2CodeBased$conditionalPowerAchieved, simResult2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simResult2), "character") df <- as.data.frame(simResult2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simResult2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationEnrichmentMeans': comparison of base and enrichment for inverse normal and Fisher combination", { options(warn = 0) # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:enrichmentDesigns} # @refFS[Sec.]{fs:sec:simulationFunctions} # @refFS[Sec.]{fs:sec:simulatingEnrichmentDesigns} # @refFS[Sec.]{fs:sec:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:stratifiedtTestEnrichment} # @refFS[Formula]{fs:simulationEnrichmentMeansGenerate} # @refFS[Formula]{fs:simulationEnrichmentSelections} # @refFS[Formula]{fs:simulatingEnrichmentEffectSpecification} # @refFS[Formula]{fs:enrichmentRejectionRule} .skipTestIfDisabled() options(warn = -1) effectSeq <- seq(0, 0.7, 0.1) effects <- matrix(effectSeq, byrow = TRUE, ncol = 1) effectList <- list(subGroups = "F", prevalences = 1, stDevs = 1.3, effects = effects) design <- getDesignInverseNormal(informationRates = c(0.3, 1), typeOfDesign = "OF", futilityBounds = c(0.1)) suppressWarnings(x1 <- getSimulationEnrichmentMeans(design, populations = 1, plannedSubjects = c(60, 180), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 2, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA, 10), maxNumberOfSubjectsPerStage = c(NA, 180), thetaH1 = 0.5, seed = 123 )) x2 <- getSimulationMeans(design, plannedSubjects = c(60, 180), alternative = effectSeq, maxNumberOfIterations = 100, allocationRatioPlanned = 2, stDev = 1.3, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA, 10), maxNumberOfSubjectsPerStage = c(NA, 180), thetaH1 = 0.5, seed = 123 ) comp1 <- x2$overallReject - x1$rejectAtLeastOne ## Comparison of the results of numeric object 'comp1' with expected results expect_equal(comp1, c(0.02, -0.01, 0.01, -0.03, 0.08, -0.05, 0.04, -0.03), tolerance = 1e-07) comp2 <- x2$conditionalPowerAchieved - x1$conditionalPowerAchieved ## Comparison of the results of matrixarray object 'comp2' with expected results expect_equal(comp2[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(comp2[2, ], c(0.0070281375, -0.0046190664, -0.020739941, -0.011327634, -0.0046695544, 0.0025709653, 0.0032941476, 0.0045055727), tolerance = 1e-07) comp3 <- x2$expectedNumberOfSubjects - x1$expectedNumberOfSubjects ## Comparison of the results of numeric object 'comp3' with expected results expect_equal(comp3, c(-5.9383973, -5.0998562, -5.4120322, 1.2304065, -6.6264122, -15.289639, -4.6069346, -0.41855064), tolerance = 1e-07) design <- getDesignFisher(informationRates = c(0.3, 1), kMax = 2) suppressWarnings(x1 <- getSimulationEnrichmentMeans(design, populations = 1, plannedSubjects = c(60, 180), effectList = effectList, maxNumberOfIterations = 100, allocationRatioPlanned = 2, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA, 10), maxNumberOfSubjectsPerStage = c(NA, 180), thetaH1 = 0.5, seed = 123 )) x2 <- getSimulationMeans(design, plannedSubjects = c(60, 180), alternative = effectSeq, maxNumberOfIterations = 100, allocationRatioPlanned = 2, stDev = 1.3, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA, 10), maxNumberOfSubjectsPerStage = c(NA, 180), thetaH1 = 0.5, seed = 123 ) comp4 <- x2$overallReject - x1$rejectAtLeastOne ## Comparison of the results of numeric object 'comp4' with expected results expect_equal(comp4, c(0, 0, 0.02, -0.01, 0.04, 0.03, 0.07, -0.01), tolerance = 1e-07) comp5 <- x2$conditionalPowerAchieved - x1$conditionalPowerAchieved ## Comparison of the results of matrixarray object 'comp5' with expected results expect_equal(comp5[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(comp5[2, ], c(0, -0.0026724666, -0.020506475, -0.0095136176, -0.01871572, -0.0085381669, -0.0011844682, -0.023030147), tolerance = 1e-07) comp6 <- x2$expectedNumberOfSubjects - x1$expectedNumberOfSubjects ## Comparison of the results of numeric object 'comp6' with expected results expect_equal(comp6, c(0, 3.5569071, 9.4761962, -1.6191689, -3.0007806, -12.622314, 2.072784, -19.12106), tolerance = 1e-07) options(warn = 0) }) rpact/tests/testthat/test-f_analysis_input_validation.R0000644000175000017500000000700414154142422023400 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_analysis_input_validation.R ## | Creation date: 08 December 2021, 09:06:01 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing the Correct Input Validation of All Analysis Functions") test_that("Errors and warnings for calculation of analysis results with dataset of means", { .skipTestIfDisabled() design1 <- getDesignInverseNormal(kMax = 4, alpha = 0.02, futilityBounds = c(-0.5,0,0.5), bindingFutility = FALSE, typeOfDesign = "asKD", gammaA = 1.2, informationRates = c(0.15,0.4,0.7,1)) design3 <- getDesignConditionalDunnett(alpha = 0.02, informationAtInterim = 0.4, secondStageConditioning = TRUE) dataExample1 <- getDataset( n = c(13, 25), means = c(24.2, 22.2), stDevs = c(24.4, 22.1)) dataExample2 <- getDataset( n1 = c(13, 25), n2 = c(15, 27), means1 = c(24.2, 22.2), means2 = c(18.8, 27.7), stDevs1 = c(24.4, 22.1), stDevs2 = c(21.2, 23.7)) dataExample4 <- getDataset( n1 = c(13, 25), n2 = c(15, NA), n3 = c(14, 27), n4 = c(12, 29), means1 = c(24.2, 22.2), means2 = c(18.8, NA), means3 = c(26.7, 27.7), means4 = c(9.2, 12.2), stDevs1 = c(24.4, 22.1), stDevs2 = c(21.2, NA), stDevs3 = c(25.6, 23.2), stDevs4 = c(21.5, 22.7)) expect_error(getAnalysisResults(design = design1, dataInput = dataExample4, intersectionTest = "", varianceOption = "notPooled", nPlanned = c(20, 20))) expect_error(getAnalysisResults(design = design1, dataInput = dataExample4, intersectionTest = "Simes", varianceOption = "X", nPlanned = c(20, 20))) expect_error(getAnalysisResults(design = design1, dataInput = dataExample4, intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20, 30))) expect_error(getAnalysisResults(design = design1, dataInput = dataExample4, intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = 20)) expect_error(getAnalysisResults(design = design1, dataInput = dataExample4, intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c())) expect_error(getAnalysisResults(design = design1, dataInput = dataExample4, intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = numeric(0))) expect_error(getAnalysisResults(design = design3, dataInput = dataExample4, intersectionTest = "Dunnett", varianceOption = "pairwisePooled"), paste0("Illegal argument: variance option ('pairwisePooled') must be 'overallPooled' ", "because conditional Dunnett test was specified as design"), fixed = TRUE) expect_error(getAnalysisResults(design = design1, dataInput = dataExample4, intersectionTest = "Dunnett", varianceOption = "pairwisePooled", nPlanned = c(20, 20)), "Dunnett t test can only be performed with overall variance estimation", fixed = TRUE) expect_error(getConditionalPower(getStageResults(design1, dataInput = dataExample2), nPlanned = c(20, 20), allocationRatioPlanned = -1)) }) rpact/tests/testthat/test-f_simulation_base_survival.R0000644000175000017500000056104014154142422023242 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_simulation_base_survival.R ## | Creation date: 08 December 2021, 09:09:34 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Simulation Survival Function") test_that("'getSimulationSurvival': configuration 1", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationSurvival} # @refFS[Formula]{fs:SimulationSurvivalTimeGenerate} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:SimulationSurvivalLogRank} # @refFS[Formula]{fs:SimulationSurvivalIncrements} # @refFS[Formula]{fs:SimulationSurvivalHazardEstimate} simulationResults <- getSimulationSurvival(maxNumberOfSubjects = 200, plannedEvents = 50, accrualTime = c(0, 3, 6, 12), accrualIntensity = c(0.1, 0.2, 0.2) , maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResults' with expected results expect_equal(simulationResults$median1, c(37.275405, 23.320299, 16.282985, 12), tolerance = 1e-07) expect_equal(simulationResults$median2, 37.275405, tolerance = 1e-07) expect_equal(simulationResults$accrualIntensity, c(9.5238095, 19.047619, 19.047619), tolerance = 1e-07) expect_equal(simulationResults$lambda1, c(0.018595296, 0.029722912, 0.042568802, 0.057762265), tolerance = 1e-07) expect_equal(simulationResults$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(simulationResults$hazardRatio, c(1, 1.5984103, 2.2892242, 3.1062837), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[1, ], c(22.223223, 18.818775, 16.321595, 14.790808), tolerance = 1e-07) expect_equal(simulationResults$studyDuration, c(22.223223, 18.818775, 16.321595, 14.790808), tolerance = 1e-07) expect_equal(simulationResults$eventsNotAchieved[1, ], c(0, 0, 0, 0)) expect_equal(simulationResults$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simulationResults$overallReject, c(0.01, 0.41, 0.81, 1), tolerance = 1e-07) expect_gte(object = simulationResults$overallReject[1], expected = 0) expect_gte(object = simulationResults$overallReject[2], expected = 0) expect_gte(object = simulationResults$overallReject[3], expected = 0) expect_gte(object = simulationResults$overallReject[4], expected = 0) expect_lte(object = simulationResults$overallReject[1], expected = 1) expect_lte(object = simulationResults$overallReject[2], expected = 1) expect_lte(object = simulationResults$overallReject[3], expected = 1) expect_lte(object = simulationResults$overallReject[4], expected = 1) expect_equal(simulationResults$rejectPerStage[1, ], c(0.01, 0.41, 0.81, 1), tolerance = 1e-07) expect_equal(simulationResults$earlyStop, c(0, 0, 0, 0)) expect_equal(simulationResults$expectedNumberOfSubjects, c(200, 200, 200, 200)) expect_equal(simulationResults$expectedNumberOfEvents, c(50, 50, 50, 50)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResults), NA))) expect_output(print(simulationResults)$show()) invisible(capture.output(expect_error(summary(simulationResults), NA))) expect_output(summary(simulationResults)$show()) simulationResultsCodeBased <- eval(parse(text = getObjectRCode(simulationResults, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultsCodeBased$median1, simulationResults$median1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$median2, simulationResults$median2, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$accrualIntensity, simulationResults$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$lambda1, simulationResults$lambda1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$lambda2, simulationResults$lambda2, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$hazardRatio, simulationResults$hazardRatio, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$analysisTime, simulationResults$analysisTime, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$studyDuration, simulationResults$studyDuration, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsNotAchieved, simulationResults$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$iterations, simulationResults$iterations, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$overallReject, simulationResults$overallReject, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$rejectPerStage, simulationResults$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityPerStage, simulationResults$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$earlyStop, simulationResults$earlyStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfSubjects, simulationResults$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfEvents, simulationResults$expectedNumberOfEvents, tolerance = 1e-05) expect_type(names(simulationResults), "character") df <- as.data.frame(simulationResults) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResults) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': configuration 2", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationSurvival} # @refFS[Formula]{fs:SimulationSurvivalTimeGenerate} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:SimulationSurvivalLogRank} # @refFS[Formula]{fs:SimulationSurvivalIncrements} # @refFS[Formula]{fs:SimulationSurvivalHazardEstimate} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} design <- getDesignFisher(kMax = 3, alpha0Vec = c(0.5, 0.5)) simulationResults <- getSimulationSurvival(design = design, pi2 = 0.6, pi1 = seq(0.3, 0.45, 0.05), directionUpper = FALSE, maxNumberOfSubjects = 500, plannedEvents = (1:design$kMax) * 20, allocation1 = 1, allocation2 = 1, accrualTime = c(0, 3, 6, 12), accrualIntensity = c(0.1, 0.2, 0.2) , dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12, conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA_real_, 10, 10), maxNumberOfEventsPerStage = c(NA_real_, 100, 200), maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResults' with expected results expect_equal(simulationResults$median1, c(23.320299, 19.308487, 16.282985, 13.9131), tolerance = 1e-07) expect_equal(simulationResults$median2, 9.0776496, tolerance = 1e-07) expect_equal(simulationResults$accrualIntensity, c(23.809524, 47.619048, 47.619048), tolerance = 1e-07) expect_equal(simulationResults$lambda1, c(0.029722912, 0.035898576, 0.042568802, 0.04981975), tolerance = 1e-07) expect_equal(simulationResults$lambda2, 0.076357561, tolerance = 1e-07) expect_equal(simulationResults$hazardRatio, c(0.38925958, 0.47013781, 0.55749295, 0.6524534), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[1, ], c(5.4183926, 5.2945044, 5.1495619, 5.0392001), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[2, ], c(10.130549, 10.39649, 10.458778, 9.7641943), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[3, ], c(13.506679, 14.455396, 18.382917, 18.866629), tolerance = 1e-07) expect_equal(simulationResults$studyDuration, c(8.500396, 9.4448778, 11.628285, 12.227203), tolerance = 1e-07) expect_equal(simulationResults$eventsNotAchieved[1, ], c(0, 0, 0, 0)) expect_equal(simulationResults$eventsNotAchieved[2, ], c(0, 0, 0, 0)) expect_equal(simulationResults$eventsNotAchieved[3, ], c(0, 0, 0, 0)) expect_equal(simulationResults$numberOfSubjects[1, ], c(186.51, 180.63, 173.73, 168.48), tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[2, ], c(406.05, 420.67123, 424.60256, 393.44615), tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[3, ], c(428.4, 466.33333, 480.96429, 488.78261), tolerance = 1e-07) expect_equal(simulationResults$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simulationResults$iterations[2, ], c(60, 73, 78, 65)) expect_equal(simulationResults$iterations[3, ], c(5, 9, 28, 46)) expect_equal(simulationResults$overallReject, c(1, 0.93, 0.96, 0.69), tolerance = 1e-07) expect_gte(object = simulationResults$overallReject[1], expected = 0) expect_gte(object = simulationResults$overallReject[2], expected = 0) expect_gte(object = simulationResults$overallReject[3], expected = 0) expect_gte(object = simulationResults$overallReject[4], expected = 0) expect_lte(object = simulationResults$overallReject[1], expected = 1) expect_lte(object = simulationResults$overallReject[2], expected = 1) expect_lte(object = simulationResults$overallReject[3], expected = 1) expect_lte(object = simulationResults$overallReject[4], expected = 1) expect_equal(simulationResults$rejectPerStage[1, ], c(0.4, 0.21, 0.2, 0.13), tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[2, ], c(0.55, 0.63, 0.5, 0.15), tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[3, ], c(0.05, 0.09, 0.26, 0.41), tolerance = 1e-07) expect_equal(simulationResults$futilityStop, c(0, 0.07, 0.02, 0.26), tolerance = 1e-07) expect_equal(simulationResults$futilityPerStage[1, ], c(0, 0.06, 0.02, 0.22), tolerance = 1e-07) expect_equal(simulationResults$futilityPerStage[2, ], c(0, 0.01, 0, 0.04), tolerance = 1e-07) expect_equal(simulationResults$earlyStop, c(0.95, 0.91, 0.72, 0.54), tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfSubjects, c(319.3515, 359.96969, 385.19188, 358.56277), tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfEvents, c(62.22, 80.58, 119.09, 138.58), tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[1, ], c(20, 20, 20, 20)) expect_equal(simulationResults$eventsPerStage[2, ], c(84.483333, 93.054795, 98.884615, 92.015385), tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[3, ], c(155.08333, 173.61035, 233.02747, 248.03712), tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simulationResults$conditionalPowerAchieved[2, ], c(0.61612368, 0.57564124, 0.49458667, 0.52832804), tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[3, ], c(0.78816558, 0.77803263, 0.64572713, 0.66129837), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResults), NA))) expect_output(print(simulationResults)$show()) invisible(capture.output(expect_error(summary(simulationResults), NA))) expect_output(summary(simulationResults)$show()) simulationResultsCodeBased <- eval(parse(text = getObjectRCode(simulationResults, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultsCodeBased$median1, simulationResults$median1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$median2, simulationResults$median2, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$accrualIntensity, simulationResults$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$lambda1, simulationResults$lambda1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$lambda2, simulationResults$lambda2, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$hazardRatio, simulationResults$hazardRatio, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$analysisTime, simulationResults$analysisTime, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$studyDuration, simulationResults$studyDuration, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsNotAchieved, simulationResults$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$numberOfSubjects, simulationResults$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$iterations, simulationResults$iterations, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$overallReject, simulationResults$overallReject, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$rejectPerStage, simulationResults$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityStop, simulationResults$futilityStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityPerStage, simulationResults$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$earlyStop, simulationResults$earlyStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfSubjects, simulationResults$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfEvents, simulationResults$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsPerStage, simulationResults$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$conditionalPowerAchieved, simulationResults$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResults), "character") df <- as.data.frame(simulationResults) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResults) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': configuration 3", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationSurvival} # @refFS[Formula]{fs:SimulationSurvivalTimeGenerate} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:SimulationSurvivalLogRank} # @refFS[Formula]{fs:SimulationSurvivalIncrements} # @refFS[Formula]{fs:SimulationSurvivalHazardEstimate} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} design <- getDesignFisher(kMax = 3, alpha0Vec = c(0.5, 0.5)) simulationResults <- getSimulationSurvival(design = design, pi2 = 0.2, pi1 = seq(0.3, 0.45, 0.05), directionUpper = TRUE, maxNumberOfSubjects = 500, plannedEvents = (1:design$kMax) * 20, allocation1 = 1, allocation2 = 1, accrualTime = c(0, 3, 6, 12), accrualIntensity = c(0.1, 0.2, 0.2) , dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12, conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA_real_, 10, 10), maxNumberOfEventsPerStage = c(NA_real_, 100, 200), maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResults' with expected results expect_equal(simulationResults$median1, c(23.320299, 19.308487, 16.282985, 13.9131), tolerance = 1e-07) expect_equal(simulationResults$median2, 37.275405, tolerance = 1e-07) expect_equal(simulationResults$accrualIntensity, c(23.809524, 47.619048, 47.619048), tolerance = 1e-07) expect_equal(simulationResults$lambda1, c(0.029722912, 0.035898576, 0.042568802, 0.04981975), tolerance = 1e-07) expect_equal(simulationResults$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(simulationResults$hazardRatio, c(1.5984103, 1.9305192, 2.2892242, 2.6791588), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[1, ], c(7.2763799, 7.0838561, 6.7193502, 6.3616317), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[2, ], c(16.764021, 14.756285, 13.821816, 12.988284), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[3, ], c(38.977945, 24.200748, 26.934721, 11.875967), tolerance = 1e-07) expect_equal(simulationResults$studyDuration, c(22.098154, 13.978342, 11.899449, 9.7796143), tolerance = 1e-07) expect_equal(simulationResults$eventsNotAchieved[1, ], c(0, 0, 0, 0)) expect_equal(simulationResults$eventsNotAchieved[2, ], c(0, 0, 0, 0)) expect_equal(simulationResults$eventsNotAchieved[3, ], c(0, 0, 0, 0)) expect_equal(simulationResults$numberOfSubjects[1, ], c(275.04, 265.86, 248.46, 231.45), tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[2, ], c(496.07246, 481.84722, 476, 463.84), tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[3, ], c(500, 500, 500, 494)) expect_equal(simulationResults$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simulationResults$iterations[2, ], c(69, 72, 59, 50)) expect_equal(simulationResults$iterations[3, ], c(37, 12, 7, 2)) expect_equal(simulationResults$overallReject, c(0.84, 0.92, 0.98, 0.99), tolerance = 1e-07) expect_gte(object = simulationResults$overallReject[1], expected = 0) expect_gte(object = simulationResults$overallReject[2], expected = 0) expect_gte(object = simulationResults$overallReject[3], expected = 0) expect_gte(object = simulationResults$overallReject[4], expected = 0) expect_lte(object = simulationResults$overallReject[1], expected = 1) expect_lte(object = simulationResults$overallReject[2], expected = 1) expect_lte(object = simulationResults$overallReject[3], expected = 1) expect_lte(object = simulationResults$overallReject[4], expected = 1) expect_equal(simulationResults$rejectPerStage[1, ], c(0.18, 0.22, 0.39, 0.49), tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[2, ], c(0.31, 0.59, 0.52, 0.48), tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[3, ], c(0.35, 0.11, 0.07, 0.02), tolerance = 1e-07) expect_equal(simulationResults$futilityStop, c(0.14, 0.07, 0.02, 0.01), tolerance = 1e-07) expect_equal(simulationResults$futilityPerStage[1, ], c(0.13, 0.06, 0.02, 0.01), tolerance = 1e-07) expect_equal(simulationResults$futilityPerStage[2, ], c(0.01, 0.01, 0, 0), tolerance = 1e-07) expect_equal(simulationResults$earlyStop, c(0.63, 0.88, 0.93, 0.98), tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfSubjects, c(429.00559, 423.54913, 384.3886, 348.2482), tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfEvents, c(137.13, 85.39, 72.76, 57.98), tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[1, ], c(20, 20, 20, 20)) expect_equal(simulationResults$eventsPerStage[2, ], c(106.50725, 94.541667, 94.677966, 94.48), tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[3, ], c(261.75049, 192.20833, 218.96368, 131.48), tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simulationResults$conditionalPowerAchieved[2, ], c(0.46273079, 0.58305775, 0.61313502, 0.59484117), tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[3, ], c(0.66165116, 0.75066235, 0.71981679, 0.8), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResults), NA))) expect_output(print(simulationResults)$show()) invisible(capture.output(expect_error(summary(simulationResults), NA))) expect_output(summary(simulationResults)$show()) simulationResultsCodeBased <- eval(parse(text = getObjectRCode(simulationResults, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultsCodeBased$median1, simulationResults$median1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$median2, simulationResults$median2, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$accrualIntensity, simulationResults$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$lambda1, simulationResults$lambda1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$lambda2, simulationResults$lambda2, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$hazardRatio, simulationResults$hazardRatio, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$analysisTime, simulationResults$analysisTime, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$studyDuration, simulationResults$studyDuration, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsNotAchieved, simulationResults$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$numberOfSubjects, simulationResults$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$iterations, simulationResults$iterations, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$overallReject, simulationResults$overallReject, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$rejectPerStage, simulationResults$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityStop, simulationResults$futilityStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityPerStage, simulationResults$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$earlyStop, simulationResults$earlyStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfSubjects, simulationResults$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfEvents, simulationResults$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsPerStage, simulationResults$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$conditionalPowerAchieved, simulationResults$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResults), "character") df <- as.data.frame(simulationResults) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResults) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': configuration 4", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationSurvival} # @refFS[Formula]{fs:SimulationSurvivalTimeGenerate} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:SimulationSurvivalLogRank} # @refFS[Formula]{fs:SimulationSurvivalIncrements} # @refFS[Formula]{fs:SimulationSurvivalHazardEstimate} # @refFS[Formula]{fs:testStatisticGroupSequential} design <- getDesignGroupSequential(kMax = 3, typeOfDesign = "WT", deltaWT = 0.25) piecewiseSurvivalTime <- list( "<6" = 0.025, "6 - <9" = 0.04, "9 - <15" = 0.015, "15 - <21" = 0.01, ">=21" = 0.007) simulationResults <- getSimulationSurvival(design = design, directionUpper = TRUE, maxNumberOfSubjects = 500, plannedEvents = (1:design$kMax) * 20, allocation1 = 1, allocation2 = 1, accrualTime = c(0, 3, 6, 12), piecewiseSurvivalTime = piecewiseSurvivalTime, hazardRatio = 1.7, accrualIntensity = c(0.1, 0.2, 0.2) , dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12, conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA_real_, 10, 10), maxNumberOfEventsPerStage = c(NA_real_, 100, 200), maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResults' with expected results expect_equal(simulationResults$accrualIntensity, c(23.809524, 47.619048, 47.619048), tolerance = 1e-07) expect_equal(simulationResults$lambda1, c(0.0425, 0.068, 0.0255, 0.017, 0.0119), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[1, ], 6.3619038, tolerance = 1e-07) expect_equal(simulationResults$analysisTime[2, ], 12.345684, tolerance = 1e-07) expect_equal(simulationResults$analysisTime[3, ], 36.687962, tolerance = 1e-07) expect_equal(simulationResults$studyDuration, 19.26207, tolerance = 1e-07) expect_equal(simulationResults$eventsNotAchieved[1, ], 0) expect_equal(simulationResults$eventsNotAchieved[2, ], 0) expect_equal(simulationResults$eventsNotAchieved[3, ], 0) expect_equal(simulationResults$numberOfSubjects[1, ], 231.41, tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[2, ], 448.23158, tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[3, ], 491.66667, tolerance = 1e-07) expect_equal(simulationResults$iterations[1, ], 100) expect_equal(simulationResults$iterations[2, ], 95) expect_equal(simulationResults$iterations[3, ], 30) expect_equal(simulationResults$overallReject, 0.99, tolerance = 1e-07) expect_gte(object = simulationResults$overallReject[1], expected = 0) expect_lte(object = simulationResults$overallReject[1], expected = 1) expect_equal(simulationResults$rejectPerStage[1, ], 0.05, tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[2, ], 0.65, tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[3, ], 0.29, tolerance = 1e-07) expect_equal(simulationResults$futilityStop, 0) expect_equal(simulationResults$futilityPerStage[1, ], 0) expect_equal(simulationResults$futilityPerStage[2, ], 0) expect_equal(simulationResults$earlyStop, 0.7, tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfSubjects, 450.42103, tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfEvents, 121.64, tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[1, ], 20) expect_equal(simulationResults$eventsPerStage[2, ], 91.694737, tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[3, ], 203.4614, tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simulationResults$conditionalPowerAchieved[2, ], 0.49425129, tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[3, ], 0.73157546, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResults), NA))) expect_output(print(simulationResults)$show()) invisible(capture.output(expect_error(summary(simulationResults), NA))) expect_output(summary(simulationResults)$show()) simulationResultsCodeBased <- eval(parse(text = getObjectRCode(simulationResults, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultsCodeBased$accrualIntensity, simulationResults$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$lambda1, simulationResults$lambda1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$analysisTime, simulationResults$analysisTime, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$studyDuration, simulationResults$studyDuration, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsNotAchieved, simulationResults$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$numberOfSubjects, simulationResults$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$iterations, simulationResults$iterations, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$overallReject, simulationResults$overallReject, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$rejectPerStage, simulationResults$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityStop, simulationResults$futilityStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityPerStage, simulationResults$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$earlyStop, simulationResults$earlyStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfSubjects, simulationResults$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfEvents, simulationResults$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsPerStage, simulationResults$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$conditionalPowerAchieved, simulationResults$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResults), "character") df <- as.data.frame(simulationResults) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResults) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': configuration 5", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationSurvival} # @refFS[Formula]{fs:SimulationSurvivalTimeGenerate} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:SimulationSurvivalLogRank} # @refFS[Formula]{fs:SimulationSurvivalIncrements} # @refFS[Formula]{fs:SimulationSurvivalHazardEstimate} # @refFS[Formula]{fs:testStatisticGroupSequential} design <- getDesignGroupSequential(kMax = 3, typeOfDesign = "WT", deltaWT = 0.25) simulationResults <- getSimulationSurvival(design = design, pi2 = 0.6, pi1 = seq(0.3, 0.45, 0.05), directionUpper = FALSE, maxNumberOfSubjects = 200, plannedEvents = (1:design$kMax) * 20, allocation1 = 1, allocation2 = 1, accrualTime = c(0, 3, 6, 12), accrualIntensity = c(0.1, 0.2, 0.2) , dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12, conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA_real_, 10, 10), maxNumberOfEventsPerStage = c(NA_real_, 40, 40), maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResults' with expected results expect_equal(simulationResults$median1, c(23.320299, 19.308487, 16.282985, 13.9131), tolerance = 1e-07) expect_equal(simulationResults$median2, 9.0776496, tolerance = 1e-07) expect_equal(simulationResults$accrualIntensity, c(9.5238095, 19.047619, 19.047619), tolerance = 1e-07) expect_equal(simulationResults$lambda1, c(0.029722912, 0.035898576, 0.042568802, 0.04981975), tolerance = 1e-07) expect_equal(simulationResults$lambda2, 0.076357561, tolerance = 1e-07) expect_equal(simulationResults$hazardRatio, c(0.38925958, 0.47013781, 0.55749295, 0.6524534), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[1, ], c(8.1674426, 7.9228743, 7.6045868, 7.4881493), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[2, ], c(12.354338, 12.56529, 12.380125, 12.254955), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[3, ], c(16.473595, 17.9949, 17.847597, 17.390492), tolerance = 1e-07) expect_equal(simulationResults$studyDuration, c(12.562909, 13.818364, 15.044701, 16.144285), tolerance = 1e-07) expect_equal(simulationResults$eventsNotAchieved[1, ], c(0, 0, 0, 0)) expect_equal(simulationResults$eventsNotAchieved[2, ], c(0, 0, 0, 0)) expect_equal(simulationResults$eventsNotAchieved[3, ], c(0, 0, 0, 0)) expect_equal(simulationResults$numberOfSubjects[1, ], c(126.03, 121.42, 115.37, 113.16), tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[2, ], c(187.50575, 190.98876, 193.16304, 192.33), tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[3, ], c(199.11111, 200, 199.39655, 199.28571), tolerance = 1e-07) expect_equal(simulationResults$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simulationResults$iterations[2, ], c(87, 89, 92, 100)) expect_equal(simulationResults$iterations[3, ], c(18, 34, 58, 77)) expect_equal(simulationResults$overallReject, c(0.99, 0.97, 0.68, 0.48), tolerance = 1e-07) expect_gte(object = simulationResults$overallReject[1], expected = 0) expect_gte(object = simulationResults$overallReject[2], expected = 0) expect_gte(object = simulationResults$overallReject[3], expected = 0) expect_gte(object = simulationResults$overallReject[4], expected = 0) expect_lte(object = simulationResults$overallReject[1], expected = 1) expect_lte(object = simulationResults$overallReject[2], expected = 1) expect_lte(object = simulationResults$overallReject[3], expected = 1) expect_lte(object = simulationResults$overallReject[4], expected = 1) expect_equal(simulationResults$rejectPerStage[1, ], c(0.13, 0.11, 0.08, 0), tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[2, ], c(0.69, 0.55, 0.34, 0.23), tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[3, ], c(0.17, 0.31, 0.26, 0.25), tolerance = 1e-07) expect_equal(simulationResults$futilityStop, c(0, 0, 0, 0)) expect_equal(simulationResults$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(simulationResults$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(simulationResults$earlyStop, c(0.82, 0.66, 0.42, 0.23), tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfSubjects, c(181.60287, 186.40002, 190.55503, 197.6859), tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfEvents, c(49.58, 59.5, 73.87, 84.89), tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[1, ], c(20, 20, 20, 20)) expect_equal(simulationResults$eventsPerStage[2, ], c(48.54023, 51.561798, 55.130435, 55.79), tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[3, ], c(74.929119, 85.120621, 92.285607, 93.582208), tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(simulationResults$conditionalPowerAchieved[2, ], c(0.56161185, 0.47418383, 0.31608317, 0.29578133), tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[3, ], c(0.71394365, 0.57778506, 0.37448609, 0.32265113), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResults), NA))) expect_output(print(simulationResults)$show()) invisible(capture.output(expect_error(summary(simulationResults), NA))) expect_output(summary(simulationResults)$show()) simulationResultsCodeBased <- eval(parse(text = getObjectRCode(simulationResults, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultsCodeBased$median1, simulationResults$median1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$median2, simulationResults$median2, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$accrualIntensity, simulationResults$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$lambda1, simulationResults$lambda1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$lambda2, simulationResults$lambda2, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$hazardRatio, simulationResults$hazardRatio, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$analysisTime, simulationResults$analysisTime, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$studyDuration, simulationResults$studyDuration, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsNotAchieved, simulationResults$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$numberOfSubjects, simulationResults$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$iterations, simulationResults$iterations, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$overallReject, simulationResults$overallReject, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$rejectPerStage, simulationResults$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityStop, simulationResults$futilityStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityPerStage, simulationResults$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$earlyStop, simulationResults$earlyStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfSubjects, simulationResults$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfEvents, simulationResults$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsPerStage, simulationResults$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$conditionalPowerAchieved, simulationResults$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResults), "character") df <- as.data.frame(simulationResults) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResults) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': configuration 6", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationSurvival} # @refFS[Formula]{fs:SimulationSurvivalTimeGenerate} # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:SimulationSurvivalLogRank} # @refFS[Formula]{fs:SimulationSurvivalIncrements} # @refFS[Formula]{fs:SimulationSurvivalHazardEstimate} # @refFS[Formula]{fs:testStatisticGroupSequential} design <- getDesignGroupSequential(kMax = 3, typeOfDesign = "WT", deltaWT = 0.25) piecewiseSurvivalTime <- list( "0 - <6" = 0.025, "6 - <9" = 0.04, "9 - <15" = 0.015, "15 - <21" = 0.01, ">=21" = 0.007) suppressWarnings(simulationResults <- getSimulationSurvival(design = design, directionUpper = FALSE, maxNumberOfSubjects = 260, plannedEvents = (1:design$kMax) * 20, allocation1 = 1, allocation2 = 1, accrualTime = c(0, 3, 6, 12), piecewiseSurvivalTime = piecewiseSurvivalTime, hazardRatio = 0.8, accrualIntensity = c(0.1, 0.2, 0.2) , dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12, conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA_real_, 10, 10), maxNumberOfEventsPerStage = c(NA_real_, 400, 200), maxNumberOfIterations = 100, seed = 1234567890)) ## Comparison of the results of SimulationResultsSurvival object 'simulationResults' with expected results expect_equal(simulationResults$accrualIntensity, c(12.380952, 24.761905, 24.761905), tolerance = 1e-07) expect_equal(simulationResults$lambda1, c(0.02, 0.032, 0.012, 0.008, 0.0056), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[1, ], 9.8001583, tolerance = 1e-07) expect_equal(simulationResults$analysisTime[2, ], 134.1032, tolerance = 1e-07) expect_equal(simulationResults$analysisTime[3, ], 189.74226, tolerance = 1e-07) expect_equal(simulationResults$studyDuration, 39.514056, tolerance = 1e-07) expect_equal(simulationResults$eventsNotAchieved[1, ], 0) expect_equal(simulationResults$eventsNotAchieved[2, ], 0.62, tolerance = 1e-07) expect_equal(simulationResults$eventsNotAchieved[3, ], 0.18, tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[1, ], 205.17, tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[2, ], 258.63158, tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[3, ], 258.76923, tolerance = 1e-07) expect_equal(simulationResults$iterations[1, ], 100) expect_equal(simulationResults$iterations[2, ], 38) expect_equal(simulationResults$iterations[3, ], 13) expect_equal(simulationResults$overallReject, 0.1, tolerance = 1e-07) expect_gte(object = simulationResults$overallReject[1], expected = 0) expect_lte(object = simulationResults$overallReject[1], expected = 1) expect_equal(simulationResults$rejectPerStage[1, ], 0) expect_equal(simulationResults$rejectPerStage[2, ], 0.07, tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[3, ], 0.03, tolerance = 1e-07) expect_equal(simulationResults$futilityStop, 0) expect_equal(simulationResults$futilityPerStage[1, ], 0) expect_equal(simulationResults$futilityPerStage[2, ], 0) expect_equal(simulationResults$earlyStop, 0.07, tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfSubjects, 258.7596, tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfEvents, 215.70668, tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[1, ], 20) expect_equal(simulationResults$eventsPerStage[2, ], 125.21053, tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[3, ], 222.51822, tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simulationResults$conditionalPowerAchieved[2, ], 0.80033324, tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[3, ], 0.64354689, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResults), NA))) expect_output(print(simulationResults)$show()) invisible(capture.output(expect_error(summary(simulationResults), NA))) expect_output(summary(simulationResults)$show()) suppressWarnings(simulationResultsCodeBased <- eval(parse(text = getObjectRCode(simulationResults, stringWrapParagraphWidth = NULL)))) expect_equal(simulationResultsCodeBased$accrualIntensity, simulationResults$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$lambda1, simulationResults$lambda1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$analysisTime, simulationResults$analysisTime, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$studyDuration, simulationResults$studyDuration, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsNotAchieved, simulationResults$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$numberOfSubjects, simulationResults$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$iterations, simulationResults$iterations, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$overallReject, simulationResults$overallReject, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$rejectPerStage, simulationResults$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityStop, simulationResults$futilityStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityPerStage, simulationResults$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$earlyStop, simulationResults$earlyStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfSubjects, simulationResults$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfEvents, simulationResults$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsPerStage, simulationResults$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$conditionalPowerAchieved, simulationResults$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResults), "character") df <- as.data.frame(simulationResults) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResults) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } expect_warning(getSimulationSurvival(design = design, directionUpper = FALSE, maxNumberOfSubjects = 200, plannedEvents = (1:design$kMax) * 20, allocation1 = 1, allocation2 = 1, accrualTime = c(0, 3, 6, 12), piecewiseSurvivalTime = piecewiseSurvivalTime, hazardRatio = 0.8, accrualIntensity = c(0.1, 0.2, 0.2) , dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12, conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA_real_, 10, 10), maxNumberOfEventsPerStage = c(NA_real_, 400, 200), maxNumberOfIterations = 100, seed = 1234567890), paste0("Presumably due to drop-outs, required number of events were not achieved for at least one situation. ", "Increase the maximum number of subjects (200) to avoid this situation"), fixed = TRUE) expect_warning(getSimulationSurvival(design = design, directionUpper = FALSE, maxNumberOfSubjects = 200, plannedEvents = (1:design$kMax) * 20, allocation1 = 1, allocation2 = 1, accrualTime = c(0, 3, 6, 12), piecewiseSurvivalTime = piecewiseSurvivalTime, hazardRatio = 0.8, accrualIntensity = c(0.1, 0.2, 0.2) , dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12, conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA_real_, 10, 10), maxNumberOfEventsPerStage = c(NA_real_, 400, 200), maxNumberOfIterations = 100, seed = 1234567890), paste0("Presumably due to drop-outs, required number of events were not achieved for at least one situation. ", "Increase the maximum number of subjects (200) to avoid this situation"), fixed = TRUE) expect_warning(getSimulationSurvival( piecewiseSurvivalTime = list("<6" = 1.7, "6 - Inf" = 1.2), hazardRatio = c(0.65, 0.7, 0.8), plannedEvents = 98, maxNumberOfSubjects = 120, directionUpper = FALSE, maxNumberOfIterations = 1000, sided = 1, alpha = 0.1), paste0("Only the first 'hazardRatio' (0.65) was used for piecewise survival time definition ", "(use a loop over the function to simulate different hazard ratios)"), fixed = TRUE) }) test_that("'getSimulationSurvival': configuration 7", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationSurvival} # @refFS[Formula]{fs:SimulationSurvivalTimeGenerate} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} # @refFS[Formula]{fs:SimulationSurvivalLogRank} # @refFS[Formula]{fs:SimulationSurvivalIncrements} # @refFS[Formula]{fs:SimulationSurvivalHazardEstimate} # @refFS[Formula]{fs:testStatisticGroupSequential} design <- getDesignGroupSequential(kMax = 3, typeOfDesign = "WT", deltaWT = 0.25) simulationResults <- getSimulationSurvival(design = design, directionUpper = FALSE, maxNumberOfSubjects = 260, plannedEvents = (1:design$kMax) * 20, allocation1 = 1, allocation2 = 1, accrualTime = c(0, 3, 6, 12), piecewiseSurvivalTime = list("0 - ?" = 0.025), hazardRatio = 0.8, accrualIntensity = c(0.1, 0.2, 0.2) , dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12, conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA_real_, 10, 10), maxNumberOfEventsPerStage = c(NA_real_, 100, 100), maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResults' with expected results expect_equal(simulationResults$median1, 34.657359, tolerance = 1e-07) expect_equal(simulationResults$median2, 27.725887, tolerance = 1e-07) expect_equal(simulationResults$accrualIntensity, c(12.380952, 24.761905, 24.761905), tolerance = 1e-07) expect_equal(simulationResults$lambda1, 0.02, tolerance = 1e-07) expect_equal(simulationResults$analysisTime[1, ], 10.071413, tolerance = 1e-07) expect_equal(simulationResults$analysisTime[2, ], 31.014645, tolerance = 1e-07) expect_equal(simulationResults$analysisTime[3, ], 78.484045, tolerance = 1e-07) expect_equal(simulationResults$studyDuration, 75.086051, tolerance = 1e-07) expect_equal(simulationResults$eventsNotAchieved[1, ], 0) expect_equal(simulationResults$eventsNotAchieved[2, ], 0) expect_equal(simulationResults$eventsNotAchieved[3, ], 0) expect_equal(simulationResults$numberOfSubjects[1, ], 211.81, tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[2, ], 259.98, tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[3, ], 260) expect_equal(simulationResults$iterations[1, ], 100) expect_equal(simulationResults$iterations[2, ], 100) expect_equal(simulationResults$iterations[3, ], 93) expect_equal(simulationResults$overallReject, 0.26, tolerance = 1e-07) expect_gte(object = simulationResults$overallReject[1], expected = 0) expect_lte(object = simulationResults$overallReject[1], expected = 1) expect_equal(simulationResults$rejectPerStage[1, ], 0) expect_equal(simulationResults$rejectPerStage[2, ], 0.07, tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[3, ], 0.19, tolerance = 1e-07) expect_equal(simulationResults$futilityStop, 0) expect_equal(simulationResults$futilityPerStage[1, ], 0) expect_equal(simulationResults$futilityPerStage[2, ], 0) expect_equal(simulationResults$earlyStop, 0.07, tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfSubjects, 259.9986, tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfEvents, 194.37, tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[1, ], 20) expect_equal(simulationResults$eventsPerStage[2, ], 107.53, tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[3, ], 200.90634, tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simulationResults$conditionalPowerAchieved[2, ], 0.26815489, tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[3, ], 0.24457773, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResults), NA))) expect_output(print(simulationResults)$show()) invisible(capture.output(expect_error(summary(simulationResults), NA))) expect_output(summary(simulationResults)$show()) simulationResultsCodeBased <- eval(parse(text = getObjectRCode(simulationResults, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultsCodeBased$median1, simulationResults$median1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$median2, simulationResults$median2, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$accrualIntensity, simulationResults$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$lambda1, simulationResults$lambda1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$analysisTime, simulationResults$analysisTime, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$studyDuration, simulationResults$studyDuration, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsNotAchieved, simulationResults$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$numberOfSubjects, simulationResults$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$iterations, simulationResults$iterations, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$overallReject, simulationResults$overallReject, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$rejectPerStage, simulationResults$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityStop, simulationResults$futilityStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityPerStage, simulationResults$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$earlyStop, simulationResults$earlyStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfSubjects, simulationResults$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfEvents, simulationResults$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsPerStage, simulationResults$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$conditionalPowerAchieved, simulationResults$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResults), "character") df <- as.data.frame(simulationResults) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResults) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': configuration 8", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationSurvival} # @refFS[Formula]{fs:SimulationSurvivalTimeGenerate} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} # @refFS[Formula]{fs:SimulationSurvivalLogRank} # @refFS[Formula]{fs:SimulationSurvivalIncrements} # @refFS[Formula]{fs:SimulationSurvivalHazardEstimate} # @refFS[Formula]{fs:testStatisticGroupSequential} design <- getDesignGroupSequential(kMax = 3, typeOfDesign = "WT", deltaWT = 0.25) simulationResults <- getSimulationSurvival(design = design, directionUpper = FALSE, maxNumberOfSubjects = 200, plannedEvents = (1:design$kMax) * 20, allocation1 = 1, allocation2 = 1, accrualTime = c(0, 3, 6, 12), piecewiseSurvivalTime = c(0, 6), lambda2 = c(0.01, 0.03), hazardRatio = 0.8, accrualIntensity = c(0.1, 0.2, 0.2) , dropoutRate1 = 0.04, dropoutRate2 = 0.08, dropoutTime = 12, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResults' with expected results expect_equal(simulationResults$accrualIntensity, c(9.5238095, 19.047619, 19.047619), tolerance = 1e-07) expect_equal(simulationResults$lambda1, c(0.008, 0.024), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[1, ], 14.155697, tolerance = 1e-07) expect_equal(simulationResults$analysisTime[2, ], 19.508242, tolerance = 1e-07) expect_equal(simulationResults$analysisTime[3, ], 25.008056, tolerance = 1e-07) expect_equal(simulationResults$studyDuration, 24.627971, tolerance = 1e-07) expect_equal(simulationResults$eventsNotAchieved[1, ], 0) expect_equal(simulationResults$eventsNotAchieved[2, ], 0) expect_equal(simulationResults$eventsNotAchieved[3, ], 0) expect_equal(simulationResults$numberOfSubjects[1, ], 199.73, tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[2, ], 200) expect_equal(simulationResults$numberOfSubjects[3, ], 200) expect_equal(simulationResults$iterations[1, ], 100) expect_equal(simulationResults$iterations[2, ], 99) expect_equal(simulationResults$iterations[3, ], 95) expect_equal(simulationResults$overallReject, 0.11, tolerance = 1e-07) expect_gte(object = simulationResults$overallReject[1], expected = 0) expect_lte(object = simulationResults$overallReject[1], expected = 1) expect_equal(simulationResults$rejectPerStage[1, ], 0.01, tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[2, ], 0.04, tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[3, ], 0.06, tolerance = 1e-07) expect_equal(simulationResults$futilityStop, 0) expect_equal(simulationResults$futilityPerStage[1, ], 0) expect_equal(simulationResults$futilityPerStage[2, ], 0) expect_equal(simulationResults$earlyStop, 0.05, tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfSubjects, 199.9973, tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfEvents, 58.8, tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[1, ], 20) expect_equal(simulationResults$eventsPerStage[2, ], 40) expect_equal(simulationResults$eventsPerStage[3, ], 60) expect_equal(simulationResults$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simulationResults$conditionalPowerAchieved[2, ], 0.13387917, tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[3, ], 0.12806393, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResults), NA))) expect_output(print(simulationResults)$show()) invisible(capture.output(expect_error(summary(simulationResults), NA))) expect_output(summary(simulationResults)$show()) simulationResultsCodeBased <- eval(parse(text = getObjectRCode(simulationResults, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultsCodeBased$accrualIntensity, simulationResults$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$lambda1, simulationResults$lambda1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$analysisTime, simulationResults$analysisTime, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$studyDuration, simulationResults$studyDuration, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsNotAchieved, simulationResults$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$numberOfSubjects, simulationResults$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$iterations, simulationResults$iterations, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$overallReject, simulationResults$overallReject, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$rejectPerStage, simulationResults$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityStop, simulationResults$futilityStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityPerStage, simulationResults$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$earlyStop, simulationResults$earlyStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfSubjects, simulationResults$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfEvents, simulationResults$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsPerStage, simulationResults$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$conditionalPowerAchieved, simulationResults$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResults), "character") df <- as.data.frame(simulationResults) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResults) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': configuration 9; ", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationSurvival} # @refFS[Formula]{fs:SimulationSurvivalTimeGenerate} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} # @refFS[Formula]{fs:SimulationSurvivalLogRank} # @refFS[Formula]{fs:SimulationSurvivalIncrements} # @refFS[Formula]{fs:SimulationSurvivalHazardEstimate} # @refFS[Formula]{fs:testStatisticGroupSequential} design <- getDesignGroupSequential(kMax = 3, typeOfDesign = "WT", deltaWT = 0.25) simulationResults <- getSimulationSurvival(design = design, directionUpper = FALSE, maxNumberOfSubjects = 260, plannedEvents = (1:design$kMax) * 20, allocation1 = 1, allocation2 = 1, accrualTime = c(0, 3, 6, 12), piecewiseSurvivalTime = c(0, 6), lambda2 = c(0.01, 0.03), hazardRatio = c(0.75), accrualIntensity = c(0.1, 0.2, 0.2) , dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12, conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA_real_, 10, 10), maxNumberOfEventsPerStage = c(NA_real_, 100, 100), maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResults' with expected results expect_equal(simulationResults$accrualIntensity, c(12.380952, 24.761905, 24.761905), tolerance = 1e-07) expect_equal(simulationResults$lambda1, c(0.0075, 0.0225), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[1, ], 12.905156, tolerance = 1e-07) expect_equal(simulationResults$analysisTime[2, ], 31.363371, tolerance = 1e-07) expect_equal(simulationResults$analysisTime[3, ], 71.176717, tolerance = 1e-07) expect_equal(simulationResults$studyDuration, 65.836001, tolerance = 1e-07) expect_equal(simulationResults$eventsNotAchieved[1, ], 0) expect_equal(simulationResults$eventsNotAchieved[2, ], 0) expect_equal(simulationResults$eventsNotAchieved[3, ], 0) expect_equal(simulationResults$numberOfSubjects[1, ], 257.27, tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[2, ], 260) expect_equal(simulationResults$numberOfSubjects[3, ], 260) expect_equal(simulationResults$iterations[1, ], 100) expect_equal(simulationResults$iterations[2, ], 99) expect_equal(simulationResults$iterations[3, ], 87) expect_equal(simulationResults$overallReject, 0.47, tolerance = 1e-07) expect_gte(object = simulationResults$overallReject[1], expected = 0) expect_lte(object = simulationResults$overallReject[1], expected = 1) expect_equal(simulationResults$rejectPerStage[1, ], 0.01, tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[2, ], 0.12, tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[3, ], 0.34, tolerance = 1e-07) expect_equal(simulationResults$futilityStop, 0) expect_equal(simulationResults$futilityPerStage[1, ], 0) expect_equal(simulationResults$futilityPerStage[2, ], 0) expect_equal(simulationResults$earlyStop, 0.13, tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfSubjects, 259.9727, tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfEvents, 183.23, tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[1, ], 20) expect_equal(simulationResults$eventsPerStage[2, ], 106.16162, tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[3, ], 195.73633, tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simulationResults$conditionalPowerAchieved[2, ], 0.28641702, tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[3, ], 0.33103011, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResults), NA))) expect_output(print(simulationResults)$show()) invisible(capture.output(expect_error(summary(simulationResults), NA))) expect_output(summary(simulationResults)$show()) simulationResultsCodeBased <- eval(parse(text = getObjectRCode(simulationResults, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultsCodeBased$accrualIntensity, simulationResults$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$lambda1, simulationResults$lambda1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$analysisTime, simulationResults$analysisTime, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$studyDuration, simulationResults$studyDuration, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsNotAchieved, simulationResults$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$numberOfSubjects, simulationResults$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$iterations, simulationResults$iterations, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$overallReject, simulationResults$overallReject, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$rejectPerStage, simulationResults$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityStop, simulationResults$futilityStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityPerStage, simulationResults$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$earlyStop, simulationResults$earlyStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfSubjects, simulationResults$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfEvents, simulationResults$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsPerStage, simulationResults$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$conditionalPowerAchieved, simulationResults$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResults), "character") df <- as.data.frame(simulationResults) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResults) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': configuration 10; ", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationSurvival} # @refFS[Formula]{fs:SimulationSurvivalTimeGenerate} # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:SimulationSurvivalLogRank} # @refFS[Formula]{fs:SimulationSurvivalIncrements} # @refFS[Formula]{fs:SimulationSurvivalHazardEstimate} # @refFS[Formula]{fs:testStatisticGroupSequential} design <- getDesignGroupSequential(kMax = 3, typeOfDesign = "WT", deltaWT = 0.25) simulationResults <- getSimulationSurvival(design = design, directionUpper = FALSE, maxNumberOfSubjects = 260, plannedEvents = (1:design$kMax) * 20, allocation1 = 1, allocation2 = 1, accrualTime = c(0, 3, 6, 12), lambda2 = 0.03, hazardRatio = c(0.75, 0.8, 0.9), accrualIntensity = c(0.1, 0.2, 0.2) , dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12, conditionalPower = 0.8, minNumberOfEventsPerStage = c(NA_real_, 10, 10), maxNumberOfEventsPerStage = c(NA_real_, 100, 100), maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResults' with expected results expect_equal(simulationResults$pi1, c(0.23662051, 0.25023841, 0.27674976), tolerance = 1e-07) expect_equal(simulationResults$pi2, 0.30232367, tolerance = 1e-07) expect_equal(simulationResults$median1, c(30.806541, 28.881133, 25.672118), tolerance = 1e-07) expect_equal(simulationResults$median2, 23.104906, tolerance = 1e-07) expect_equal(simulationResults$accrualIntensity, c(12.380952, 24.761905, 24.761905), tolerance = 1e-07) expect_equal(simulationResults$lambda1, c(0.0225, 0.024, 0.027), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[1, ], c(9.4112305, 9.2753297, 9.1968922), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[2, ], c(27.054738, 27.519552, 26.652741), tolerance = 1e-07) expect_equal(simulationResults$analysisTime[3, ], c(67.286427, 67.154864, 68.163763), tolerance = 1e-07) expect_equal(simulationResults$studyDuration, c(61.651041, 62.169663, 64.720225), tolerance = 1e-07) expect_equal(simulationResults$eventsNotAchieved[1, ], c(0, 0, 0)) expect_equal(simulationResults$eventsNotAchieved[2, ], c(0, 0, 0)) expect_equal(simulationResults$eventsNotAchieved[3, ], c(0, 0, 0)) expect_equal(simulationResults$numberOfSubjects[1, ], c(195.58, 192.19, 190.21), tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[2, ], c(258.86, 259.77778, 259.64646), tolerance = 1e-07) expect_equal(simulationResults$numberOfSubjects[3, ], c(260, 260, 260)) expect_equal(simulationResults$iterations[1, ], c(100, 100, 100)) expect_equal(simulationResults$iterations[2, ], c(100, 99, 99)) expect_equal(simulationResults$iterations[3, ], c(86, 88, 93)) expect_equal(simulationResults$overallReject, c(0.46, 0.36, 0.13), tolerance = 1e-07) expect_gte(object = simulationResults$overallReject[1], expected = 0) expect_gte(object = simulationResults$overallReject[2], expected = 0) expect_gte(object = simulationResults$overallReject[3], expected = 0) expect_lte(object = simulationResults$overallReject[1], expected = 1) expect_lte(object = simulationResults$overallReject[2], expected = 1) expect_lte(object = simulationResults$overallReject[3], expected = 1) expect_equal(simulationResults$rejectPerStage[1, ], c(0, 0.01, 0.01), tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[2, ], c(0.14, 0.11, 0.06), tolerance = 1e-07) expect_equal(simulationResults$rejectPerStage[3, ], c(0.32, 0.24, 0.06), tolerance = 1e-07) expect_equal(simulationResults$futilityStop, c(0, 0, 0)) expect_equal(simulationResults$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(simulationResults$futilityPerStage[2, ], c(0, 0, 0)) expect_equal(simulationResults$earlyStop, c(0.14, 0.12, 0.07), tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfSubjects, c(259.8404, 259.29746, 259.28089), tolerance = 1e-07) expect_equal(simulationResults$expectedNumberOfEvents, c(184.28, 187.82, 203.16), tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[1, ], c(20, 20, 20)) expect_equal(simulationResults$eventsPerStage[2, ], c(105.16, 109.35354, 112.36364), tolerance = 1e-07) expect_equal(simulationResults$eventsPerStage[3, ], c(197.16, 199.53535, 210.98729), tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(simulationResults$conditionalPowerAchieved[2, ], c(0.30728214, 0.23928832, 0.1863817), tolerance = 1e-07) expect_equal(simulationResults$conditionalPowerAchieved[3, ], c(0.33344952, 0.28614054, 0.14302818), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResults), NA))) expect_output(print(simulationResults)$show()) invisible(capture.output(expect_error(summary(simulationResults), NA))) expect_output(summary(simulationResults)$show()) simulationResultsCodeBased <- eval(parse(text = getObjectRCode(simulationResults, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultsCodeBased$pi1, simulationResults$pi1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$pi2, simulationResults$pi2, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$median1, simulationResults$median1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$median2, simulationResults$median2, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$accrualIntensity, simulationResults$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$lambda1, simulationResults$lambda1, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$analysisTime, simulationResults$analysisTime, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$studyDuration, simulationResults$studyDuration, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsNotAchieved, simulationResults$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$numberOfSubjects, simulationResults$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$iterations, simulationResults$iterations, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$overallReject, simulationResults$overallReject, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$rejectPerStage, simulationResults$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityStop, simulationResults$futilityStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$futilityPerStage, simulationResults$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$earlyStop, simulationResults$earlyStop, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfSubjects, simulationResults$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$expectedNumberOfEvents, simulationResults$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$eventsPerStage, simulationResults$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultsCodeBased$conditionalPowerAchieved, simulationResults$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResults), "character") df <- as.data.frame(simulationResults) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResults) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': test accrual time and intensity definition", { .skipTestIfDisabled() maxNumberOfSubjects <- getSimulationSurvival(plannedEvents = 100, accrualTime = c(0, 6, 12), accrualIntensity = c(22, 33), maxNumberOfIterations = 100)$maxNumberOfSubjects expect_equal(maxNumberOfSubjects, 330) accrualIntensity <- getSimulationSurvival(plannedEvents = 100, accrualTime = c(0, 6, 12), accrualIntensity = c(0.2, 0.3), maxNumberOfSubjects = 330, maxNumberOfIterations = 100, seed = 1234567890)$accrualIntensity expect_equal(accrualIntensity, c(22, 33)) }) test_that("'getSimulationSurvival': test expected warnings and errors", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationSurvival} # @refFS[Formula]{fs:SimulationSurvivalTimeGenerate} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:SimulationSurvivalLogRank} # @refFS[Formula]{fs:SimulationSurvivalIncrements} # @refFS[Formula]{fs:SimulationSurvivalHazardEstimate} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} .skipTestIfDisabled() dIN <- getDesignInverseNormal(informationRates = c(0.4, 0.7, 1)) expect_warning(getSimulationSurvival(design = dIN, hazardRatio = seq(1, 1.6, 0.1), pi2 = 0.3, plannedEvents = c(58, 102, 146), minNumberOfEventsPerStage = c(NA_real_, 44, 44), maxNumberOfSubjects = 800, maxNumberOfIterations = 100, seed = 1234567890), "'minNumberOfEventsPerStage' (NA, 44, 44) will be ignored because 'conditionalPower' is not defined", fixed = TRUE) expect_warning(getSimulationSurvival(design = dIN, hazardRatio = seq(1, 1.6, 0.1), pi2 = 0.3, plannedEvents = c(58, 102, 146), maxNumberOfEventsPerStage = 4 * c(NA_real_, 44, 44), maxNumberOfSubjects = 800, maxNumberOfIterations = 100, seed = 1234567890), "'maxNumberOfEventsPerStage' (NA, 176, 176) will be ignored because 'conditionalPower' is not defined", fixed = TRUE) expect_error(getSimulationSurvival(design = dIN, hazardRatio = seq(1, 1.6, 0.1), pi2 = 0.3, conditionalPower = 0.8, plannedEvents = c(58, 102, 146), maxNumberOfSubjects = 800, maxNumberOfIterations = 100, seed = 1234567890), "Missing argument: 'minNumberOfEventsPerStage' must be defined because 'conditionalPower' is defined", fixed = TRUE) expect_error(getSimulationSurvival(design = dIN, hazardRatio = seq(1, 1.6, 0.1), pi2 = 0.3, conditionalPower = 0.8, plannedEvents = c(58, 102, 146), minNumberOfEventsPerStage = c(NA_real_, 44, 44), maxNumberOfSubjects = 800, maxNumberOfIterations = 100, seed = 1234567890), "Missing argument: 'maxNumberOfEventsPerStage' must be defined because 'conditionalPower' is defined", fixed = TRUE) expect_error(getSimulationSurvival(design = dIN, hazardRatio = seq(1, 1.6, 0.1), pi2 = 0.3, conditionalPower = -0.1, plannedEvents = c(58, 102, 146), minNumberOfEventsPerStage = c(NA_real_, 44, 44), maxNumberOfEventsPerStage = 4 * c(NA_real_, 44, 44), maxNumberOfSubjects = 800, maxNumberOfIterations = 100, seed = 1234567890), "Argument out of bounds: 'conditionalPower' (-0.1) is out of bounds (0; 1)", fixed = TRUE) expect_error(getSimulationSurvival(design = dIN, hazardRatio = seq(1, 1.6, 0.1), pi2 = 0.3, conditionalPower = 1.1, plannedEvents = c(58, 102, 146), minNumberOfEventsPerStage = c(NA_real_, 44, 44), maxNumberOfEventsPerStage = 4 * c(NA_real_, 44, 44), maxNumberOfSubjects = 800, maxNumberOfIterations = 100, seed = 1234567890), "Argument out of bounds: 'conditionalPower' (1.1) is out of bounds (0; 1)", fixed = TRUE) expect_error(getSimulationSurvival(plannedEvents = -100, accrualTime = c(0, 6, 12), accrualIntensity = c(22, 33), maxNumberOfIterations = 100, seed = 1234567890), "Argument out of bounds: 'plannedEvents' (-100) must be >= 1", fixed = TRUE) expect_error(getSimulationSurvival(design = dIN, plannedEvents = c(100,100, 150), accrualTime = c(0, 6, 12), accrualIntensity = c(22, 33), maxNumberOfIterations = 100, seed = 1234567890), "Illegal argument: 'plannedEvents' (100, 100, 150) must be strictly increasing: x_1 < .. < x_3", fixed = TRUE) expect_error(getSimulationSurvival(design = dIN, hazardRatio = seq(1, 1.6, 0.1), pi2 = 0.3, conditionalPower = 0.8, plannedEvents = c(58, 102, 146), minNumberOfEventsPerStage = c(NA_real_, 44, -44), maxNumberOfEventsPerStage = 4 * c(NA_real_, 44, 44), maxNumberOfSubjects = 800, maxNumberOfIterations = 100, seed = 1234567890), "Argument out of bounds: each value of 'minNumberOfEventsPerStage' (58, 44, -44) must be >= 1", fixed = TRUE) expect_error(getSimulationSurvival(design = dIN, hazardRatio = seq(1, 1.6, 0.1), pi2 = 0.3, conditionalPower = 0.8, plannedEvents = c(58, 102, 146), minNumberOfEventsPerStage = c(NA_real_, 44, 44), maxNumberOfEventsPerStage = 4 * c(NA_real_, 10, 44), maxNumberOfSubjects = 800, maxNumberOfIterations = 100, seed = 1234567890), "Illegal argument: 'maxNumberOfEventsPerStage' (58, 40, 176) must be not smaller than minNumberOfEventsPerStage' (58, 44, 44)", fixed = TRUE) expect_error(getSimulationSurvival(plannedEvents = 100, maxNumberOfIterations = 100, seed = 1234567890), "Illegal argument: 'maxNumberOfSubjects' must be defined", fixed = TRUE) expect_error(getSimulationSurvival(plannedEvents = 100, accrualTime = c(0, 12), accrualIntensity = 20, thetaH1 = 0, maxNumberOfIterations = 100, seed = 1234567890), "Argument out of bounds: 'thetaH1' (0) must be > 0", fixed = TRUE) expect_error(getSimulationSurvival(plannedEvents = 100, accrualTime = c(0, 12), accrualIntensity = 20, conditionalPower = 0, maxNumberOfIterations = 100, seed = 1234567890), "Argument out of bounds: 'conditionalPower' (0) is out of bounds (0; 1)", fixed = TRUE) expect_error(getSimulationSurvival(plannedEvents = 100, accrualTime = c(0, 12), accrualIntensity = 20, conditionalPower = 1, maxNumberOfIterations = 100, seed = 1234567890), "Argument out of bounds: 'conditionalPower' (1) is out of bounds (0; 1)", fixed = TRUE) expect_error(getSimulationSurvival(plannedEvents = 100, accrualTime = c(0, 12), accrualIntensity = 20, conditionalPower = c(0.5, 0.8), maxNumberOfIterations = 100, seed = 1234567890), "Illegal argument: 'conditionalPower' c(0.5, 0.8) must be a single numeric value", fixed = TRUE) }) context("Testing the Simulation of Survival Data for Different Parameter Variants") test_that("'getSimulationSurvival': Fixed sample size with minimum required definitions, pi1 = c(0.4, 0.5, 0.6) and pi2 = 0.2 at event time 12, accrual time 12 and follow-up time 6 as default ", { .skipTestIfDisabled() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationSurvival} # @refFS[Formula]{fs:SimulationSurvivalTimeGenerate} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:SimulationSurvivalLogRank} # @refFS[Formula]{fs:SimulationSurvivalIncrements} # @refFS[Formula]{fs:SimulationSurvivalHazardEstimate} simulationResult <- getSimulationSurvival(plannedEvents = 40, maxNumberOfSubjects = 200, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResult' with expected results expect_equal(simulationResult$median1, c(37.275405, 23.320299, 16.282985, 12), tolerance = 1e-07) expect_equal(simulationResult$median2, 37.275405, tolerance = 1e-07) expect_equal(simulationResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(simulationResult$lambda1, c(0.018595296, 0.029722912, 0.042568802, 0.057762265), tolerance = 1e-07) expect_equal(simulationResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(simulationResult$hazardRatio, c(1, 1.5984103, 2.2892242, 3.1062837), tolerance = 1e-07) expect_equal(simulationResult$analysisTime[1, ], c(17.941133, 15.499503, 13.535749, 12.34), tolerance = 1e-07) expect_equal(simulationResult$studyDuration, c(17.941133, 15.499503, 13.535749, 12.34), tolerance = 1e-07) expect_equal(simulationResult$eventsNotAchieved[1, ], c(0, 0, 0, 0)) expect_equal(simulationResult$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simulationResult$overallReject, c(0.01, 0.3, 0.68, 0.95), tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[1, ], c(0.01, 0.3, 0.68, 0.95), tolerance = 1e-07) expect_equal(simulationResult$earlyStop, c(0, 0, 0, 0)) expect_equal(simulationResult$expectedNumberOfSubjects, c(200, 200, 199.71, 196.74), tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfEvents, c(40, 40, 40, 40)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResult), NA))) expect_output(print(simulationResult)$show()) invisible(capture.output(expect_error(summary(simulationResult), NA))) expect_output(summary(simulationResult)$show()) simulationResultCodeBased <- eval(parse(text = getObjectRCode(simulationResult, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultCodeBased$median1, simulationResult$median1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$median2, simulationResult$median2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$accrualIntensity, simulationResult$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda1, simulationResult$lambda1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda2, simulationResult$lambda2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$hazardRatio, simulationResult$hazardRatio, tolerance = 1e-05) expect_equal(simulationResultCodeBased$analysisTime, simulationResult$analysisTime, tolerance = 1e-05) expect_equal(simulationResultCodeBased$studyDuration, simulationResult$studyDuration, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsNotAchieved, simulationResult$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultCodeBased$iterations, simulationResult$iterations, tolerance = 1e-05) expect_equal(simulationResultCodeBased$overallReject, simulationResult$overallReject, tolerance = 1e-05) expect_equal(simulationResultCodeBased$rejectPerStage, simulationResult$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityPerStage, simulationResult$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$earlyStop, simulationResult$earlyStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfSubjects, simulationResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfEvents, simulationResult$expectedNumberOfEvents, tolerance = 1e-05) expect_type(names(simulationResult), "character") df <- as.data.frame(simulationResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': Determine necessary accrual time if 200 subjects and 30 subjects per time unit can be recruited ", { .skipTestIfDisabled() simulationResult <- getSimulationSurvival(plannedEvents = 40, accrualTime = 0, accrualIntensity = 30, maxNumberOfSubjects = 200, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResult' with expected results expect_equal(simulationResult$median1, c(37.275405, 23.320299, 16.282985, 12), tolerance = 1e-07) expect_equal(simulationResult$median2, 37.275405, tolerance = 1e-07) expect_equal(simulationResult$lambda1, c(0.018595296, 0.029722912, 0.042568802, 0.057762265), tolerance = 1e-07) expect_equal(simulationResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(simulationResult$hazardRatio, c(1, 1.5984103, 2.2892242, 3.1062837), tolerance = 1e-07) expect_equal(simulationResult$analysisTime[1, ], c(15.255121, 12.685136, 10.656532, 9.4294312), tolerance = 1e-07) expect_equal(simulationResult$studyDuration, c(15.255121, 12.685136, 10.656532, 9.4294312), tolerance = 1e-07) expect_equal(simulationResult$eventsNotAchieved[1, ], c(0, 0, 0, 0)) expect_equal(simulationResult$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simulationResult$overallReject, c(0.02, 0.28, 0.77, 0.96), tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[1, ], c(0.02, 0.28, 0.77, 0.96), tolerance = 1e-07) expect_equal(simulationResult$earlyStop, c(0, 0, 0, 0)) expect_equal(simulationResult$expectedNumberOfSubjects, c(200, 200, 200, 200)) expect_equal(simulationResult$expectedNumberOfEvents, c(40, 40, 40, 40)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResult), NA))) expect_output(print(simulationResult)$show()) invisible(capture.output(expect_error(summary(simulationResult), NA))) expect_output(summary(simulationResult)$show()) simulationResultCodeBased <- eval(parse(text = getObjectRCode(simulationResult, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultCodeBased$median1, simulationResult$median1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$median2, simulationResult$median2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda1, simulationResult$lambda1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda2, simulationResult$lambda2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$hazardRatio, simulationResult$hazardRatio, tolerance = 1e-05) expect_equal(simulationResultCodeBased$analysisTime, simulationResult$analysisTime, tolerance = 1e-05) expect_equal(simulationResultCodeBased$studyDuration, simulationResult$studyDuration, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsNotAchieved, simulationResult$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultCodeBased$iterations, simulationResult$iterations, tolerance = 1e-05) expect_equal(simulationResultCodeBased$overallReject, simulationResult$overallReject, tolerance = 1e-05) expect_equal(simulationResultCodeBased$rejectPerStage, simulationResult$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityPerStage, simulationResult$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$earlyStop, simulationResult$earlyStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfSubjects, simulationResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfEvents, simulationResult$expectedNumberOfEvents, tolerance = 1e-05) expect_type(names(simulationResult), "character") df <- as.data.frame(simulationResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': Determine necessary accrual time if 200 subjects and if the first 6 time units 20 subjects per time unit can be recruited, then 30 subjects per time unit ", { .skipTestIfDisabled() simulationResult <- getSimulationSurvival(plannedEvents = 40, accrualTime = c(0, 6), accrualIntensity = c(20, 30), maxNumberOfSubjects = 200, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResult' with expected results expect_equal(simulationResult$median1, c(37.275405, 23.320299, 16.282985, 12), tolerance = 1e-07) expect_equal(simulationResult$median2, 37.275405, tolerance = 1e-07) expect_equal(simulationResult$lambda1, c(0.018595296, 0.029722912, 0.042568802, 0.057762265), tolerance = 1e-07) expect_equal(simulationResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(simulationResult$hazardRatio, c(1, 1.5984103, 2.2892242, 3.1062837), tolerance = 1e-07) expect_equal(simulationResult$analysisTime[1, ], c(16.683961, 14.141068, 12.109744, 10.96314), tolerance = 1e-07) expect_equal(simulationResult$studyDuration, c(16.683961, 14.141068, 12.109744, 10.96314), tolerance = 1e-07) expect_equal(simulationResult$eventsNotAchieved[1, ], c(0, 0, 0, 0)) expect_equal(simulationResult$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simulationResult$overallReject, c(0.01, 0.28, 0.72, 0.96), tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[1, ], c(0.01, 0.28, 0.72, 0.96), tolerance = 1e-07) expect_equal(simulationResult$earlyStop, c(0, 0, 0, 0)) expect_equal(simulationResult$expectedNumberOfSubjects, c(200, 200, 200, 200)) expect_equal(simulationResult$expectedNumberOfEvents, c(40, 40, 40, 40)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResult), NA))) expect_output(print(simulationResult)$show()) invisible(capture.output(expect_error(summary(simulationResult), NA))) expect_output(summary(simulationResult)$show()) simulationResultCodeBased <- eval(parse(text = getObjectRCode(simulationResult, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultCodeBased$median1, simulationResult$median1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$median2, simulationResult$median2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda1, simulationResult$lambda1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda2, simulationResult$lambda2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$hazardRatio, simulationResult$hazardRatio, tolerance = 1e-05) expect_equal(simulationResultCodeBased$analysisTime, simulationResult$analysisTime, tolerance = 1e-05) expect_equal(simulationResultCodeBased$studyDuration, simulationResult$studyDuration, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsNotAchieved, simulationResult$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultCodeBased$iterations, simulationResult$iterations, tolerance = 1e-05) expect_equal(simulationResultCodeBased$overallReject, simulationResult$overallReject, tolerance = 1e-05) expect_equal(simulationResultCodeBased$rejectPerStage, simulationResult$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityPerStage, simulationResult$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$earlyStop, simulationResult$earlyStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfSubjects, simulationResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfEvents, simulationResult$expectedNumberOfEvents, tolerance = 1e-05) expect_type(names(simulationResult), "character") df <- as.data.frame(simulationResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': Determine maximum number of Subjects if the first 6 time units 20 subjects per time unit can be recruited, and after 10 time units 30 subjects per time unit", { .skipTestIfDisabled() simulationResult <- getSimulationSurvival(plannedEvents = 40, accrualTime = c(0, 6, 10), accrualIntensity = c(20, 30), maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResult' with expected results expect_equal(simulationResult$median1, c(37.275405, 23.320299, 16.282985, 12), tolerance = 1e-07) expect_equal(simulationResult$median2, 37.275405, tolerance = 1e-07) expect_equal(simulationResult$maxNumberOfSubjects, 240) expect_equal(simulationResult$lambda1, c(0.018595296, 0.029722912, 0.042568802, 0.057762265), tolerance = 1e-07) expect_equal(simulationResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(simulationResult$hazardRatio, c(1, 1.5984103, 2.2892242, 3.1062837), tolerance = 1e-07) expect_equal(simulationResult$analysisTime[1, ], c(15.210978, 13.172199, 11.59631, 10.698373), tolerance = 1e-07) expect_equal(simulationResult$studyDuration, c(15.210978, 13.172199, 11.59631, 10.698373), tolerance = 1e-07) expect_equal(simulationResult$eventsNotAchieved[1, ], c(0, 0, 0, 0)) expect_equal(simulationResult$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simulationResult$overallReject, c(0.04, 0.33, 0.75, 0.95), tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[1, ], c(0.04, 0.33, 0.75, 0.95), tolerance = 1e-07) expect_equal(simulationResult$earlyStop, c(0, 0, 0, 0)) expect_equal(simulationResult$expectedNumberOfSubjects, c(240, 240, 239.63, 237.56), tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfEvents, c(40, 40, 40, 40)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResult), NA))) expect_output(print(simulationResult)$show()) invisible(capture.output(expect_error(summary(simulationResult), NA))) expect_output(summary(simulationResult)$show()) simulationResultCodeBased <- eval(parse(text = getObjectRCode(simulationResult, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultCodeBased$median1, simulationResult$median1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$median2, simulationResult$median2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$maxNumberOfSubjects, simulationResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda1, simulationResult$lambda1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda2, simulationResult$lambda2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$hazardRatio, simulationResult$hazardRatio, tolerance = 1e-05) expect_equal(simulationResultCodeBased$analysisTime, simulationResult$analysisTime, tolerance = 1e-05) expect_equal(simulationResultCodeBased$studyDuration, simulationResult$studyDuration, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsNotAchieved, simulationResult$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultCodeBased$iterations, simulationResult$iterations, tolerance = 1e-05) expect_equal(simulationResultCodeBased$overallReject, simulationResult$overallReject, tolerance = 1e-05) expect_equal(simulationResultCodeBased$rejectPerStage, simulationResult$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityPerStage, simulationResult$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$earlyStop, simulationResult$earlyStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfSubjects, simulationResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfEvents, simulationResult$expectedNumberOfEvents, tolerance = 1e-05) expect_type(names(simulationResult), "character") df <- as.data.frame(simulationResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': Specify accrual time as a list", { .skipTestIfDisabled() at <- list("0 - <6" = 20, "6 - Inf" = 30) simulationResult <- getSimulationSurvival(plannedEvents = 40, accrualTime = at, maxNumberOfSubjects = 200, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResult' with expected results expect_equal(simulationResult$median1, c(37.275405, 23.320299, 16.282985, 12), tolerance = 1e-07) expect_equal(simulationResult$median2, 37.275405, tolerance = 1e-07) expect_equal(simulationResult$lambda1, c(0.018595296, 0.029722912, 0.042568802, 0.057762265), tolerance = 1e-07) expect_equal(simulationResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(simulationResult$hazardRatio, c(1, 1.5984103, 2.2892242, 3.1062837), tolerance = 1e-07) expect_equal(simulationResult$analysisTime[1, ], c(16.683961, 14.141068, 12.109744, 10.96314), tolerance = 1e-07) expect_equal(simulationResult$studyDuration, c(16.683961, 14.141068, 12.109744, 10.96314), tolerance = 1e-07) expect_equal(simulationResult$eventsNotAchieved[1, ], c(0, 0, 0, 0)) expect_equal(simulationResult$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simulationResult$overallReject, c(0.01, 0.28, 0.72, 0.96), tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[1, ], c(0.01, 0.28, 0.72, 0.96), tolerance = 1e-07) expect_equal(simulationResult$earlyStop, c(0, 0, 0, 0)) expect_equal(simulationResult$expectedNumberOfSubjects, c(200, 200, 200, 200)) expect_equal(simulationResult$expectedNumberOfEvents, c(40, 40, 40, 40)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResult), NA))) expect_output(print(simulationResult)$show()) invisible(capture.output(expect_error(summary(simulationResult), NA))) expect_output(summary(simulationResult)$show()) simulationResultCodeBased <- eval(parse(text = getObjectRCode(simulationResult, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultCodeBased$median1, simulationResult$median1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$median2, simulationResult$median2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda1, simulationResult$lambda1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda2, simulationResult$lambda2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$hazardRatio, simulationResult$hazardRatio, tolerance = 1e-05) expect_equal(simulationResultCodeBased$analysisTime, simulationResult$analysisTime, tolerance = 1e-05) expect_equal(simulationResultCodeBased$studyDuration, simulationResult$studyDuration, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsNotAchieved, simulationResult$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultCodeBased$iterations, simulationResult$iterations, tolerance = 1e-05) expect_equal(simulationResultCodeBased$overallReject, simulationResult$overallReject, tolerance = 1e-05) expect_equal(simulationResultCodeBased$rejectPerStage, simulationResult$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityPerStage, simulationResult$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$earlyStop, simulationResult$earlyStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfSubjects, simulationResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfEvents, simulationResult$expectedNumberOfEvents, tolerance = 1e-05) expect_type(names(simulationResult), "character") df <- as.data.frame(simulationResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': Specify accrual time as a list, if maximum number of subjects need to be calculated", { .skipTestIfDisabled() at <- list("0 - <6" = 20, "6 - <=10" = 30) simulationResult <- getSimulationSurvival(plannedEvents = 40, accrualTime = at, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResult' with expected results expect_equal(simulationResult$median1, c(37.275405, 23.320299, 16.282985, 12), tolerance = 1e-07) expect_equal(simulationResult$median2, 37.275405, tolerance = 1e-07) expect_equal(simulationResult$maxNumberOfSubjects, 240) expect_equal(simulationResult$lambda1, c(0.018595296, 0.029722912, 0.042568802, 0.057762265), tolerance = 1e-07) expect_equal(simulationResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(simulationResult$hazardRatio, c(1, 1.5984103, 2.2892242, 3.1062837), tolerance = 1e-07) expect_equal(simulationResult$analysisTime[1, ], c(15.210978, 13.172199, 11.59631, 10.698373), tolerance = 1e-07) expect_equal(simulationResult$studyDuration, c(15.210978, 13.172199, 11.59631, 10.698373), tolerance = 1e-07) expect_equal(simulationResult$eventsNotAchieved[1, ], c(0, 0, 0, 0)) expect_equal(simulationResult$iterations[1, ], c(100, 100, 100, 100)) expect_equal(simulationResult$overallReject, c(0.04, 0.33, 0.75, 0.95), tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[1, ], c(0.04, 0.33, 0.75, 0.95), tolerance = 1e-07) expect_equal(simulationResult$earlyStop, c(0, 0, 0, 0)) expect_equal(simulationResult$expectedNumberOfSubjects, c(240, 240, 239.63, 237.56), tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfEvents, c(40, 40, 40, 40)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResult), NA))) expect_output(print(simulationResult)$show()) invisible(capture.output(expect_error(summary(simulationResult), NA))) expect_output(summary(simulationResult)$show()) simulationResultCodeBased <- eval(parse(text = getObjectRCode(simulationResult, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultCodeBased$median1, simulationResult$median1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$median2, simulationResult$median2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$maxNumberOfSubjects, simulationResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda1, simulationResult$lambda1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda2, simulationResult$lambda2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$hazardRatio, simulationResult$hazardRatio, tolerance = 1e-05) expect_equal(simulationResultCodeBased$analysisTime, simulationResult$analysisTime, tolerance = 1e-05) expect_equal(simulationResultCodeBased$studyDuration, simulationResult$studyDuration, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsNotAchieved, simulationResult$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultCodeBased$iterations, simulationResult$iterations, tolerance = 1e-05) expect_equal(simulationResultCodeBased$overallReject, simulationResult$overallReject, tolerance = 1e-05) expect_equal(simulationResultCodeBased$rejectPerStage, simulationResult$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityPerStage, simulationResult$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$earlyStop, simulationResult$earlyStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfSubjects, simulationResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfEvents, simulationResult$expectedNumberOfEvents, tolerance = 1e-05) expect_type(names(simulationResult), "character") df <- as.data.frame(simulationResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': Specify effect size for a two-stage group design with O'Brien & Fleming boundaries Effect size is based on event rates at specified event time, directionUpper = FALSE needs to be specified because it should be shown that hazard ratio < 1", { .skipTestIfDisabled() simulationResult <- getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), pi1 = 0.2, pi2 = 0.3, eventTime = 24, plannedEvents = c(20, 40), maxNumberOfSubjects = 200, directionUpper = FALSE, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResult' with expected results expect_equal(simulationResult$median1, 74.550809, tolerance = 1e-07) expect_equal(simulationResult$median2, 46.640597, tolerance = 1e-07) expect_equal(simulationResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(simulationResult$lambda1, 0.009297648, tolerance = 1e-07) expect_equal(simulationResult$lambda2, 0.014861456, tolerance = 1e-07) expect_equal(simulationResult$hazardRatio, 0.62562161, tolerance = 1e-07) expect_equal(simulationResult$analysisTime[1, ], 14.769473, tolerance = 1e-07) expect_equal(simulationResult$analysisTime[2, ], 24.499634, tolerance = 1e-07) expect_equal(simulationResult$studyDuration, 24.198958, tolerance = 1e-07) expect_equal(simulationResult$eventsNotAchieved[1, ], 0) expect_equal(simulationResult$eventsNotAchieved[2, ], 0) expect_equal(simulationResult$numberOfSubjects[1, ], 199.47, tolerance = 1e-07) expect_equal(simulationResult$numberOfSubjects[2, ], 200) expect_equal(simulationResult$iterations[1, ], 100) expect_equal(simulationResult$iterations[2, ], 97) expect_equal(simulationResult$overallReject, 0.27, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[1, ], 0.03, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[2, ], 0.24, tolerance = 1e-07) expect_equal(simulationResult$futilityPerStage[1, ], 0) expect_equal(simulationResult$earlyStop, 0.03, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfSubjects, 199.9841, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfEvents, 39.4, tolerance = 1e-07) expect_equal(simulationResult$eventsPerStage[1, ], 20) expect_equal(simulationResult$eventsPerStage[2, ], 40) expect_equal(simulationResult$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simulationResult$conditionalPowerAchieved[2, ], 0.29516222, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResult), NA))) expect_output(print(simulationResult)$show()) invisible(capture.output(expect_error(summary(simulationResult), NA))) expect_output(summary(simulationResult)$show()) simulationResultCodeBased <- eval(parse(text = getObjectRCode(simulationResult, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultCodeBased$median1, simulationResult$median1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$median2, simulationResult$median2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$accrualIntensity, simulationResult$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda1, simulationResult$lambda1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda2, simulationResult$lambda2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$hazardRatio, simulationResult$hazardRatio, tolerance = 1e-05) expect_equal(simulationResultCodeBased$analysisTime, simulationResult$analysisTime, tolerance = 1e-05) expect_equal(simulationResultCodeBased$studyDuration, simulationResult$studyDuration, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsNotAchieved, simulationResult$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultCodeBased$numberOfSubjects, simulationResult$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$iterations, simulationResult$iterations, tolerance = 1e-05) expect_equal(simulationResultCodeBased$overallReject, simulationResult$overallReject, tolerance = 1e-05) expect_equal(simulationResultCodeBased$rejectPerStage, simulationResult$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityPerStage, simulationResult$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$earlyStop, simulationResult$earlyStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfSubjects, simulationResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfEvents, simulationResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsPerStage, simulationResult$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$conditionalPowerAchieved, simulationResult$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResult), "character") df <- as.data.frame(simulationResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': As above, but with a three-stage O'Brien and Fleming design with specified information rates, note that planned events consists of integer values", { .skipTestIfDisabled() d3 <- getDesignGroupSequential(informationRates = c(0.4, 0.7, 1)) simulationResult <- getSimulationSurvival(design = d3, pi1 = 0.2, pi2 = 0.3, eventTime = 24, plannedEvents = round(d3$informationRates * 40), maxNumberOfSubjects = 200, directionUpper = FALSE, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResult' with expected results expect_equal(simulationResult$median1, 74.550809, tolerance = 1e-07) expect_equal(simulationResult$median2, 46.640597, tolerance = 1e-07) expect_equal(simulationResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(simulationResult$lambda1, 0.009297648, tolerance = 1e-07) expect_equal(simulationResult$lambda2, 0.014861456, tolerance = 1e-07) expect_equal(simulationResult$hazardRatio, 0.62562161, tolerance = 1e-07) expect_equal(simulationResult$analysisTime[1, ], 13.073331, tolerance = 1e-07) expect_equal(simulationResult$analysisTime[2, ], 18.748105, tolerance = 1e-07) expect_equal(simulationResult$analysisTime[3, ], 24.810251, tolerance = 1e-07) expect_equal(simulationResult$studyDuration, 23.877826, tolerance = 1e-07) expect_equal(simulationResult$eventsNotAchieved[1, ], 0) expect_equal(simulationResult$eventsNotAchieved[2, ], 0) expect_equal(simulationResult$eventsNotAchieved[3, ], 0) expect_equal(simulationResult$numberOfSubjects[1, ], 195.313, tolerance = 1e-07) expect_equal(simulationResult$numberOfSubjects[2, ], 200) expect_equal(simulationResult$numberOfSubjects[3, ], 200) expect_equal(simulationResult$iterations[1, ], 1000) expect_equal(simulationResult$iterations[2, ], 985) expect_equal(simulationResult$iterations[3, ], 861) expect_equal(simulationResult$overallReject, 0.322, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[1, ], 0.015, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[2, ], 0.124, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[3, ], 0.183, tolerance = 1e-07) expect_equal(simulationResult$futilityStop, 0) expect_equal(simulationResult$futilityPerStage[1, ], 0) expect_equal(simulationResult$futilityPerStage[2, ], 0) expect_equal(simulationResult$earlyStop, 0.139, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfSubjects, 199.92969, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfEvents, 38.152, tolerance = 1e-07) expect_equal(simulationResult$eventsPerStage[1, ], 16) expect_equal(simulationResult$eventsPerStage[2, ], 28) expect_equal(simulationResult$eventsPerStage[3, ], 40) expect_equal(simulationResult$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simulationResult$conditionalPowerAchieved[2, ], 0.19637573, tolerance = 1e-07) expect_equal(simulationResult$conditionalPowerAchieved[3, ], 0.23542216, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResult), NA))) expect_output(print(simulationResult)$show()) invisible(capture.output(expect_error(summary(simulationResult), NA))) expect_output(summary(simulationResult)$show()) simulationResultCodeBased <- eval(parse(text = getObjectRCode(simulationResult, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultCodeBased$median1, simulationResult$median1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$median2, simulationResult$median2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$accrualIntensity, simulationResult$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda1, simulationResult$lambda1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda2, simulationResult$lambda2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$hazardRatio, simulationResult$hazardRatio, tolerance = 1e-05) expect_equal(simulationResultCodeBased$analysisTime, simulationResult$analysisTime, tolerance = 1e-05) expect_equal(simulationResultCodeBased$studyDuration, simulationResult$studyDuration, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsNotAchieved, simulationResult$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultCodeBased$numberOfSubjects, simulationResult$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$iterations, simulationResult$iterations, tolerance = 1e-05) expect_equal(simulationResultCodeBased$overallReject, simulationResult$overallReject, tolerance = 1e-05) expect_equal(simulationResultCodeBased$rejectPerStage, simulationResult$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityStop, simulationResult$futilityStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityPerStage, simulationResult$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$earlyStop, simulationResult$earlyStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfSubjects, simulationResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfEvents, simulationResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsPerStage, simulationResult$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$conditionalPowerAchieved, simulationResult$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResult), "character") df <- as.data.frame(simulationResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': Effect size is based on event rate at specified event time for the reference group and hazard ratio, directionUpper = FALSE needs to be specified because it should be shown that hazard ratio < 1", { .skipTestIfDisabled() simulationResult <- getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), hazardRatio = 0.5, pi2 = 0.3, eventTime = 24, plannedEvents = c(20, 40), maxNumberOfSubjects = 200, directionUpper = FALSE, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResult' with expected results expect_equal(simulationResult$pi1, 0.16333997, tolerance = 1e-07) expect_equal(simulationResult$median1, 93.281194, tolerance = 1e-07) expect_equal(simulationResult$median2, 46.640597, tolerance = 1e-07) expect_equal(simulationResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(simulationResult$lambda1, 0.007430728, tolerance = 1e-07) expect_equal(simulationResult$lambda2, 0.014861456, tolerance = 1e-07) expect_equal(simulationResult$analysisTime[1, ], 15.596955, tolerance = 1e-07) expect_equal(simulationResult$analysisTime[2, ], 26.310745, tolerance = 1e-07) expect_equal(simulationResult$studyDuration, 25.440402, tolerance = 1e-07) expect_equal(simulationResult$eventsNotAchieved[1, ], 0) expect_equal(simulationResult$eventsNotAchieved[2, ], 0) expect_equal(simulationResult$numberOfSubjects[1, ], 199.69, tolerance = 1e-07) expect_equal(simulationResult$numberOfSubjects[2, ], 200) expect_equal(simulationResult$iterations[1, ], 100) expect_equal(simulationResult$iterations[2, ], 92) expect_equal(simulationResult$overallReject, 0.52, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[1, ], 0.08, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[2, ], 0.44, tolerance = 1e-07) expect_equal(simulationResult$futilityPerStage[1, ], 0) expect_equal(simulationResult$earlyStop, 0.08, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfSubjects, 199.9752, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfEvents, 38.4, tolerance = 1e-07) expect_equal(simulationResult$eventsPerStage[1, ], 20) expect_equal(simulationResult$eventsPerStage[2, ], 40) expect_equal(simulationResult$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simulationResult$conditionalPowerAchieved[2, ], 0.43087375, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResult), NA))) expect_output(print(simulationResult)$show()) invisible(capture.output(expect_error(summary(simulationResult), NA))) expect_output(summary(simulationResult)$show()) simulationResultCodeBased <- eval(parse(text = getObjectRCode(simulationResult, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultCodeBased$pi1, simulationResult$pi1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$median1, simulationResult$median1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$median2, simulationResult$median2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$accrualIntensity, simulationResult$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda1, simulationResult$lambda1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda2, simulationResult$lambda2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$analysisTime, simulationResult$analysisTime, tolerance = 1e-05) expect_equal(simulationResultCodeBased$studyDuration, simulationResult$studyDuration, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsNotAchieved, simulationResult$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultCodeBased$numberOfSubjects, simulationResult$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$iterations, simulationResult$iterations, tolerance = 1e-05) expect_equal(simulationResultCodeBased$overallReject, simulationResult$overallReject, tolerance = 1e-05) expect_equal(simulationResultCodeBased$rejectPerStage, simulationResult$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityPerStage, simulationResult$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$earlyStop, simulationResult$earlyStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfSubjects, simulationResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfEvents, simulationResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsPerStage, simulationResult$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$conditionalPowerAchieved, simulationResult$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResult), "character") df <- as.data.frame(simulationResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': Effect size is based on hazard rate for the reference group and hazard ratio, directionUpper = FALSE needs to be specified because it should be shown that hazard ratio < 1", { .skipTestIfDisabled() simulationResult <- getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), hazardRatio = 0.5, lambda2 = 0.02, plannedEvents = c(20, 40), maxNumberOfSubjects = 200, directionUpper = FALSE, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResult' with expected results expect_equal(simulationResult$median1, 69.314718, tolerance = 1e-07) expect_equal(simulationResult$median2, 34.657359, tolerance = 1e-07) expect_equal(simulationResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(simulationResult$lambda1, 0.01, tolerance = 1e-07) expect_equal(simulationResult$analysisTime[1, ], 13.132525, tolerance = 1e-07) expect_equal(simulationResult$analysisTime[2, ], 21.186744, tolerance = 1e-07) expect_equal(simulationResult$studyDuration, 20.690944, tolerance = 1e-07) expect_equal(simulationResult$eventsNotAchieved[1, ], 0) expect_equal(simulationResult$eventsNotAchieved[2, ], 0) expect_equal(simulationResult$numberOfSubjects[1, ], 195.5, tolerance = 1e-07) expect_equal(simulationResult$numberOfSubjects[2, ], 200) expect_equal(simulationResult$iterations[1, ], 100) expect_equal(simulationResult$iterations[2, ], 94) expect_equal(simulationResult$overallReject, 0.49, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[1, ], 0.06, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[2, ], 0.43, tolerance = 1e-07) expect_equal(simulationResult$futilityPerStage[1, ], 0) expect_equal(simulationResult$earlyStop, 0.06, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfSubjects, 199.73, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfEvents, 38.8, tolerance = 1e-07) expect_equal(simulationResult$eventsPerStage[1, ], 20) expect_equal(simulationResult$eventsPerStage[2, ], 40) expect_equal(simulationResult$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simulationResult$conditionalPowerAchieved[2, ], 0.48014443, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResult), NA))) expect_output(print(simulationResult)$show()) invisible(capture.output(expect_error(summary(simulationResult), NA))) expect_output(summary(simulationResult)$show()) simulationResultCodeBased <- eval(parse(text = getObjectRCode(simulationResult, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultCodeBased$median1, simulationResult$median1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$median2, simulationResult$median2, tolerance = 1e-05) expect_equal(simulationResultCodeBased$accrualIntensity, simulationResult$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda1, simulationResult$lambda1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$analysisTime, simulationResult$analysisTime, tolerance = 1e-05) expect_equal(simulationResultCodeBased$studyDuration, simulationResult$studyDuration, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsNotAchieved, simulationResult$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultCodeBased$numberOfSubjects, simulationResult$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$iterations, simulationResult$iterations, tolerance = 1e-05) expect_equal(simulationResultCodeBased$overallReject, simulationResult$overallReject, tolerance = 1e-05) expect_equal(simulationResultCodeBased$rejectPerStage, simulationResult$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityPerStage, simulationResult$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$earlyStop, simulationResult$earlyStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfSubjects, simulationResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfEvents, simulationResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsPerStage, simulationResult$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$conditionalPowerAchieved, simulationResult$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResult), "character") df <- as.data.frame(simulationResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': Specification of piecewise exponential survival time and hazard ratios, note that in getSimulationSurvival only one hazard ratio is used in the case that the survival time is piecewise exponential", { .skipTestIfDisabled() simulationResult <- getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.01, 0.02, 0.04), hazardRatio = 1.5, plannedEvents = c(20, 40), maxNumberOfSubjects = 200, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResult' with expected results expect_equal(simulationResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(simulationResult$lambda1, c(0.015, 0.03, 0.06), tolerance = 1e-07) expect_equal(simulationResult$analysisTime[1, ], 12.106711, tolerance = 1e-07) expect_equal(simulationResult$analysisTime[2, ], 16.150578, tolerance = 1e-07) expect_equal(simulationResult$studyDuration, 16.020702, tolerance = 1e-07) expect_equal(simulationResult$eventsNotAchieved[1, ], 0) expect_equal(simulationResult$eventsNotAchieved[2, ], 0) expect_equal(simulationResult$numberOfSubjects[1, ], 193.51, tolerance = 1e-07) expect_equal(simulationResult$numberOfSubjects[2, ], 200) expect_equal(simulationResult$iterations[1, ], 100) expect_equal(simulationResult$iterations[2, ], 96) expect_equal(simulationResult$overallReject, 0.32, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[1, ], 0.04, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[2, ], 0.28, tolerance = 1e-07) expect_equal(simulationResult$futilityPerStage[1, ], 0) expect_equal(simulationResult$earlyStop, 0.04, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfSubjects, 199.7404, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfEvents, 39.2, tolerance = 1e-07) expect_equal(simulationResult$eventsPerStage[1, ], 20) expect_equal(simulationResult$eventsPerStage[2, ], 40) expect_equal(simulationResult$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simulationResult$conditionalPowerAchieved[2, ], 0.33404702, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResult), NA))) expect_output(print(simulationResult)$show()) invisible(capture.output(expect_error(summary(simulationResult), NA))) expect_output(summary(simulationResult)$show()) simulationResultCodeBased <- eval(parse(text = getObjectRCode(simulationResult, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultCodeBased$accrualIntensity, simulationResult$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda1, simulationResult$lambda1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$analysisTime, simulationResult$analysisTime, tolerance = 1e-05) expect_equal(simulationResultCodeBased$studyDuration, simulationResult$studyDuration, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsNotAchieved, simulationResult$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultCodeBased$numberOfSubjects, simulationResult$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$iterations, simulationResult$iterations, tolerance = 1e-05) expect_equal(simulationResultCodeBased$overallReject, simulationResult$overallReject, tolerance = 1e-05) expect_equal(simulationResultCodeBased$rejectPerStage, simulationResult$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityPerStage, simulationResult$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$earlyStop, simulationResult$earlyStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfSubjects, simulationResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfEvents, simulationResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsPerStage, simulationResult$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$conditionalPowerAchieved, simulationResult$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResult), "character") df <- as.data.frame(simulationResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pws <- list("0 - <5" = 0.01, "5 - <10" = 0.02, ">=10" = 0.04) simulationResult <- getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = pws, hazardRatio = c(1.5), plannedEvents = c(20, 40), maxNumberOfSubjects = 200, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResult' with expected results expect_equal(simulationResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(simulationResult$lambda1, c(0.015, 0.03, 0.06), tolerance = 1e-07) expect_equal(simulationResult$analysisTime[1, ], 12.106711, tolerance = 1e-07) expect_equal(simulationResult$analysisTime[2, ], 16.150578, tolerance = 1e-07) expect_equal(simulationResult$studyDuration, 16.020702, tolerance = 1e-07) expect_equal(simulationResult$eventsNotAchieved[1, ], 0) expect_equal(simulationResult$eventsNotAchieved[2, ], 0) expect_equal(simulationResult$numberOfSubjects[1, ], 193.51, tolerance = 1e-07) expect_equal(simulationResult$numberOfSubjects[2, ], 200) expect_equal(simulationResult$iterations[1, ], 100) expect_equal(simulationResult$iterations[2, ], 96) expect_equal(simulationResult$overallReject, 0.32, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[1, ], 0.04, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[2, ], 0.28, tolerance = 1e-07) expect_equal(simulationResult$futilityPerStage[1, ], 0) expect_equal(simulationResult$earlyStop, 0.04, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfSubjects, 199.7404, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfEvents, 39.2, tolerance = 1e-07) expect_equal(simulationResult$eventsPerStage[1, ], 20) expect_equal(simulationResult$eventsPerStage[2, ], 40) expect_equal(simulationResult$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simulationResult$conditionalPowerAchieved[2, ], 0.33404702, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResult), NA))) expect_output(print(simulationResult)$show()) invisible(capture.output(expect_error(summary(simulationResult), NA))) expect_output(summary(simulationResult)$show()) simulationResultCodeBased <- eval(parse(text = getObjectRCode(simulationResult, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultCodeBased$accrualIntensity, simulationResult$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda1, simulationResult$lambda1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$analysisTime, simulationResult$analysisTime, tolerance = 1e-05) expect_equal(simulationResultCodeBased$studyDuration, simulationResult$studyDuration, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsNotAchieved, simulationResult$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultCodeBased$numberOfSubjects, simulationResult$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$iterations, simulationResult$iterations, tolerance = 1e-05) expect_equal(simulationResultCodeBased$overallReject, simulationResult$overallReject, tolerance = 1e-05) expect_equal(simulationResultCodeBased$rejectPerStage, simulationResult$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityPerStage, simulationResult$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$earlyStop, simulationResult$earlyStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfSubjects, simulationResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfEvents, simulationResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsPerStage, simulationResult$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$conditionalPowerAchieved, simulationResult$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResult), "character") df <- as.data.frame(simulationResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': Specification of piecewise exponential survival time for both treatment arms ", { .skipTestIfDisabled() simulationResult <- getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.01, 0.02, 0.04), lambda1 = c(0.015, 0.03, 0.06), plannedEvents = c(20, 40), maxNumberOfSubjects = 200, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResult' with expected results expect_equal(simulationResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(simulationResult$hazardRatio, 1.5, tolerance = 1e-07) expect_equal(simulationResult$analysisTime[1, ], 12.106711, tolerance = 1e-07) expect_equal(simulationResult$analysisTime[2, ], 16.150578, tolerance = 1e-07) expect_equal(simulationResult$studyDuration, 16.020702, tolerance = 1e-07) expect_equal(simulationResult$eventsNotAchieved[1, ], 0) expect_equal(simulationResult$eventsNotAchieved[2, ], 0) expect_equal(simulationResult$numberOfSubjects[1, ], 193.51, tolerance = 1e-07) expect_equal(simulationResult$numberOfSubjects[2, ], 200) expect_equal(simulationResult$iterations[1, ], 100) expect_equal(simulationResult$iterations[2, ], 96) expect_equal(simulationResult$overallReject, 0.32, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[1, ], 0.04, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[2, ], 0.28, tolerance = 1e-07) expect_equal(simulationResult$futilityPerStage[1, ], 0) expect_equal(simulationResult$earlyStop, 0.04, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfSubjects, 199.7404, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfEvents, 39.2, tolerance = 1e-07) expect_equal(simulationResult$eventsPerStage[1, ], 20) expect_equal(simulationResult$eventsPerStage[2, ], 40) expect_equal(simulationResult$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simulationResult$conditionalPowerAchieved[2, ], 0.33404702, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResult), NA))) expect_output(print(simulationResult)$show()) invisible(capture.output(expect_error(summary(simulationResult), NA))) expect_output(summary(simulationResult)$show()) simulationResultCodeBased <- eval(parse(text = getObjectRCode(simulationResult, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultCodeBased$accrualIntensity, simulationResult$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultCodeBased$hazardRatio, simulationResult$hazardRatio, tolerance = 1e-05) expect_equal(simulationResultCodeBased$analysisTime, simulationResult$analysisTime, tolerance = 1e-05) expect_equal(simulationResultCodeBased$studyDuration, simulationResult$studyDuration, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsNotAchieved, simulationResult$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultCodeBased$numberOfSubjects, simulationResult$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$iterations, simulationResult$iterations, tolerance = 1e-05) expect_equal(simulationResultCodeBased$overallReject, simulationResult$overallReject, tolerance = 1e-05) expect_equal(simulationResultCodeBased$rejectPerStage, simulationResult$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityPerStage, simulationResult$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$earlyStop, simulationResult$earlyStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfSubjects, simulationResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfEvents, simulationResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsPerStage, simulationResult$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$conditionalPowerAchieved, simulationResult$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResult), "character") df <- as.data.frame(simulationResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pws <- list("0 - <5" = 0.01, "5 - <10" = 0.02, ">=10" = 0.04) simulationResult <- getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = pws, hazardRatio = 1.5, plannedEvents = c(20, 40), maxNumberOfSubjects = 200, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResult' with expected results expect_equal(simulationResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(simulationResult$lambda1, c(0.015, 0.03, 0.06), tolerance = 1e-07) expect_equal(simulationResult$analysisTime[1, ], 12.106711, tolerance = 1e-07) expect_equal(simulationResult$analysisTime[2, ], 16.150578, tolerance = 1e-07) expect_equal(simulationResult$studyDuration, 16.020702, tolerance = 1e-07) expect_equal(simulationResult$eventsNotAchieved[1, ], 0) expect_equal(simulationResult$eventsNotAchieved[2, ], 0) expect_equal(simulationResult$numberOfSubjects[1, ], 193.51, tolerance = 1e-07) expect_equal(simulationResult$numberOfSubjects[2, ], 200) expect_equal(simulationResult$iterations[1, ], 100) expect_equal(simulationResult$iterations[2, ], 96) expect_equal(simulationResult$overallReject, 0.32, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[1, ], 0.04, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[2, ], 0.28, tolerance = 1e-07) expect_equal(simulationResult$futilityPerStage[1, ], 0) expect_equal(simulationResult$earlyStop, 0.04, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfSubjects, 199.7404, tolerance = 1e-07) expect_equal(simulationResult$expectedNumberOfEvents, 39.2, tolerance = 1e-07) expect_equal(simulationResult$eventsPerStage[1, ], 20) expect_equal(simulationResult$eventsPerStage[2, ], 40) expect_equal(simulationResult$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simulationResult$conditionalPowerAchieved[2, ], 0.33404702, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResult), NA))) expect_output(print(simulationResult)$show()) invisible(capture.output(expect_error(summary(simulationResult), NA))) expect_output(summary(simulationResult)$show()) simulationResultCodeBased <- eval(parse(text = getObjectRCode(simulationResult, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultCodeBased$accrualIntensity, simulationResult$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultCodeBased$lambda1, simulationResult$lambda1, tolerance = 1e-05) expect_equal(simulationResultCodeBased$analysisTime, simulationResult$analysisTime, tolerance = 1e-05) expect_equal(simulationResultCodeBased$studyDuration, simulationResult$studyDuration, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsNotAchieved, simulationResult$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultCodeBased$numberOfSubjects, simulationResult$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$iterations, simulationResult$iterations, tolerance = 1e-05) expect_equal(simulationResultCodeBased$overallReject, simulationResult$overallReject, tolerance = 1e-05) expect_equal(simulationResultCodeBased$rejectPerStage, simulationResult$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityPerStage, simulationResult$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$earlyStop, simulationResult$earlyStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfSubjects, simulationResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfEvents, simulationResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsPerStage, simulationResult$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$conditionalPowerAchieved, simulationResult$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResult), "character") df <- as.data.frame(simulationResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } simulationResult <- getSimulationSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.01, 0.02, 0.04), lambda1 = c(0.01, 0.02, 0.06), plannedEvents = c(20, 40), maxNumberOfSubjects = 200, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'simulationResult' with expected results expect_equal(simulationResult$accrualIntensity, 16.666667, tolerance = 1e-07) expect_equal(simulationResult$hazardRatio, c(1, 1, 1.5), tolerance = 1e-07) expect_equal(simulationResult$analysisTime[1, ], 12.973056, tolerance = 1e-07) expect_equal(simulationResult$analysisTime[2, ], 17.030809, tolerance = 1e-07) expect_equal(simulationResult$studyDuration, 17.030809, tolerance = 1e-07) expect_equal(simulationResult$eventsNotAchieved[1, ], 0) expect_equal(simulationResult$eventsNotAchieved[2, ], 0) expect_equal(simulationResult$numberOfSubjects[1, ], 197.81, tolerance = 1e-07) expect_equal(simulationResult$numberOfSubjects[2, ], 200) expect_equal(simulationResult$iterations[1, ], 100) expect_equal(simulationResult$iterations[2, ], 100) expect_equal(simulationResult$overallReject, 0.06, tolerance = 1e-07) expect_equal(simulationResult$rejectPerStage[1, ], 0) expect_equal(simulationResult$rejectPerStage[2, ], 0.06, tolerance = 1e-07) expect_equal(simulationResult$futilityPerStage[1, ], 0) expect_equal(simulationResult$earlyStop, 0) expect_equal(simulationResult$expectedNumberOfSubjects, 200) expect_equal(simulationResult$expectedNumberOfEvents, 40) expect_equal(simulationResult$eventsPerStage[1, ], 20) expect_equal(simulationResult$eventsPerStage[2, ], 40) expect_equal(simulationResult$conditionalPowerAchieved[1, ], NA_real_) expect_equal(simulationResult$conditionalPowerAchieved[2, ], 0.1789388, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(simulationResult), NA))) expect_output(print(simulationResult)$show()) invisible(capture.output(expect_error(summary(simulationResult), NA))) expect_output(summary(simulationResult)$show()) simulationResultCodeBased <- eval(parse(text = getObjectRCode(simulationResult, stringWrapParagraphWidth = NULL))) expect_equal(simulationResultCodeBased$accrualIntensity, simulationResult$accrualIntensity, tolerance = 1e-05) expect_equal(simulationResultCodeBased$hazardRatio, simulationResult$hazardRatio, tolerance = 1e-05) expect_equal(simulationResultCodeBased$analysisTime, simulationResult$analysisTime, tolerance = 1e-05) expect_equal(simulationResultCodeBased$studyDuration, simulationResult$studyDuration, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsNotAchieved, simulationResult$eventsNotAchieved, tolerance = 1e-05) expect_equal(simulationResultCodeBased$numberOfSubjects, simulationResult$numberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$iterations, simulationResult$iterations, tolerance = 1e-05) expect_equal(simulationResultCodeBased$overallReject, simulationResult$overallReject, tolerance = 1e-05) expect_equal(simulationResultCodeBased$rejectPerStage, simulationResult$rejectPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$futilityPerStage, simulationResult$futilityPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$earlyStop, simulationResult$earlyStop, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfSubjects, simulationResult$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(simulationResultCodeBased$expectedNumberOfEvents, simulationResult$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(simulationResultCodeBased$eventsPerStage, simulationResult$eventsPerStage, tolerance = 1e-05) expect_equal(simulationResultCodeBased$conditionalPowerAchieved, simulationResult$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(simulationResult), "character") df <- as.data.frame(simulationResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(simulationResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationSurvival': Perform recalculation of number of events based on conditional power", { .skipTestIfDisabled() # Perform recalculation of number of events based on conditional power for a # three-stage design with inverse normal combination test, where the conditional power # is calculated under the specified effect size thetaH1 = 1.3 and up to a four-fold # increase in originally planned sample size (number of events) is allowed # Note that the first value in \code{minNumberOfEventsPerStage} and # \code{maxNumberOfEventsPerStage} is arbitrary, i.e., it has no effect. dIN <- getDesignInverseNormal(informationRates = c(0.4, 0.7, 1)) resultsWithSSR1 <- getSimulationSurvival(design = dIN, hazardRatio = seq(1, 1.6, 0.1), pi2 = 0.3, conditionalPower = 0.8, thetaH1 = 1.3, plannedEvents = c(58, 102, 146), minNumberOfEventsPerStage = c(NA_real_, 44, 44), maxNumberOfEventsPerStage = 4 * c(NA_real_, 44, 44), maxNumberOfSubjects = 800, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'resultsWithSSR1' with expected results expect_equal(resultsWithSSR1$pi1, c(0.3, 0.32452723, 0.34819506, 0.37103359, 0.39307188, 0.41433798, 0.43485894), tolerance = 1e-07) expect_equal(resultsWithSSR1$median1, c(23.320299, 21.200271, 19.433582, 17.938691, 16.657356, 15.546866, 14.575187), tolerance = 1e-07) expect_equal(resultsWithSSR1$median2, 23.320299, tolerance = 1e-07) expect_equal(resultsWithSSR1$accrualIntensity, 66.666667, tolerance = 1e-07) expect_equal(resultsWithSSR1$lambda1, c(0.029722912, 0.032695203, 0.035667494, 0.038639786, 0.041612077, 0.044584368, 0.047556659), tolerance = 1e-07) expect_equal(resultsWithSSR1$lambda2, 0.029722912, tolerance = 1e-07) expect_equal(resultsWithSSR1$analysisTime[1, ], c(7.9761501, 7.8239889, 7.5191849, 7.4832292, 7.3291066, 7.1091953, 6.9737455), tolerance = 1e-07) expect_equal(resultsWithSSR1$analysisTime[2, ], c(17.76189, 17.229038, 16.567328, 16.175906, 15.668575, 15.328143, 14.604753), tolerance = 1e-07) expect_equal(resultsWithSSR1$analysisTime[3, ], c(30.192276, 28.615009, 26.463502, 25.657109, 23.821118, 23.34898, 22.534023), tolerance = 1e-07) expect_equal(resultsWithSSR1$studyDuration, c(29.683899, 28.160756, 25.20615, 22.190278, 19.319577, 18.030286, 14.789904), tolerance = 1e-07) expect_equal(resultsWithSSR1$eventsNotAchieved[1, ], c(0, 0, 0, 0, 0, 0, 0)) expect_equal(resultsWithSSR1$eventsNotAchieved[2, ], c(0, 0, 0, 0, 0, 0, 0)) expect_equal(resultsWithSSR1$eventsNotAchieved[3, ], c(0, 0, 0, 0, 0, 0, 0)) expect_equal(resultsWithSSR1$numberOfSubjects[1, ], c(531.25, 521.07, 500.8, 498.42, 488.13, 473.47, 464.37), tolerance = 1e-07) expect_equal(resultsWithSSR1$numberOfSubjects[2, ], c(800, 800, 799.45, 798.66327, 796.55208, 797.06061, 793.47826), tolerance = 1e-07) expect_equal(resultsWithSSR1$numberOfSubjects[3, ], c(800, 800, 800, 800, 800, 800, 800)) expect_equal(resultsWithSSR1$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100)) expect_equal(resultsWithSSR1$iterations[2, ], c(100, 100, 100, 98, 96, 99, 92)) expect_equal(resultsWithSSR1$iterations[3, ], c(96, 96, 88, 67, 50, 35, 11)) expect_equal(resultsWithSSR1$overallReject, c(0.04, 0.16, 0.38, 0.75, 0.91, 0.95, 1), tolerance = 1e-07) expect_equal(resultsWithSSR1$rejectPerStage[1, ], c(0, 0, 0, 0.02, 0.04, 0.01, 0.08), tolerance = 1e-07) expect_equal(resultsWithSSR1$rejectPerStage[2, ], c(0.04, 0.04, 0.12, 0.31, 0.46, 0.64, 0.81), tolerance = 1e-07) expect_equal(resultsWithSSR1$rejectPerStage[3, ], c(0, 0.12, 0.26, 0.42, 0.41, 0.3, 0.11), tolerance = 1e-07) expect_equal(resultsWithSSR1$futilityStop, c(0, 0, 0, 0, 0, 0, 0)) expect_equal(resultsWithSSR1$futilityPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0)) expect_equal(resultsWithSSR1$futilityPerStage[2, ], c(0, 0, 0, 0, 0, 0, 0)) expect_equal(resultsWithSSR1$earlyStop, c(0.04, 0.04, 0.12, 0.33, 0.5, 0.65, 0.89), tolerance = 1e-07) expect_equal(resultsWithSSR1$expectedNumberOfSubjects, c(800, 800, 799.934, 793.55401, 785.93916, 794.85349, 767.86699), tolerance = 1e-07) expect_equal(resultsWithSSR1$expectedNumberOfEvents, c(401.92, 394, 365.45, 325.77, 290.4, 275.74, 221.24), tolerance = 1e-07) expect_equal(resultsWithSSR1$eventsPerStage[1, ], c(58, 58, 58, 58, 58, 58, 58)) expect_equal(resultsWithSSR1$eventsPerStage[2, ], c(233.65, 231.27, 229.84, 229.43878, 228.57292, 227.67677, 219.44565), tolerance = 1e-07) expect_equal(resultsWithSSR1$eventsPerStage[3, ], c(408.93125, 400.78042, 383.94227, 378.3343, 365.87292, 369.8482, 353.17292), tolerance = 1e-07) expect_equal(resultsWithSSR1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(resultsWithSSR1$conditionalPowerAchieved[2, ], c(0.12165751, 0.15502837, 0.23497758, 0.29890789, 0.33886493, 0.41286728, 0.49916888), tolerance = 1e-07) expect_equal(resultsWithSSR1$conditionalPowerAchieved[3, ], c(0.14749827, 0.23857933, 0.44868993, 0.59763371, 0.65378645, 0.66059558, 0.69812096), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(resultsWithSSR1), NA))) expect_output(print(resultsWithSSR1)$show()) invisible(capture.output(expect_error(summary(resultsWithSSR1), NA))) expect_output(summary(resultsWithSSR1)$show()) resultsWithSSR1CodeBased <- eval(parse(text = getObjectRCode(resultsWithSSR1, stringWrapParagraphWidth = NULL))) expect_equal(resultsWithSSR1CodeBased$pi1, resultsWithSSR1$pi1, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$median1, resultsWithSSR1$median1, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$median2, resultsWithSSR1$median2, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$accrualIntensity, resultsWithSSR1$accrualIntensity, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$lambda1, resultsWithSSR1$lambda1, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$lambda2, resultsWithSSR1$lambda2, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$analysisTime, resultsWithSSR1$analysisTime, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$studyDuration, resultsWithSSR1$studyDuration, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$eventsNotAchieved, resultsWithSSR1$eventsNotAchieved, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$numberOfSubjects, resultsWithSSR1$numberOfSubjects, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$iterations, resultsWithSSR1$iterations, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$overallReject, resultsWithSSR1$overallReject, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$rejectPerStage, resultsWithSSR1$rejectPerStage, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$futilityStop, resultsWithSSR1$futilityStop, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$futilityPerStage, resultsWithSSR1$futilityPerStage, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$earlyStop, resultsWithSSR1$earlyStop, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$expectedNumberOfSubjects, resultsWithSSR1$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$expectedNumberOfEvents, resultsWithSSR1$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$eventsPerStage, resultsWithSSR1$eventsPerStage, tolerance = 1e-05) expect_equal(resultsWithSSR1CodeBased$conditionalPowerAchieved, resultsWithSSR1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(resultsWithSSR1), "character") df <- as.data.frame(resultsWithSSR1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(resultsWithSSR1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # If thetaH1 is unspecified, the observed hazard ratio estimate # (calculated from the log-rank statistic) is used for performing the # recalculation of the number of events resultsWithSSR2 <- getSimulationSurvival(design = dIN, hazardRatio = seq(1, 1.6, 0.1), pi2 = 0.3, conditionalPower = 0.8, plannedEvents = c(58, 102, 146), minNumberOfEventsPerStage = c(NA_real_, 44, 44), maxNumberOfEventsPerStage = 4 * c(NA_real_, 44, 44), maxNumberOfSubjects = 800, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of SimulationResultsSurvival object 'resultsWithSSR2' with expected results expect_equal(resultsWithSSR2$pi1, c(0.3, 0.32452723, 0.34819506, 0.37103359, 0.39307188, 0.41433798, 0.43485894), tolerance = 1e-07) expect_equal(resultsWithSSR2$median1, c(23.320299, 21.200271, 19.433582, 17.938691, 16.657356, 15.546866, 14.575187), tolerance = 1e-07) expect_equal(resultsWithSSR2$median2, 23.320299, tolerance = 1e-07) expect_equal(resultsWithSSR2$accrualIntensity, 66.666667, tolerance = 1e-07) expect_equal(resultsWithSSR2$lambda1, c(0.029722912, 0.032695203, 0.035667494, 0.038639786, 0.041612077, 0.044584368, 0.047556659), tolerance = 1e-07) expect_equal(resultsWithSSR2$lambda2, 0.029722912, tolerance = 1e-07) expect_equal(resultsWithSSR2$analysisTime[1, ], c(7.9761501, 7.8239889, 7.5191849, 7.4832292, 7.3291066, 7.1091953, 6.9737455), tolerance = 1e-07) expect_equal(resultsWithSSR2$analysisTime[2, ], c(17.532866, 16.792737, 15.753436, 15.242772, 14.414526, 13.395253, 12.536642), tolerance = 1e-07) expect_equal(resultsWithSSR2$analysisTime[3, ], c(29.782185, 28.27297, 25.249508, 24.235039, 21.407797, 20.846814, 17.625231), tolerance = 1e-07) expect_equal(resultsWithSSR2$studyDuration, c(29.663096, 27.530562, 24.305604, 21.136576, 18.176787, 16.398878, 13.170673), tolerance = 1e-07) expect_equal(resultsWithSSR2$eventsNotAchieved[1, ], c(0, 0, 0, 0, 0, 0, 0)) expect_equal(resultsWithSSR2$eventsNotAchieved[2, ], c(0, 0, 0, 0, 0, 0, 0)) expect_equal(resultsWithSSR2$eventsNotAchieved[3, ], c(0, 0, 0, 0, 0, 0, 0)) expect_equal(resultsWithSSR2$numberOfSubjects[1, ], c(531.25, 521.07, 500.8, 498.42, 488.13, 473.47, 464.37), tolerance = 1e-07) expect_equal(resultsWithSSR2$numberOfSubjects[2, ], c(798.3, 792.67, 784.71, 785.72449, 774.40625, 754.47475, 731), tolerance = 1e-07) expect_equal(resultsWithSSR2$numberOfSubjects[3, ], c(800, 800, 800, 800, 799.08333, 797.51111, 794.95238), tolerance = 1e-07) expect_equal(resultsWithSSR2$iterations[1, ], c(100, 100, 100, 100, 100, 100, 100)) expect_equal(resultsWithSSR2$iterations[2, ], c(100, 100, 100, 98, 96, 99, 92)) expect_equal(resultsWithSSR2$iterations[3, ], c(99, 95, 92, 71, 60, 45, 21)) expect_equal(resultsWithSSR2$overallReject, c(0.04, 0.16, 0.37, 0.68, 0.88, 0.92, 0.98), tolerance = 1e-07) expect_equal(resultsWithSSR2$rejectPerStage[1, ], c(0, 0, 0, 0.02, 0.04, 0.01, 0.08), tolerance = 1e-07) expect_equal(resultsWithSSR2$rejectPerStage[2, ], c(0.01, 0.05, 0.08, 0.27, 0.36, 0.54, 0.71), tolerance = 1e-07) expect_equal(resultsWithSSR2$rejectPerStage[3, ], c(0.03, 0.11, 0.29, 0.39, 0.48, 0.37, 0.19), tolerance = 1e-07) expect_equal(resultsWithSSR2$futilityStop, c(0, 0, 0, 0, 0, 0, 0)) expect_equal(resultsWithSSR2$futilityPerStage[1, ], c(0, 0, 0, 0, 0, 0, 0)) expect_equal(resultsWithSSR2$futilityPerStage[2, ], c(0, 0, 0, 0, 0, 0, 0)) expect_equal(resultsWithSSR2$earlyStop, c(0.01, 0.05, 0.08, 0.29, 0.4, 0.55, 0.79), tolerance = 1e-07) expect_equal(resultsWithSSR2$expectedNumberOfSubjects, c(799.983, 799.6335, 798.7768, 790.11401, 777.76145, 771.03106, 723.0996), tolerance = 1e-07) expect_equal(resultsWithSSR2$expectedNumberOfEvents, c(401.86, 383.74, 349.47, 306.7, 267.64, 241.1, 183.79), tolerance = 1e-07) expect_equal(resultsWithSSR2$eventsPerStage[1, ], c(58, 58, 58, 58, 58, 58, 58)) expect_equal(resultsWithSSR2$eventsPerStage[2, ], c(229.71, 222.76, 213.91, 210.63265, 201.21875, 185.82828, 171.84783), tolerance = 1e-07) expect_equal(resultsWithSSR2$eventsPerStage[3, ], c(403.59889, 392.21263, 361.25783, 350.23829, 321.46875, 311.49495, 272.08592), tolerance = 1e-07) expect_equal(resultsWithSSR2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(resultsWithSSR2$conditionalPowerAchieved[2, ], c(0.13442705, 0.17515425, 0.27216274, 0.37121019, 0.42163288, 0.51345413, 0.62679958), tolerance = 1e-07) expect_equal(resultsWithSSR2$conditionalPowerAchieved[3, ], c(0.088787205, 0.13342075, 0.37806621, 0.51790868, 0.64116584, 0.64220287, 0.73456911), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(resultsWithSSR2), NA))) expect_output(print(resultsWithSSR2)$show()) invisible(capture.output(expect_error(summary(resultsWithSSR2), NA))) expect_output(summary(resultsWithSSR2)$show()) resultsWithSSR2CodeBased <- eval(parse(text = getObjectRCode(resultsWithSSR2, stringWrapParagraphWidth = NULL))) expect_equal(resultsWithSSR2CodeBased$pi1, resultsWithSSR2$pi1, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$median1, resultsWithSSR2$median1, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$median2, resultsWithSSR2$median2, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$accrualIntensity, resultsWithSSR2$accrualIntensity, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$lambda1, resultsWithSSR2$lambda1, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$lambda2, resultsWithSSR2$lambda2, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$analysisTime, resultsWithSSR2$analysisTime, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$studyDuration, resultsWithSSR2$studyDuration, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$eventsNotAchieved, resultsWithSSR2$eventsNotAchieved, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$numberOfSubjects, resultsWithSSR2$numberOfSubjects, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$iterations, resultsWithSSR2$iterations, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$overallReject, resultsWithSSR2$overallReject, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$rejectPerStage, resultsWithSSR2$rejectPerStage, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$futilityStop, resultsWithSSR2$futilityStop, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$futilityPerStage, resultsWithSSR2$futilityPerStage, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$earlyStop, resultsWithSSR2$earlyStop, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$expectedNumberOfSubjects, resultsWithSSR2$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$expectedNumberOfEvents, resultsWithSSR2$expectedNumberOfEvents, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$eventsPerStage, resultsWithSSR2$eventsPerStage, tolerance = 1e-05) expect_equal(resultsWithSSR2CodeBased$conditionalPowerAchieved, resultsWithSSR2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(resultsWithSSR2), "character") df <- as.data.frame(resultsWithSSR2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(resultsWithSSR2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # Compare it with design without event size recalculation resultsWithoutSSR <- getSimulationSurvival(design = dIN, hazardRatio = seq(1, 1.6, 0.1), pi2 = 0.3, plannedEvents = c(58,102,145), maxNumberOfSubjects = 800, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of numeric object 'resultsWithoutSSR$overallReject' with expected results expect_equal(resultsWithoutSSR$overallReject, c(0.06, 0.09, 0.26, 0.36, 0.5, 0.62, 0.8), tolerance = 1e-07) ## Comparison of the results of numeric object 'resultsWithSSR1$overallReject' with expected results expect_equal(resultsWithSSR1$overallReject, c(0.04, 0.16, 0.38, 0.75, 0.91, 0.95, 1), tolerance = 1e-07) ## Comparison of the results of numeric object 'resultsWithSSR2$overallReject' with expected results expect_equal(resultsWithSSR2$overallReject, c(0.04, 0.16, 0.37, 0.68, 0.88, 0.92, 0.98), tolerance = 1e-07) }) test_that("'getSimulationSurvival': Confirm that event size racalcuation increases the Type I error rate, i.e., you have to use the combination test ", { .skipTestIfDisabled() dGS <- getDesignGroupSequential(informationRates = c(0.4, 0.7, 1)) resultsWithSSRGS <- getSimulationSurvival(design = dGS, hazardRatio = seq(1), pi2 = 0.3, conditionalPower = 0.8, plannedEvents = c(58, 102, 145), minNumberOfEventsPerStage = c(NA_real_, 44, 44), maxNumberOfEventsPerStage = 4 * c(NA_real_, 44, 44), maxNumberOfSubjects = 800, maxNumberOfIterations = 100, seed = 1234567890) ## Comparison of the results of numeric object 'resultsWithSSRGS$overallReject' with expected results expect_equal(resultsWithSSRGS$overallReject, 0.05, tolerance = 1e-07) }) test_that("'getSimulationSurvival': Confirm that different inputs of lambda, median, and pi with the identical meaning result in the same output", { .skipTestIfDisabled() x1 <- getSimulationSurvival( lambda2 = 0.4, hazardRatio = c(0.65, 0.7), plannedEvents = 98, maxNumberOfSubjects = 120, directionUpper = FALSE, maxNumberOfIterations = 1000, sided = 1, alpha = 0.1, seed = 123 ) x2 <- getSimulationSurvival( lambda2 = x1$.piecewiseSurvivalTime$lambda2, lambda1 = x1$.piecewiseSurvivalTime$lambda1, plannedEvents = 98, maxNumberOfSubjects = 120, directionUpper = FALSE, maxNumberOfIterations = 1000, sided = 1, alpha = 0.1, seed = 123 ) x3 <- getSimulationSurvival( piecewiseSurvivalTime = x2$.piecewiseSurvivalTime, plannedEvents = 98, maxNumberOfSubjects = 120, directionUpper = FALSE, maxNumberOfIterations = 1000, sided = 1, alpha = 0.1, seed = 123 ) x4 <- getSimulationSurvival( pi2 = getPiByLambda(x1$.piecewiseSurvivalTime$lambda2, 12L), hazardRatio = c(0.65, 0.7), plannedEvents = 98, maxNumberOfSubjects = 120, directionUpper = FALSE, maxNumberOfIterations = 1000, sided = 1, alpha = 0.1, seed = 123 ) x5 <- getSimulationSurvival( lambda2 = 0.4, lambda1 = x4$lambda1, plannedEvents = 98, maxNumberOfSubjects = 120, directionUpper = FALSE, maxNumberOfIterations = 1000, sided = 1, alpha = 0.1, seed = 123 ) x6 <- getSimulationSurvival( median2 = x5$median2, hazardRatio = c(0.65, 0.7), plannedEvents = 98, maxNumberOfSubjects = 120, directionUpper = FALSE, maxNumberOfIterations = 1000, sided = 1, alpha = 0.1, seed = 123 ) x7 <- getSimulationSurvival( median2 = x5$median2, median1 = x5$median1, plannedEvents = 98, maxNumberOfSubjects = 120, directionUpper = FALSE, maxNumberOfIterations = 1000, sided = 1, alpha = 0.1, seed = 123 ) ## Pairwise comparison of the results of x1 with the results of x2, x3, x4, x5, x6, and x7 expect_equal(x2$maxNumberOfIterations, x1$maxNumberOfIterations) expect_equal(x2$seed, x1$seed) expect_equal(x2$allocationRatioPlanned, x1$allocationRatioPlanned) expect_equal(x2$conditionalPower, x1$conditionalPower) expect_equal(x2$iterations[1, ], x1$iterations[1, ]) expect_equal(x2$futilityStop, x1$futilityStop) expect_equal(x2$directionUpper, x1$directionUpper) expect_equal(x2$plannedEvents, x1$plannedEvents) expect_equal(x2$minNumberOfEventsPerStage, x1$minNumberOfEventsPerStage) expect_equal(x2$maxNumberOfEventsPerStage, x1$maxNumberOfEventsPerStage) expect_equal(x2$thetaH1, x1$thetaH1) expect_equal(x2$expectedNumberOfEvents, x1$expectedNumberOfEvents) expect_equal(x2$pi1, x1$pi1, tolerance = 1e-07) expect_equal(x2$pi2, x1$pi2, tolerance = 1e-07) expect_equal(x2$median1, x1$median1, tolerance = 1e-07) expect_equal(x2$median2, x1$median2, tolerance = 1e-07) expect_equal(x2$maxNumberOfSubjects, x1$maxNumberOfSubjects) expect_equal(x2$accrualTime, x1$accrualTime) expect_equal(x2$accrualIntensity, x1$accrualIntensity) expect_equal(x2$dropoutRate1, x1$dropoutRate1) expect_equal(x2$dropoutRate2, x1$dropoutRate2) expect_equal(x2$dropoutTime, x1$dropoutTime) expect_equal(x2$eventTime, x1$eventTime) expect_equal(x2$thetaH0, x1$thetaH0) expect_equal(x2$allocation1, x1$allocation1) expect_equal(x2$allocation2, x1$allocation2) expect_equal(x2$kappa, x1$kappa) expect_equal(x2$piecewiseSurvivalTime, x1$piecewiseSurvivalTime) expect_equal(x2$lambda1, x1$lambda1, tolerance = 1e-07) expect_equal(x2$lambda2, x1$lambda2, tolerance = 1e-07) expect_equal(x2$earlyStop, x1$earlyStop) expect_equal(x2$hazardRatio, x1$hazardRatio, tolerance = 1e-07) expect_equal(x2$analysisTime[1, ], x1$analysisTime[1, ], tolerance = 1e-07) expect_equal(x2$studyDuration, x1$studyDuration, tolerance = 1e-07) expect_equal(x2$eventsNotAchieved[1, ], x1$eventsNotAchieved[1, ]) expect_equal(x2$numberOfSubjects[1, ], x1$numberOfSubjects[1, ], tolerance = 1e-07) expect_equal(x2$numberOfSubjects1[1, ], x1$numberOfSubjects1[1, ], tolerance = 1e-07) expect_equal(x2$numberOfSubjects2[1, ], x1$numberOfSubjects2[1, ], tolerance = 1e-07) expect_equal(x2$eventsPerStage[1, ], x1$eventsPerStage[1, ]) expect_equal(x2$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-07) expect_equal(x2$rejectPerStage[1, ], x1$rejectPerStage[1, ], tolerance = 1e-07) expect_equal(x2$overallReject, x1$overallReject, tolerance = 1e-07) expect_equal(x3$maxNumberOfIterations, x1$maxNumberOfIterations) expect_equal(x3$seed, x1$seed) expect_equal(x3$allocationRatioPlanned, x1$allocationRatioPlanned) expect_equal(x3$conditionalPower, x1$conditionalPower) expect_equal(x3$iterations[1, ], x1$iterations[1, ]) expect_equal(x3$futilityStop, x1$futilityStop) expect_equal(x3$directionUpper, x1$directionUpper) expect_equal(x3$plannedEvents, x1$plannedEvents) expect_equal(x3$minNumberOfEventsPerStage, x1$minNumberOfEventsPerStage) expect_equal(x3$maxNumberOfEventsPerStage, x1$maxNumberOfEventsPerStage) expect_equal(x3$thetaH1, x1$thetaH1) expect_equal(x3$expectedNumberOfEvents, x1$expectedNumberOfEvents) expect_equal(x3$pi1, x1$pi1, tolerance = 1e-07) expect_equal(x3$pi2, x1$pi2, tolerance = 1e-07) expect_equal(x3$median1, x1$median1, tolerance = 1e-07) expect_equal(x3$median2, x1$median2, tolerance = 1e-07) expect_equal(x3$maxNumberOfSubjects, x1$maxNumberOfSubjects) expect_equal(x3$accrualTime, x1$accrualTime) expect_equal(x3$accrualIntensity, x1$accrualIntensity) expect_equal(x3$dropoutRate1, x1$dropoutRate1) expect_equal(x3$dropoutRate2, x1$dropoutRate2) expect_equal(x3$dropoutTime, x1$dropoutTime) expect_equal(x3$eventTime, x1$eventTime) expect_equal(x3$thetaH0, x1$thetaH0) expect_equal(x3$allocation1, x1$allocation1) expect_equal(x3$allocation2, x1$allocation2) expect_equal(x3$kappa, x1$kappa) expect_equal(x3$piecewiseSurvivalTime, x1$piecewiseSurvivalTime) expect_equal(x3$lambda1, x1$lambda1, tolerance = 1e-07) expect_equal(x3$lambda2, x1$lambda2, tolerance = 1e-07) expect_equal(x3$earlyStop, x1$earlyStop) expect_equal(x3$hazardRatio, x1$hazardRatio, tolerance = 1e-07) expect_equal(x3$analysisTime[1, ], x1$analysisTime[1, ], tolerance = 1e-07) expect_equal(x3$studyDuration, x1$studyDuration, tolerance = 1e-07) expect_equal(x3$eventsNotAchieved[1, ], x1$eventsNotAchieved[1, ]) expect_equal(x3$numberOfSubjects[1, ], x1$numberOfSubjects[1, ], tolerance = 1e-07) expect_equal(x3$numberOfSubjects1[1, ], x1$numberOfSubjects1[1, ], tolerance = 1e-07) expect_equal(x3$numberOfSubjects2[1, ], x1$numberOfSubjects2[1, ], tolerance = 1e-07) expect_equal(x3$eventsPerStage[1, ], x1$eventsPerStage[1, ]) expect_equal(x3$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-07) expect_equal(x3$rejectPerStage[1, ], x1$rejectPerStage[1, ], tolerance = 1e-07) expect_equal(x3$overallReject, x1$overallReject, tolerance = 1e-07) expect_equal(x4$maxNumberOfIterations, x1$maxNumberOfIterations) expect_equal(x4$seed, x1$seed) expect_equal(x4$allocationRatioPlanned, x1$allocationRatioPlanned) expect_equal(x4$conditionalPower, x1$conditionalPower) expect_equal(x4$iterations[1, ], x1$iterations[1, ]) expect_equal(x4$futilityStop, x1$futilityStop) expect_equal(x4$directionUpper, x1$directionUpper) expect_equal(x4$plannedEvents, x1$plannedEvents) expect_equal(x4$minNumberOfEventsPerStage, x1$minNumberOfEventsPerStage) expect_equal(x4$maxNumberOfEventsPerStage, x1$maxNumberOfEventsPerStage) expect_equal(x4$thetaH1, x1$thetaH1) expect_equal(x4$expectedNumberOfEvents, x1$expectedNumberOfEvents) expect_equal(x4$pi1, x1$pi1, tolerance = 1e-07) expect_equal(x4$pi2, x1$pi2, tolerance = 1e-07) expect_equal(x4$median1, x1$median1, tolerance = 1e-07) expect_equal(x4$median2, x1$median2, tolerance = 1e-07) expect_equal(x4$maxNumberOfSubjects, x1$maxNumberOfSubjects) expect_equal(x4$accrualTime, x1$accrualTime) expect_equal(x4$accrualIntensity, x1$accrualIntensity) expect_equal(x4$dropoutRate1, x1$dropoutRate1) expect_equal(x4$dropoutRate2, x1$dropoutRate2) expect_equal(x4$dropoutTime, x1$dropoutTime) expect_equal(x4$thetaH0, x1$thetaH0) expect_equal(x4$allocation1, x1$allocation1) expect_equal(x4$allocation2, x1$allocation2) expect_equal(x4$kappa, x1$kappa) expect_equal(x4$piecewiseSurvivalTime, x1$piecewiseSurvivalTime) expect_equal(x4$lambda1, x1$lambda1, tolerance = 1e-07) expect_equal(x4$lambda2, x1$lambda2, tolerance = 1e-07) expect_equal(x4$earlyStop, x1$earlyStop) expect_equal(x4$hazardRatio, x1$hazardRatio, tolerance = 1e-07) expect_equal(x4$analysisTime[1, ], x1$analysisTime[1, ], tolerance = 1e-07) expect_equal(x4$studyDuration, x1$studyDuration, tolerance = 1e-07) expect_equal(x4$eventsNotAchieved[1, ], x1$eventsNotAchieved[1, ]) expect_equal(x4$numberOfSubjects[1, ], x1$numberOfSubjects[1, ], tolerance = 1e-07) expect_equal(x4$numberOfSubjects1[1, ], x1$numberOfSubjects1[1, ], tolerance = 1e-07) expect_equal(x4$numberOfSubjects2[1, ], x1$numberOfSubjects2[1, ], tolerance = 1e-07) expect_equal(x4$eventsPerStage[1, ], x1$eventsPerStage[1, ]) expect_equal(x4$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-07) expect_equal(x4$rejectPerStage[1, ], x1$rejectPerStage[1, ], tolerance = 1e-07) expect_equal(x4$overallReject, x1$overallReject, tolerance = 1e-07) expect_equal(x5$maxNumberOfIterations, x1$maxNumberOfIterations) expect_equal(x5$seed, x1$seed) expect_equal(x5$allocationRatioPlanned, x1$allocationRatioPlanned) expect_equal(x5$conditionalPower, x1$conditionalPower) expect_equal(x5$iterations[1, ], x1$iterations[1, ]) expect_equal(x5$futilityStop, x1$futilityStop) expect_equal(x5$directionUpper, x1$directionUpper) expect_equal(x5$plannedEvents, x1$plannedEvents) expect_equal(x5$minNumberOfEventsPerStage, x1$minNumberOfEventsPerStage) expect_equal(x5$maxNumberOfEventsPerStage, x1$maxNumberOfEventsPerStage) expect_equal(x5$thetaH1, x1$thetaH1) expect_equal(x5$expectedNumberOfEvents, x1$expectedNumberOfEvents) expect_equal(x5$pi1, x1$pi1, tolerance = 1e-07) expect_equal(x5$pi2, x1$pi2, tolerance = 1e-07) expect_equal(x5$median1, x1$median1, tolerance = 1e-07) expect_equal(x5$median2, x1$median2, tolerance = 1e-07) expect_equal(x5$maxNumberOfSubjects, x1$maxNumberOfSubjects) expect_equal(x5$accrualTime, x1$accrualTime) expect_equal(x5$accrualIntensity, x1$accrualIntensity) expect_equal(x5$dropoutRate1, x1$dropoutRate1) expect_equal(x5$dropoutRate2, x1$dropoutRate2) expect_equal(x5$dropoutTime, x1$dropoutTime) expect_equal(x5$eventTime, x1$eventTime) expect_equal(x5$thetaH0, x1$thetaH0) expect_equal(x5$allocation1, x1$allocation1) expect_equal(x5$allocation2, x1$allocation2) expect_equal(x5$kappa, x1$kappa) expect_equal(x5$piecewiseSurvivalTime, x1$piecewiseSurvivalTime) expect_equal(x5$lambda1, x1$lambda1, tolerance = 1e-07) expect_equal(x5$lambda2, x1$lambda2, tolerance = 1e-07) expect_equal(x5$earlyStop, x1$earlyStop) expect_equal(x5$hazardRatio, x1$hazardRatio, tolerance = 1e-07) expect_equal(x5$analysisTime[1, ], x1$analysisTime[1, ], tolerance = 1e-07) expect_equal(x5$studyDuration, x1$studyDuration, tolerance = 1e-07) expect_equal(x5$eventsNotAchieved[1, ], x1$eventsNotAchieved[1, ]) expect_equal(x5$numberOfSubjects[1, ], x1$numberOfSubjects[1, ], tolerance = 1e-07) expect_equal(x5$numberOfSubjects1[1, ], x1$numberOfSubjects1[1, ], tolerance = 1e-07) expect_equal(x5$numberOfSubjects2[1, ], x1$numberOfSubjects2[1, ], tolerance = 1e-07) expect_equal(x5$eventsPerStage[1, ], x1$eventsPerStage[1, ]) expect_equal(x5$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-07) expect_equal(x5$rejectPerStage[1, ], x1$rejectPerStage[1, ], tolerance = 1e-07) expect_equal(x5$overallReject, x1$overallReject, tolerance = 1e-07) expect_equal(x6$maxNumberOfIterations, x1$maxNumberOfIterations) expect_equal(x6$seed, x1$seed) expect_equal(x6$allocationRatioPlanned, x1$allocationRatioPlanned) expect_equal(x6$conditionalPower, x1$conditionalPower) expect_equal(x6$iterations[1, ], x1$iterations[1, ]) expect_equal(x6$futilityStop, x1$futilityStop) expect_equal(x6$directionUpper, x1$directionUpper) expect_equal(x6$plannedEvents, x1$plannedEvents) expect_equal(x6$minNumberOfEventsPerStage, x1$minNumberOfEventsPerStage) expect_equal(x6$maxNumberOfEventsPerStage, x1$maxNumberOfEventsPerStage) expect_equal(x6$thetaH1, x1$thetaH1) expect_equal(x6$expectedNumberOfEvents, x1$expectedNumberOfEvents) expect_equal(x6$pi1, x1$pi1, tolerance = 1e-07) expect_equal(x6$pi2, x1$pi2, tolerance = 1e-07) expect_equal(x6$median1, x1$median1, tolerance = 1e-07) expect_equal(x6$median2, x1$median2, tolerance = 1e-07) expect_equal(x6$maxNumberOfSubjects, x1$maxNumberOfSubjects) expect_equal(x6$accrualTime, x1$accrualTime) expect_equal(x6$accrualIntensity, x1$accrualIntensity) expect_equal(x6$dropoutRate1, x1$dropoutRate1) expect_equal(x6$dropoutRate2, x1$dropoutRate2) expect_equal(x6$dropoutTime, x1$dropoutTime) expect_equal(x6$eventTime, x1$eventTime) expect_equal(x6$thetaH0, x1$thetaH0) expect_equal(x6$allocation1, x1$allocation1) expect_equal(x6$allocation2, x1$allocation2) expect_equal(x6$kappa, x1$kappa) expect_equal(x6$piecewiseSurvivalTime, x1$piecewiseSurvivalTime) expect_equal(x6$lambda1, x1$lambda1, tolerance = 1e-07) expect_equal(x6$lambda2, x1$lambda2, tolerance = 1e-07) expect_equal(x6$earlyStop, x1$earlyStop) expect_equal(x6$hazardRatio, x1$hazardRatio, tolerance = 1e-07) expect_equal(x6$analysisTime[1, ], x1$analysisTime[1, ], tolerance = 1e-07) expect_equal(x6$studyDuration, x1$studyDuration, tolerance = 1e-07) expect_equal(x6$eventsNotAchieved[1, ], x1$eventsNotAchieved[1, ]) expect_equal(x6$numberOfSubjects[1, ], x1$numberOfSubjects[1, ], tolerance = 1e-07) expect_equal(x6$numberOfSubjects1[1, ], x1$numberOfSubjects1[1, ], tolerance = 1e-07) expect_equal(x6$numberOfSubjects2[1, ], x1$numberOfSubjects2[1, ], tolerance = 1e-07) expect_equal(x6$eventsPerStage[1, ], x1$eventsPerStage[1, ]) expect_equal(x6$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-07) expect_equal(x6$rejectPerStage[1, ], x1$rejectPerStage[1, ], tolerance = 1e-07) expect_equal(x6$overallReject, x1$overallReject, tolerance = 1e-07) expect_equal(x7$maxNumberOfIterations, x1$maxNumberOfIterations) expect_equal(x7$seed, x1$seed) expect_equal(x7$allocationRatioPlanned, x1$allocationRatioPlanned) expect_equal(x7$conditionalPower, x1$conditionalPower) expect_equal(x7$iterations[1, ], x1$iterations[1, ]) expect_equal(x7$futilityStop, x1$futilityStop) expect_equal(x7$directionUpper, x1$directionUpper) expect_equal(x7$plannedEvents, x1$plannedEvents) expect_equal(x7$minNumberOfEventsPerStage, x1$minNumberOfEventsPerStage) expect_equal(x7$maxNumberOfEventsPerStage, x1$maxNumberOfEventsPerStage) expect_equal(x7$thetaH1, x1$thetaH1) expect_equal(x7$expectedNumberOfEvents, x1$expectedNumberOfEvents) expect_equal(x7$pi1, x1$pi1, tolerance = 1e-07) expect_equal(x7$pi2, x1$pi2, tolerance = 1e-07) expect_equal(x7$median1, x1$median1, tolerance = 1e-07) expect_equal(x7$median2, x1$median2, tolerance = 1e-07) expect_equal(x7$maxNumberOfSubjects, x1$maxNumberOfSubjects) expect_equal(x7$accrualTime, x1$accrualTime) expect_equal(x7$accrualIntensity, x1$accrualIntensity) expect_equal(x7$dropoutRate1, x1$dropoutRate1) expect_equal(x7$dropoutRate2, x1$dropoutRate2) expect_equal(x7$dropoutTime, x1$dropoutTime) expect_equal(x7$eventTime, x1$eventTime) expect_equal(x7$thetaH0, x1$thetaH0) expect_equal(x7$allocation1, x1$allocation1) expect_equal(x7$allocation2, x1$allocation2) expect_equal(x7$kappa, x1$kappa) expect_equal(x7$piecewiseSurvivalTime, x1$piecewiseSurvivalTime) expect_equal(x7$lambda1, x1$lambda1, tolerance = 1e-07) expect_equal(x7$lambda2, x1$lambda2, tolerance = 1e-07) expect_equal(x7$earlyStop, x1$earlyStop) expect_equal(x7$hazardRatio, x1$hazardRatio, tolerance = 1e-07) expect_equal(x7$analysisTime[1, ], x1$analysisTime[1, ], tolerance = 1e-07) expect_equal(x7$studyDuration, x1$studyDuration, tolerance = 1e-07) expect_equal(x7$eventsNotAchieved[1, ], x1$eventsNotAchieved[1, ]) expect_equal(x7$numberOfSubjects[1, ], x1$numberOfSubjects[1, ], tolerance = 1e-07) expect_equal(x7$numberOfSubjects1[1, ], x1$numberOfSubjects1[1, ], tolerance = 1e-07) expect_equal(x7$numberOfSubjects2[1, ], x1$numberOfSubjects2[1, ], tolerance = 1e-07) expect_equal(x7$eventsPerStage[1, ], x1$eventsPerStage[1, ]) expect_equal(x7$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-07) expect_equal(x7$rejectPerStage[1, ], x1$rejectPerStage[1, ], tolerance = 1e-07) expect_equal(x7$overallReject, x1$overallReject, tolerance = 1e-07) }) test_that("'getSimulationSurvival': Confirm that different definitions of delayed response with the identical meaning result in the same output", { .skipTestIfDisabled() x1 <- getSimulationSurvival( piecewiseSurvivalTime = c(0, 6), lambda2 = c(1.7, 1.2), hazardRatio = c(0.65, 0.7), plannedEvents = 98, maxNumberOfSubjects = 120, directionUpper = FALSE, maxNumberOfIterations = 1000, sided = 1, alpha = 0.1, seed = 123 ) x2 <- getSimulationSurvival( piecewiseSurvivalTime = list("<6" = 1.7, "6 - Inf" = 1.2), hazardRatio = c(0.65, 0.7), plannedEvents = 98, maxNumberOfSubjects = 120, directionUpper = FALSE, maxNumberOfIterations = 1000, sided = 1, alpha = 0.1, seed = 123 ) ## Pairwise comparison of the results of x1 with the results of x2 expect_equal(x2$maxNumberOfIterations, x1$maxNumberOfIterations) expect_equal(x2$seed, x1$seed) expect_equal(x2$allocationRatioPlanned, x1$allocationRatioPlanned) expect_equal(x2$conditionalPower, x1$conditionalPower) expect_equal(x2$iterations[1, ], x1$iterations[1, ]) expect_equal(x2$futilityStop, x1$futilityStop) expect_equal(x2$directionUpper, x1$directionUpper) expect_equal(x2$plannedEvents, x1$plannedEvents) expect_equal(x2$minNumberOfEventsPerStage, x1$minNumberOfEventsPerStage) expect_equal(x2$maxNumberOfEventsPerStage, x1$maxNumberOfEventsPerStage) expect_equal(x2$thetaH1, x1$thetaH1) expect_equal(x2$expectedNumberOfEvents, x1$expectedNumberOfEvents) expect_equal(x2$pi1, x1$pi1) expect_equal(x2$pi2, x1$pi2) expect_equal(x2$median1, x1$median1) expect_equal(x2$median2, x1$median2) expect_equal(x2$maxNumberOfSubjects, x1$maxNumberOfSubjects) expect_equal(x2$accrualTime, x1$accrualTime) expect_equal(x2$accrualIntensity, x1$accrualIntensity) expect_equal(x2$dropoutRate1, x1$dropoutRate1) expect_equal(x2$dropoutRate2, x1$dropoutRate2) expect_equal(x2$dropoutTime, x1$dropoutTime) expect_equal(x2$eventTime, x1$eventTime) expect_equal(x2$thetaH0, x1$thetaH0) expect_equal(x2$allocation1, x1$allocation1) expect_equal(x2$allocation2, x1$allocation2) expect_equal(x2$kappa, x1$kappa) expect_equal(x2$piecewiseSurvivalTime, x1$piecewiseSurvivalTime) expect_equal(x2$lambda1, x1$lambda1, tolerance = 1e-07) expect_equal(x2$lambda2, x1$lambda2, tolerance = 1e-07) expect_equal(x2$earlyStop, x1$earlyStop) expect_equal(x2$hazardRatio, x1$hazardRatio, tolerance = 1e-07) expect_equal(x2$analysisTime[1, ], x1$analysisTime[1, ], tolerance = 1e-07) expect_equal(x2$studyDuration, x1$studyDuration, tolerance = 1e-07) expect_equal(x2$eventsNotAchieved[1, ], x1$eventsNotAchieved[1, ]) expect_equal(x2$numberOfSubjects[1, ], x1$numberOfSubjects[1, ], tolerance = 1e-07) expect_equal(x2$numberOfSubjects1[1, ], x1$numberOfSubjects1[1, ], tolerance = 1e-07) expect_equal(x2$numberOfSubjects2[1, ], x1$numberOfSubjects2[1, ], tolerance = 1e-07) expect_equal(x2$eventsPerStage[1, ], x1$eventsPerStage[1, ]) expect_equal(x2$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-07) expect_equal(x2$rejectPerStage[1, ], x1$rejectPerStage[1, ], tolerance = 1e-07) expect_equal(x2$overallReject, x1$overallReject, tolerance = 1e-07) }) rpact/tests/testthat/test-f_analysis_base_means.R0000644000175000017500000041235414154142422022134 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_analysis_base_means.R ## | Creation date: 08 December 2021, 08:59:16 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing the Analysis Means Functionality for One Treatment") test_that("'getAnalysisResults' for two-stage group sequential design and a dataset of one mean per stage (bindingFutility = FALSE)", { dataExample <- getDataset( n = 120, means = 0.45, stDevs = 1.3 ) design <- getDesignGroupSequential(kMax = 2, alpha = 0.025, futilityBounds = 0, bindingFutility = FALSE, typeOfDesign = "WT", deltaWT = 0.4) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneMean} # @refFS[Formula]{fs:pValuesOneMeanAlternativeGreater} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCIOneMean} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneMeanEffect} result <- getAnalysisResults(design = design, dataInput = dataExample, nPlanned = 130, thetaH1 = 0.22, assumedStDev = 1, thetaH0 = 0.25) ## Comparison of the results of AnalysisResultsGroupSequential object 'result' with expected results expect_equal(result$testActions, c("continue", NA_character_)) expect_equal(result$conditionalRejectionProbabilities, c(0.094509305, NA_real_), tolerance = 1e-07) expect_equal(result$conditionalPower, c(NA_real_, 0.048907456), tolerance = 1e-07) expect_equal(result$repeatedConfidenceIntervalLowerBounds, c(0.17801061, NA_real_), tolerance = 1e-07) expect_equal(result$repeatedConfidenceIntervalUpperBounds, c(0.72198944, NA_real_), tolerance = 1e-07) expect_equal(result$repeatedPValues, c(0.085336561, NA_real_), tolerance = 1e-07) expect_equal(result$finalStage, NA_integer_) expect_equal(result$finalPValues, c(NA_real_, NA_real_)) expect_equal(result$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_)) expect_equal(result$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_)) expect_equal(result$medianUnbiasedEstimates, c(NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result), NA))) expect_output(print(result)$show()) invisible(capture.output(expect_error(summary(result), NA))) expect_output(summary(result)$show()) resultCodeBased <- eval(parse(text = getObjectRCode(result, stringWrapParagraphWidth = NULL))) expect_equal(resultCodeBased$testActions, result$testActions, tolerance = 1e-05) expect_equal(resultCodeBased$conditionalRejectionProbabilities, result$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(resultCodeBased$conditionalPower, result$conditionalPower, tolerance = 1e-05) expect_equal(resultCodeBased$repeatedConfidenceIntervalLowerBounds, result$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(resultCodeBased$repeatedConfidenceIntervalUpperBounds, result$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(resultCodeBased$repeatedPValues, result$repeatedPValues, tolerance = 1e-05) expect_equal(resultCodeBased$finalStage, result$finalStage, tolerance = 1e-05) expect_equal(resultCodeBased$finalPValues, result$finalPValues, tolerance = 1e-05) expect_equal(resultCodeBased$finalConfidenceIntervalLowerBounds, result$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(resultCodeBased$finalConfidenceIntervalUpperBounds, result$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(resultCodeBased$medianUnbiasedEstimates, result$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result), "character") df <- as.data.frame(result) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults' for three-stage group sequential design and a dataset of one mean per stage (bindingFutility = FALSE)", { .skipTestIfDisabled() dataExample <- getDataset( n = c(120, 130), means = c(0.45, 0.41) * 100, stDevs = c(1.3, 1.4) * 100 ) design <- getDesignGroupSequential(kMax = 3, alpha = 0.025, futilityBounds = rep(0.5244, 2), bindingFutility = FALSE, typeOfDesign = "WT", deltaWT = 0.4) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneMean} # @refFS[Formula]{fs:pValuesOneMeanAlternativeGreater} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCIOneMean} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneMeanEffect} result <- getAnalysisResults(design = design, dataInput = dataExample, nPlanned = 130, thetaH1 = 22, assumedStDev = 100, thetaH0 = 25) ## Comparison of the results of AnalysisResultsGroupSequential object 'result' with expected results expect_equal(result$testActions, c("continue", "continue", NA_character_)) expect_equal(result$conditionalRejectionProbabilities, c(0.10127313, 0.20204948, NA_real_), tolerance = 1e-07) expect_equal(result$conditionalPower, c(NA_real_, NA_real_, 0.11972239), tolerance = 1e-07) expect_equal(result$repeatedConfidenceIntervalLowerBounds, c(15.620913, 23.359338, NA_real_), tolerance = 1e-07) expect_equal(result$repeatedConfidenceIntervalUpperBounds, c(74.379087, 62.480662, NA_real_), tolerance = 1e-07) expect_equal(result$repeatedPValues, c(0.11501103, 0.039167372, NA_real_), tolerance = 1e-07) expect_equal(result$finalStage, NA_integer_) expect_equal(result$finalPValues, c(NA_real_, NA_real_, NA_real_)) expect_equal(result$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(result$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_)) expect_equal(result$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result), NA))) expect_output(print(result)$show()) invisible(capture.output(expect_error(summary(result), NA))) expect_output(summary(result)$show()) resultCodeBased <- eval(parse(text = getObjectRCode(result, stringWrapParagraphWidth = NULL))) expect_equal(resultCodeBased$testActions, result$testActions, tolerance = 1e-05) expect_equal(resultCodeBased$conditionalRejectionProbabilities, result$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(resultCodeBased$conditionalPower, result$conditionalPower, tolerance = 1e-05) expect_equal(resultCodeBased$repeatedConfidenceIntervalLowerBounds, result$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(resultCodeBased$repeatedConfidenceIntervalUpperBounds, result$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(resultCodeBased$repeatedPValues, result$repeatedPValues, tolerance = 1e-05) expect_equal(resultCodeBased$finalStage, result$finalStage, tolerance = 1e-05) expect_equal(resultCodeBased$finalPValues, result$finalPValues, tolerance = 1e-05) expect_equal(resultCodeBased$finalConfidenceIntervalLowerBounds, result$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(resultCodeBased$finalConfidenceIntervalUpperBounds, result$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(resultCodeBased$medianUnbiasedEstimates, result$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result), "character") df <- as.data.frame(result) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults' for group sequential design and a dataset of one mean per stage (bindingFutility = TRUE)", { .skipTestIfDisabled() dataExample0 <- getDataset( n = c(120, 130, 130), means = c(0.45, 0.41, 0.45) * 100, stDevs = c(1.3, 1.4, 1.2) * 100 ) design1 <- getDesignGroupSequential(kMax = 4, alpha = 0.025, futilityBounds = rep(0.5244, 3), bindingFutility = TRUE, typeOfDesign = "WT", deltaWT = 0.4) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneMean} # @refFS[Formula]{fs:pValuesOneMeanAlternativeGreater} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCIOneMean} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneMeanEffect} result1 <- getAnalysisResults(design = design1, dataInput = dataExample0, nPlanned = 130, thetaH1 = 22, assumedStDev = 100, thetaH0 = 25) ## Comparison of the results of AnalysisResultsGroupSequential object 'result1' with expected results expect_equal(result1$testActions, c("continue", "continue", "reject and stop", NA_character_)) expect_equal(result1$conditionalRejectionProbabilities, c(0.11438278, 0.24787613, 0.68016764, NA_real_), tolerance = 1e-07) expect_equal(result1$conditionalPower, c(NA_real_, NA_real_, NA_real_, 0.55017955), tolerance = 1e-07) expect_equal(result1$repeatedConfidenceIntervalLowerBounds, c(14.924587, 22.902668, 28.667333, NA_real_), tolerance = 1e-07) expect_equal(result1$repeatedConfidenceIntervalUpperBounds, c(75.075413, 62.937332, 58.595825, NA_real_), tolerance = 1e-07) expect_equal(result1$repeatedPValues, c(0.10271056, 0.041641198, 0.0060463294, NA_real_), tolerance = 1e-07) expect_equal(result1$finalStage, 3) expect_equal(result1$finalPValues, c(NA_real_, NA_real_, 0.014723218, NA_real_), tolerance = 1e-07) expect_equal(result1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 26.836053, NA_real_), tolerance = 1e-07) expect_equal(result1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 56.851998, NA_real_), tolerance = 1e-07) expect_equal(result1$medianUnbiasedEstimates, c(NA_real_, NA_real_, 42.083093, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result1), NA))) expect_output(print(result1)$show()) invisible(capture.output(expect_error(summary(result1), NA))) expect_output(summary(result1)$show()) result1CodeBased <- eval(parse(text = getObjectRCode(result1, stringWrapParagraphWidth = NULL))) expect_equal(result1CodeBased$testActions, result1$testActions, tolerance = 1e-05) expect_equal(result1CodeBased$conditionalRejectionProbabilities, result1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result1CodeBased$conditionalPower, result1$conditionalPower, tolerance = 1e-05) expect_equal(result1CodeBased$repeatedConfidenceIntervalLowerBounds, result1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result1CodeBased$repeatedConfidenceIntervalUpperBounds, result1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result1CodeBased$repeatedPValues, result1$repeatedPValues, tolerance = 1e-05) expect_equal(result1CodeBased$finalStage, result1$finalStage, tolerance = 1e-05) expect_equal(result1CodeBased$finalPValues, result1$finalPValues, tolerance = 1e-05) expect_equal(result1CodeBased$finalConfidenceIntervalLowerBounds, result1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result1CodeBased$finalConfidenceIntervalUpperBounds, result1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result1CodeBased$medianUnbiasedEstimates, result1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result1), "character") df <- as.data.frame(result1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getStageResults' for group sequential design and a dataset of one mean per stage (bindingFutility = TRUE)", { .skipTestIfDisabled() dataExample1 <- getDataset( n = c(20, 30, 30), means = c(0.45, 0.51, 0.45) * 100, stDevs = c(1.3, 1.4, 1.2) * 100 ) design1 <- getDesignGroupSequential(kMax = 4, alpha = 0.025, futilityBounds = rep(0.5244, 3), bindingFutility = TRUE, typeOfDesign = "WT", deltaWT = 0.4) # @refFS[Formula]{fs:testStatisticOneMean} # @refFS[Formula]{fs:pValuesOneMeanAlternativeGreater} stageResults1 <- getStageResults(design1, dataExample1, thetaH0 = 10, stage = 2) ## Comparison of the results of StageResultsMeans object 'stageResults1' with expected results expect_equal(stageResults1$overallTestStatistics, c(1.2040366, 2.025312, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$overallPValues, c(0.12168078, 0.02415027, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$overallMeans, c(45, 48.6, 47.25, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$overallStDevs, c(130, 134.76601, 128.66279, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$overallSampleSizes, c(20, 50, NA_real_, NA_real_)) expect_equal(stageResults1$testStatistics, c(1.2040366, 1.6040446, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$pValues, c(0.12168078, 0.059770605, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$effectSizes, c(45, 48.6, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(stageResults1), NA))) expect_output(print(stageResults1)$show()) invisible(capture.output(expect_error(summary(stageResults1), NA))) expect_output(summary(stageResults1)$show()) stageResults1CodeBased <- eval(parse(text = getObjectRCode(stageResults1, stringWrapParagraphWidth = NULL))) expect_equal(stageResults1CodeBased$overallTestStatistics, stageResults1$overallTestStatistics, tolerance = 1e-05) expect_equal(stageResults1CodeBased$overallPValues, stageResults1$overallPValues, tolerance = 1e-05) expect_equal(stageResults1CodeBased$overallMeans, stageResults1$overallMeans, tolerance = 1e-05) expect_equal(stageResults1CodeBased$overallStDevs, stageResults1$overallStDevs, tolerance = 1e-05) expect_equal(stageResults1CodeBased$overallSampleSizes, stageResults1$overallSampleSizes, tolerance = 1e-05) expect_equal(stageResults1CodeBased$testStatistics, stageResults1$testStatistics, tolerance = 1e-05) expect_equal(stageResults1CodeBased$pValues, stageResults1$pValues, tolerance = 1e-05) expect_equal(stageResults1CodeBased$effectSizes, stageResults1$effectSizes, tolerance = 1e-05) expect_type(names(stageResults1), "character") df <- as.data.frame(stageResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(stageResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneMeanEffect} plotData1 <- testGetStageResultsPlotData(stageResults1, stage = 2, nPlanned = c(30, 20), thetaRange = seq(10, 80, 5), assumedStDev = 100) ## Comparison of the results of list object 'plotData1' with expected results expect_equal(plotData1$xValues, c(10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70, 75, 80)) expect_equal(plotData1$condPowerValues, c(0.20492816, 0.31007642, 0.43512091, 0.5683138, 0.6950205, 0.80243295, 0.88343665, 0.93770927, 0.96998259, 0.98700232, 0.99495733, 0.99825113, 0.99945881, 0.9998508, 0.9999634), tolerance = 1e-07) expect_equal(plotData1$likelihoodValues, c(0.12861339, 0.21139553, 0.32435073, 0.46456173, 0.62112851, 0.77522713, 0.90320416, 0.98231862, 0.99730568, 0.94517816, 0.83619688, 0.69057821, 0.53238607, 0.38313335, 0.25738469), tolerance = 1e-07) expect_equal(plotData1$main, "Conditional Power with Likelihood") expect_equal(plotData1$xlab, "Effect size") expect_equal(plotData1$ylab, "Conditional power / Likelihood") expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 50, sd = 100") }) test_that("'getAnalysisResults' for inverse normal and Fisher designs and a dataset of one mean per stage (bindingFutility = TRUE)", { .skipTestIfDisabled() dataExample1 <- getDataset( n = c(20, 30, 30), means = c(0.45, 0.51, 0.45) * 100, stDevs = c(1.3, 1.4, 1.2) * 100 ) design2 <- getDesignInverseNormal(kMax = 4, alpha = 0.025, futilityBounds = rep(0.5244, 3), bindingFutility = FALSE, typeOfDesign = "WT", deltaWT = 0.4) # @refFS[Formula]{fs:testStatisticOneMean} # @refFS[Formula]{fs:pValuesOneMeanAlternativeGreater} stageResults2 <- getStageResults(design2, dataExample1, thetaH0 = 10, stage = 2) ## Comparison of the results of StageResultsMeans object 'stageResults2' with expected results expect_equal(stageResults2$overallTestStatistics, c(1.2040366, 2.025312, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$overallPValues, c(0.12168078, 0.02415027, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$overallMeans, c(45, 48.6, 47.25, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$overallStDevs, c(130, 134.76601, 128.66279, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$overallSampleSizes, c(20, 50, NA_real_, NA_real_)) expect_equal(stageResults2$testStatistics, c(1.2040366, 1.6040446, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$pValues, c(0.12168078, 0.059770605, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$effectSizes, c(45, 48.6, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$combInverseNormal, c(1.1666257, 1.9256836, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$weightsInverseNormal, c(0.5, 0.5, 0.5, 0.5), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(stageResults2), NA))) expect_output(print(stageResults2)$show()) invisible(capture.output(expect_error(summary(stageResults2), NA))) expect_output(summary(stageResults2)$show()) stageResults2CodeBased <- eval(parse(text = getObjectRCode(stageResults2, stringWrapParagraphWidth = NULL))) expect_equal(stageResults2CodeBased$overallTestStatistics, stageResults2$overallTestStatistics, tolerance = 1e-05) expect_equal(stageResults2CodeBased$overallPValues, stageResults2$overallPValues, tolerance = 1e-05) expect_equal(stageResults2CodeBased$overallMeans, stageResults2$overallMeans, tolerance = 1e-05) expect_equal(stageResults2CodeBased$overallStDevs, stageResults2$overallStDevs, tolerance = 1e-05) expect_equal(stageResults2CodeBased$overallSampleSizes, stageResults2$overallSampleSizes, tolerance = 1e-05) expect_equal(stageResults2CodeBased$testStatistics, stageResults2$testStatistics, tolerance = 1e-05) expect_equal(stageResults2CodeBased$pValues, stageResults2$pValues, tolerance = 1e-05) expect_equal(stageResults2CodeBased$effectSizes, stageResults2$effectSizes, tolerance = 1e-05) expect_equal(stageResults2CodeBased$combInverseNormal, stageResults2$combInverseNormal, tolerance = 1e-05) expect_equal(stageResults2CodeBased$weightsInverseNormal, stageResults2$weightsInverseNormal, tolerance = 1e-05) expect_type(names(stageResults2), "character") df <- as.data.frame(stageResults2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(stageResults2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneMeanEffect} plotData2 <- testGetStageResultsPlotData(stageResults2, stage = 2, nPlanned = c(30, 20), thetaRange = seq(10, 80, 5), assumedStDev = 100) ## Comparison of the results of list object 'plotData2' with expected results expect_equal(plotData2$xValues, c(10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70, 75, 80)) expect_equal(plotData2$condPowerValues, c(0.16190431, 0.25577971, 0.37352079, 0.50571299, 0.6381983, 0.75647047, 0.85036513, 0.91657165, 0.95799515, 0.98097554, 0.99227303, 0.99719255, 0.99908935, 0.99973672, 0.99993224), tolerance = 1e-07) expect_equal(plotData2$likelihoodValues, c(0.12861339, 0.21139553, 0.32435073, 0.46456173, 0.62112851, 0.77522713, 0.90320416, 0.98231862, 0.99730568, 0.94517816, 0.83619688, 0.69057821, 0.53238607, 0.38313335, 0.25738469), tolerance = 1e-07) expect_equal(plotData2$main, "Conditional Power with Likelihood") expect_equal(plotData2$xlab, "Effect size") expect_equal(plotData2$ylab, "Conditional power / Likelihood") expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 50, sd = 100") # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticOneMean} # @refFS[Formula]{fs:pValuesOneMeanAlternativeGreater} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCIOneMean} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneMeanEffect} result2 <- getAnalysisResults(design = design2, dataInput = dataExample1, nPlanned = 30, thetaH1 = 50, assumedStDev = 100, thetaH0 = 10) ## Comparison of the results of AnalysisResultsInverseNormal object 'result2' with expected results expect_equal(result2$testActions, c("continue", "continue", "reject and stop", NA_character_)) expect_equal(result2$conditionalRejectionProbabilities, c(0.046837862, 0.16190673, 0.42383694, NA_real_), tolerance = 1e-07) expect_equal(result2$conditionalPower, c(NA_real_, NA_real_, NA_real_, 0.97718516), tolerance = 1e-07) expect_equal(result2$repeatedConfidenceIntervalLowerBounds, c(-37.7517, 0.20066782, 12.631309, NA_real_), tolerance = 1e-07) expect_equal(result2$repeatedConfidenceIntervalUpperBounds, c(127.7517, 96.240714, 81.345632, NA_real_), tolerance = 1e-07) expect_equal(result2$repeatedPValues, c(0.28074785, 0.070627118, 0.016069426, NA_real_), tolerance = 1e-07) expect_equal(result2$finalStage, 3) expect_equal(result2$finalPValues, c(NA_real_, NA_real_, 0.015631623, NA_real_), tolerance = 1e-07) expect_equal(result2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 13.353451, NA_real_), tolerance = 1e-07) expect_equal(result2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 73.21831, NA_real_), tolerance = 1e-07) expect_equal(result2$medianUnbiasedEstimates, c(NA_real_, NA_real_, 44.191392, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result2), NA))) expect_output(print(result2)$show()) invisible(capture.output(expect_error(summary(result2), NA))) expect_output(summary(result2)$show()) result2CodeBased <- eval(parse(text = getObjectRCode(result2, stringWrapParagraphWidth = NULL))) expect_equal(result2CodeBased$testActions, result2$testActions, tolerance = 1e-05) expect_equal(result2CodeBased$conditionalRejectionProbabilities, result2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result2CodeBased$conditionalPower, result2$conditionalPower, tolerance = 1e-05) expect_equal(result2CodeBased$repeatedConfidenceIntervalLowerBounds, result2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result2CodeBased$repeatedConfidenceIntervalUpperBounds, result2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result2CodeBased$repeatedPValues, result2$repeatedPValues, tolerance = 1e-05) expect_equal(result2CodeBased$finalStage, result2$finalStage, tolerance = 1e-05) expect_equal(result2CodeBased$finalPValues, result2$finalPValues, tolerance = 1e-05) expect_equal(result2CodeBased$finalConfidenceIntervalLowerBounds, result2$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result2CodeBased$finalConfidenceIntervalUpperBounds, result2$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result2CodeBased$medianUnbiasedEstimates, result2$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result2), "character") df <- as.data.frame(result2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design3 <- getDesignFisher(kMax = 4, alpha = 0.025, alpha0Vec = rep(0.4, 3), bindingFutility = TRUE) # @refFS[Formula]{fs:testStatisticOneMean} # @refFS[Formula]{fs:pValuesOneMeanAlternativeGreater} stageResults3 <- getStageResults(design3, dataExample1, thetaH0 = 10, stage = 2) ## Comparison of the results of StageResultsMeans object 'stageResults3' with expected results expect_equal(stageResults3$overallTestStatistics, c(1.2040366, 2.025312, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults3$overallPValues, c(0.12168078, 0.02415027, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults3$overallMeans, c(45, 48.6, 47.25, NA_real_), tolerance = 1e-07) expect_equal(stageResults3$overallStDevs, c(130, 134.76601, 128.66279, NA_real_), tolerance = 1e-07) expect_equal(stageResults3$overallSampleSizes, c(20, 50, NA_real_, NA_real_)) expect_equal(stageResults3$testStatistics, c(1.2040366, 1.6040446, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults3$pValues, c(0.12168078, 0.059770605, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults3$effectSizes, c(45, 48.6, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults3$combFisher, c(0.12168078, 0.007272934, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults3$weightsFisher, c(1, 1, 1, 1)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(stageResults3), NA))) expect_output(print(stageResults3)$show()) invisible(capture.output(expect_error(summary(stageResults3), NA))) expect_output(summary(stageResults3)$show()) stageResults3CodeBased <- eval(parse(text = getObjectRCode(stageResults3, stringWrapParagraphWidth = NULL))) expect_equal(stageResults3CodeBased$overallTestStatistics, stageResults3$overallTestStatistics, tolerance = 1e-05) expect_equal(stageResults3CodeBased$overallPValues, stageResults3$overallPValues, tolerance = 1e-05) expect_equal(stageResults3CodeBased$overallMeans, stageResults3$overallMeans, tolerance = 1e-05) expect_equal(stageResults3CodeBased$overallStDevs, stageResults3$overallStDevs, tolerance = 1e-05) expect_equal(stageResults3CodeBased$overallSampleSizes, stageResults3$overallSampleSizes, tolerance = 1e-05) expect_equal(stageResults3CodeBased$testStatistics, stageResults3$testStatistics, tolerance = 1e-05) expect_equal(stageResults3CodeBased$pValues, stageResults3$pValues, tolerance = 1e-05) expect_equal(stageResults3CodeBased$effectSizes, stageResults3$effectSizes, tolerance = 1e-05) expect_equal(stageResults3CodeBased$combFisher, stageResults3$combFisher, tolerance = 1e-05) expect_equal(stageResults3CodeBased$weightsFisher, stageResults3$weightsFisher, tolerance = 1e-05) expect_type(names(stageResults3), "character") df <- as.data.frame(stageResults3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(stageResults3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:testStatisticOneMean} # @refFS[Formula]{fs:pValuesOneMeanAlternativeGreater} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:finalPValueFisherCombinationTest} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} result3 <- getAnalysisResults(design = design3, dataInput = dataExample1, thetaH0 = 10, nPlanned = 30, thetaH1 = 50, assumedStDev = 100, seed = 123456789) ## Comparison of the results of AnalysisResultsFisher object 'result3' with expected results expect_equal(result3$testActions, c("continue", "continue", "continue", NA_character_)) expect_equal(result3$conditionalRejectionProbabilities, c(0.029249394, 0.067046868, 0.15552139, NA_real_), tolerance = 1e-07) expect_equal(result3$conditionalPower, c(NA_real_, NA_real_, NA_real_, 0.88057256), tolerance = 1e-07) expect_equal(result3$repeatedConfidenceIntervalLowerBounds, c(-24.226675, 0.014834887, 8.7947814, NA_real_), tolerance = 1e-07) expect_equal(result3$repeatedConfidenceIntervalUpperBounds, c(114.22668, 96.713521, 85.125684, NA_real_), tolerance = 1e-07) expect_equal(result3$repeatedPValues, c(0.165096, 0.068572907, 0.029926287, NA_real_), tolerance = 1e-07) expect_equal(result3$finalStage, NA_integer_) expect_equal(result3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result3), NA))) expect_output(print(result3)$show()) invisible(capture.output(expect_error(summary(result3), NA))) expect_output(summary(result3)$show()) result3CodeBased <- eval(parse(text = getObjectRCode(result3, stringWrapParagraphWidth = NULL))) expect_equal(result3CodeBased$testActions, result3$testActions, tolerance = 1e-05) expect_equal(result3CodeBased$conditionalRejectionProbabilities, result3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result3CodeBased$conditionalPower, result3$conditionalPower, tolerance = 1e-05) expect_equal(result3CodeBased$repeatedConfidenceIntervalLowerBounds, result3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result3CodeBased$repeatedConfidenceIntervalUpperBounds, result3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result3CodeBased$repeatedPValues, result3$repeatedPValues, tolerance = 1e-05) expect_equal(result3CodeBased$finalStage, result3$finalStage, tolerance = 1e-05) expect_equal(result3CodeBased$finalPValues, result3$finalPValues, tolerance = 1e-05) expect_equal(result3CodeBased$finalConfidenceIntervalLowerBounds, result3$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result3CodeBased$finalConfidenceIntervalUpperBounds, result3$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result3CodeBased$medianUnbiasedEstimates, result3$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result3), "character") df <- as.data.frame(result3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults' for different designs and a dataset of one mean per stage (bindingFutility = FALSE)", { .skipTestIfDisabled() design4 <- getDesignGroupSequential(kMax = 4, alpha = 0.025, typeOfDesign = "WT", deltaWT = 0.4) dataExample2 <- getDataset( n = c(20, 20, 20), means = c(0.45, 0.51, 0.45) * 100, stDevs = c(1.3, 1.4, 1.2) * 100 ) stageResults1 <- getStageResults(design4, dataExample2, thetaH0 = 10, stage = 2) ## Comparison of the results of StageResultsMeans object 'stageResults1' with expected results expect_equal(stageResults1$overallTestStatistics, c(1.2040366, 1.8018141, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$overallPValues, c(0.12168078, 0.039654359, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$overallMeans, c(45, 48, 47, NA_real_)) expect_equal(stageResults1$overallStDevs, c(130, 133.38396, 128.06116, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$overallSampleSizes, c(20, 40, NA_real_, NA_real_)) expect_equal(stageResults1$testStatistics, c(1.2040366, 1.309697, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$pValues, c(0.12168078, 0.10295724, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$effectSizes, c(45, 48, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(stageResults1), NA))) expect_output(print(stageResults1)$show()) invisible(capture.output(expect_error(summary(stageResults1), NA))) expect_output(summary(stageResults1)$show()) stageResults1CodeBased <- eval(parse(text = getObjectRCode(stageResults1, stringWrapParagraphWidth = NULL))) expect_equal(stageResults1CodeBased$overallTestStatistics, stageResults1$overallTestStatistics, tolerance = 1e-05) expect_equal(stageResults1CodeBased$overallPValues, stageResults1$overallPValues, tolerance = 1e-05) expect_equal(stageResults1CodeBased$overallMeans, stageResults1$overallMeans, tolerance = 1e-05) expect_equal(stageResults1CodeBased$overallStDevs, stageResults1$overallStDevs, tolerance = 1e-05) expect_equal(stageResults1CodeBased$overallSampleSizes, stageResults1$overallSampleSizes, tolerance = 1e-05) expect_equal(stageResults1CodeBased$testStatistics, stageResults1$testStatistics, tolerance = 1e-05) expect_equal(stageResults1CodeBased$pValues, stageResults1$pValues, tolerance = 1e-05) expect_equal(stageResults1CodeBased$effectSizes, stageResults1$effectSizes, tolerance = 1e-05) expect_type(names(stageResults1), "character") df <- as.data.frame(stageResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(stageResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData1 <- testGetStageResultsPlotData(stageResults1, stage = 2, nPlanned = c(30, 20), thetaRange = seq(10, 80, 5), assumedStDev = 100) ## Comparison of the results of list object 'plotData1' with expected results expect_equal(plotData1$xValues, c(10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70, 75, 80)) expect_equal(plotData1$condPowerValues, c(0.11518708, 0.19320212, 0.2981846, 0.42448846, 0.55999334, 0.68937861, 0.79916986, 0.8818727, 0.93712809, 0.96985063, 0.98701854, 0.99499503, 0.99827593, 0.99947032, 0.99985507), tolerance = 1e-07) expect_equal(plotData1$likelihoodValues, c(0.19725323, 0.29399425, 0.4142314, 0.5517428, 0.69473602, 0.8269751, 0.93058175, 0.98993369, 0.99551351, 0.94640644, 0.85054578, 0.72261535, 0.58037159, 0.44065083, 0.31628057), tolerance = 1e-07) expect_equal(plotData1$main, "Conditional Power with Likelihood") expect_equal(plotData1$xlab, "Effect size") expect_equal(plotData1$ylab, "Conditional power / Likelihood") expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 50, sd = 100") # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneMean} # @refFS[Formula]{fs:pValuesOneMeanAlternativeGreater} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCIOneMean} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneMeanEffect} result1 <- getAnalysisResults(design = design4, dataInput = dataExample2, thetaH0 = 10) ## Comparison of the results of AnalysisResultsGroupSequential object 'result1' with expected results expect_equal(result1$thetaH1, 47) expect_equal(result1$assumedStDev, 128.06116, tolerance = 1e-07) expect_equal(result1$testActions, c("continue", "continue", "continue", NA_character_)) expect_equal(result1$conditionalRejectionProbabilities, c(0.046837862, 0.11518708, 0.2468754, NA_real_), tolerance = 1e-07) expect_equal(result1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result1$repeatedConfidenceIntervalLowerBounds, c(-37.7517, -4.7433931, 7.9671114, NA_real_), tolerance = 1e-07) expect_equal(result1$repeatedConfidenceIntervalUpperBounds, c(127.7517, 100.74339, 86.032888, NA_real_), tolerance = 1e-07) expect_equal(result1$repeatedPValues, c(0.28074785, 0.098382799, 0.033210734, NA_real_), tolerance = 1e-07) expect_equal(result1$finalStage, NA_integer_) expect_equal(result1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result1), NA))) expect_output(print(result1)$show()) invisible(capture.output(expect_error(summary(result1), NA))) expect_output(summary(result1)$show()) result1CodeBased <- eval(parse(text = getObjectRCode(result1, stringWrapParagraphWidth = NULL))) expect_equal(result1CodeBased$thetaH1, result1$thetaH1, tolerance = 1e-05) expect_equal(result1CodeBased$assumedStDev, result1$assumedStDev, tolerance = 1e-05) expect_equal(result1CodeBased$testActions, result1$testActions, tolerance = 1e-05) expect_equal(result1CodeBased$conditionalRejectionProbabilities, result1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result1CodeBased$conditionalPower, result1$conditionalPower, tolerance = 1e-05) expect_equal(result1CodeBased$repeatedConfidenceIntervalLowerBounds, result1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result1CodeBased$repeatedConfidenceIntervalUpperBounds, result1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result1CodeBased$repeatedPValues, result1$repeatedPValues, tolerance = 1e-05) expect_equal(result1CodeBased$finalStage, result1$finalStage, tolerance = 1e-05) expect_equal(result1CodeBased$finalPValues, result1$finalPValues, tolerance = 1e-05) expect_equal(result1CodeBased$finalConfidenceIntervalLowerBounds, result1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result1CodeBased$finalConfidenceIntervalUpperBounds, result1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result1CodeBased$medianUnbiasedEstimates, result1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result1), "character") df <- as.data.frame(result1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design5 <- getDesignInverseNormal(kMax = 4, alpha = 0.025, typeOfDesign = "WT", deltaWT = 0.4) stageResults2 <- getStageResults(design5, dataExample2, thetaH0 = 10, stage = 2) ## Comparison of the results of StageResultsMeans object 'stageResults2' with expected results expect_equal(stageResults2$overallTestStatistics, c(1.2040366, 1.8018141, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$overallPValues, c(0.12168078, 0.039654359, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$overallMeans, c(45, 48, 47, NA_real_)) expect_equal(stageResults2$overallStDevs, c(130, 133.38396, 128.06116, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$overallSampleSizes, c(20, 40, NA_real_, NA_real_)) expect_equal(stageResults2$testStatistics, c(1.2040366, 1.309697, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$pValues, c(0.12168078, 0.10295724, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$effectSizes, c(45, 48, NA_real_, NA_real_)) expect_equal(stageResults2$combInverseNormal, c(1.1666257, 1.7193339, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$weightsInverseNormal, c(0.5, 0.5, 0.5, 0.5), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(stageResults2), NA))) expect_output(print(stageResults2)$show()) invisible(capture.output(expect_error(summary(stageResults2), NA))) expect_output(summary(stageResults2)$show()) stageResults2CodeBased <- eval(parse(text = getObjectRCode(stageResults2, stringWrapParagraphWidth = NULL))) expect_equal(stageResults2CodeBased$overallTestStatistics, stageResults2$overallTestStatistics, tolerance = 1e-05) expect_equal(stageResults2CodeBased$overallPValues, stageResults2$overallPValues, tolerance = 1e-05) expect_equal(stageResults2CodeBased$overallMeans, stageResults2$overallMeans, tolerance = 1e-05) expect_equal(stageResults2CodeBased$overallStDevs, stageResults2$overallStDevs, tolerance = 1e-05) expect_equal(stageResults2CodeBased$overallSampleSizes, stageResults2$overallSampleSizes, tolerance = 1e-05) expect_equal(stageResults2CodeBased$testStatistics, stageResults2$testStatistics, tolerance = 1e-05) expect_equal(stageResults2CodeBased$pValues, stageResults2$pValues, tolerance = 1e-05) expect_equal(stageResults2CodeBased$effectSizes, stageResults2$effectSizes, tolerance = 1e-05) expect_equal(stageResults2CodeBased$combInverseNormal, stageResults2$combInverseNormal, tolerance = 1e-05) expect_equal(stageResults2CodeBased$weightsInverseNormal, stageResults2$weightsInverseNormal, tolerance = 1e-05) expect_type(names(stageResults2), "character") df <- as.data.frame(stageResults2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(stageResults2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData2 <- testGetStageResultsPlotData(stageResults2, stage = 2, nPlanned = c(30, 20), thetaRange = seq(10, 80, 5), assumedStDev = 100) ## Comparison of the results of list object 'plotData2' with expected results expect_equal(plotData2$xValues, c(10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70, 75, 80)) expect_equal(plotData2$condPowerValues, c(0.10694528, 0.18165277, 0.28365551, 0.40813694, 0.54357522, 0.6747028, 0.78751068, 0.8736511, 0.93198732, 0.96700264, 0.98562147, 0.9943885, 0.99804297, 0.99939119, 0.99983131), tolerance = 1e-07) expect_equal(plotData2$likelihoodValues, c(0.19725323, 0.29399425, 0.4142314, 0.5517428, 0.69473602, 0.8269751, 0.93058175, 0.98993369, 0.99551351, 0.94640644, 0.85054578, 0.72261535, 0.58037159, 0.44065083, 0.31628057), tolerance = 1e-07) expect_equal(plotData2$main, "Conditional Power with Likelihood") expect_equal(plotData2$xlab, "Effect size") expect_equal(plotData2$ylab, "Conditional power / Likelihood") expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 50, sd = 100") # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticOneMean} # @refFS[Formula]{fs:pValuesOneMeanAlternativeGreater} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCIOneMean} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneMeanEffect} result2 <- getAnalysisResults(design = design5, dataInput = dataExample2, thetaH0 = 10) ## Comparison of the results of AnalysisResultsInverseNormal object 'result2' with expected results expect_equal(result2$thetaH1, 47) expect_equal(result2$assumedStDev, 128.06116, tolerance = 1e-07) expect_equal(result2$testActions, c("continue", "continue", "continue", NA_character_)) expect_equal(result2$conditionalRejectionProbabilities, c(0.046837862, 0.10694527, 0.21929053, NA_real_), tolerance = 1e-07) expect_equal(result2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result2$repeatedConfidenceIntervalLowerBounds, c(-37.7517, -5.8599359, 6.9798507, NA_real_), tolerance = 1e-07) expect_equal(result2$repeatedConfidenceIntervalUpperBounds, c(127.7517, 101.68482, 86.758637, NA_real_), tolerance = 1e-07) expect_equal(result2$repeatedPValues, c(0.28074785, 0.10502799, 0.037620516, NA_real_), tolerance = 1e-07) expect_equal(result2$finalStage, NA_integer_) expect_equal(result2$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result2), NA))) expect_output(print(result2)$show()) invisible(capture.output(expect_error(summary(result2), NA))) expect_output(summary(result2)$show()) result2CodeBased <- eval(parse(text = getObjectRCode(result2, stringWrapParagraphWidth = NULL))) expect_equal(result2CodeBased$thetaH1, result2$thetaH1, tolerance = 1e-05) expect_equal(result2CodeBased$assumedStDev, result2$assumedStDev, tolerance = 1e-05) expect_equal(result2CodeBased$testActions, result2$testActions, tolerance = 1e-05) expect_equal(result2CodeBased$conditionalRejectionProbabilities, result2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result2CodeBased$conditionalPower, result2$conditionalPower, tolerance = 1e-05) expect_equal(result2CodeBased$repeatedConfidenceIntervalLowerBounds, result2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result2CodeBased$repeatedConfidenceIntervalUpperBounds, result2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result2CodeBased$repeatedPValues, result2$repeatedPValues, tolerance = 1e-05) expect_equal(result2CodeBased$finalStage, result2$finalStage, tolerance = 1e-05) expect_equal(result2CodeBased$finalPValues, result2$finalPValues, tolerance = 1e-05) expect_equal(result2CodeBased$finalConfidenceIntervalLowerBounds, result2$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result2CodeBased$finalConfidenceIntervalUpperBounds, result2$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result2CodeBased$medianUnbiasedEstimates, result2$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result2), "character") df <- as.data.frame(result2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design6 <- getDesignFisher(kMax = 4, alpha = 0.025) stageResults3 <- getStageResults(design6, dataExample2, thetaH0 = 10, stage = 2) ## Comparison of the results of StageResultsMeans object 'stageResults3' with expected results expect_equal(stageResults3$overallTestStatistics, c(1.2040366, 1.8018141, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults3$overallPValues, c(0.12168078, 0.039654359, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults3$overallMeans, c(45, 48, 47, NA_real_)) expect_equal(stageResults3$overallStDevs, c(130, 133.38396, 128.06116, NA_real_), tolerance = 1e-07) expect_equal(stageResults3$overallSampleSizes, c(20, 40, NA_real_, NA_real_)) expect_equal(stageResults3$testStatistics, c(1.2040366, 1.309697, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults3$pValues, c(0.12168078, 0.10295724, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults3$effectSizes, c(45, 48, NA_real_, NA_real_)) expect_equal(stageResults3$combFisher, c(0.12168078, 0.012527917, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults3$weightsFisher, c(1, 1, 1, 1)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(stageResults3), NA))) expect_output(print(stageResults3)$show()) invisible(capture.output(expect_error(summary(stageResults3), NA))) expect_output(summary(stageResults3)$show()) stageResults3CodeBased <- eval(parse(text = getObjectRCode(stageResults3, stringWrapParagraphWidth = NULL))) expect_equal(stageResults3CodeBased$overallTestStatistics, stageResults3$overallTestStatistics, tolerance = 1e-05) expect_equal(stageResults3CodeBased$overallPValues, stageResults3$overallPValues, tolerance = 1e-05) expect_equal(stageResults3CodeBased$overallMeans, stageResults3$overallMeans, tolerance = 1e-05) expect_equal(stageResults3CodeBased$overallStDevs, stageResults3$overallStDevs, tolerance = 1e-05) expect_equal(stageResults3CodeBased$overallSampleSizes, stageResults3$overallSampleSizes, tolerance = 1e-05) expect_equal(stageResults3CodeBased$testStatistics, stageResults3$testStatistics, tolerance = 1e-05) expect_equal(stageResults3CodeBased$pValues, stageResults3$pValues, tolerance = 1e-05) expect_equal(stageResults3CodeBased$effectSizes, stageResults3$effectSizes, tolerance = 1e-05) expect_equal(stageResults3CodeBased$combFisher, stageResults3$combFisher, tolerance = 1e-05) expect_equal(stageResults3CodeBased$weightsFisher, stageResults3$weightsFisher, tolerance = 1e-05) expect_type(names(stageResults3), "character") df <- as.data.frame(stageResults3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(stageResults3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticOneMean} # @refFS[Formula]{fs:pValuesOneMeanAlternativeGreater} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:finalPValueFisherCombinationTest} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} result3 <- getAnalysisResults(design = design6, dataInput = dataExample2, stage = 2, thetaH0 = 10, nPlanned = c(30, 20), thetaH1 = 50, assumedStDev = 100, iterations = 800, seed = 31082018) ## Comparison of the results of AnalysisResultsFisher object 'result3' with expected results expect_equal(result3$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(result3$conditionalRejectionProbabilities, c(0.026695414, 0.033302173, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result3$repeatedConfidenceIntervalLowerBounds, c(-28.274837, -9.0994871, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result3$repeatedConfidenceIntervalUpperBounds, c(118.27484, 104.78379, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result3$repeatedPValues, c(0.23830752, 0.14118934, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result3$finalStage, NA_integer_) expect_equal(result3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result3$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.54125, 0.8125), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result3), NA))) expect_output(print(result3)$show()) invisible(capture.output(expect_error(summary(result3), NA))) expect_output(summary(result3)$show()) result3CodeBased <- eval(parse(text = getObjectRCode(result3, stringWrapParagraphWidth = NULL))) expect_equal(result3CodeBased$testActions, result3$testActions, tolerance = 1e-05) expect_equal(result3CodeBased$conditionalRejectionProbabilities, result3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result3CodeBased$repeatedConfidenceIntervalLowerBounds, result3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result3CodeBased$repeatedConfidenceIntervalUpperBounds, result3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result3CodeBased$repeatedPValues, result3$repeatedPValues, tolerance = 1e-05) expect_equal(result3CodeBased$finalStage, result3$finalStage, tolerance = 1e-05) expect_equal(result3CodeBased$finalPValues, result3$finalPValues, tolerance = 1e-05) expect_equal(result3CodeBased$finalConfidenceIntervalLowerBounds, result3$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result3CodeBased$finalConfidenceIntervalUpperBounds, result3$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result3CodeBased$medianUnbiasedEstimates, result3$medianUnbiasedEstimates, tolerance = 1e-05) expect_equal(result3CodeBased$conditionalPowerSimulated, result3$conditionalPowerSimulated, tolerance = 1e-05) expect_type(names(result3), "character") df <- as.data.frame(result3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) context("Testing the Analysis Means Functionality for Two Treatments") test_that("'getAnalysisResults' for a Fisher design and a dataset of two means per stage", { .skipTestIfDisabled() # note: if third stage value of means1 (4.5) increases, lower bound of RCI does not increase design7 <- getDesignFisher(kMax = 4, informationRates = c(0.2,0.5,0.9,1), alpha = 0.05, alpha0Vec = rep(0.4,3)) dataExample3 <- getDataset( n1 = c(23, 13, 22), n2 = c(22, 11, 22), means1 = c(1, 1.1, 1.3) * 100, means2 = c(1.3, 1.4, 2.5) * 100, stds1 = c(1.3, 2.4, 2.2) * 100, stds2 = c(1.2, 2.2, 2.1) * 100 ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticDifferenceMeansEqualVariances} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeGreaterEqualVariances} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:definitionRCIwithFutilityFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:finalPValueFisherCombinationTest} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} result <- getAnalysisResults(design = design7, dataInput = dataExample3, equalVariances = TRUE, thetaH0 = 0, directionUpper = FALSE, seed = 123456789) ## Comparison of the results of AnalysisResultsFisher object 'result' with expected results expect_equal(result$thetaH1, -66.37931, tolerance = 1e-07) expect_equal(result$assumedStDev, 189.41921, tolerance = 1e-07) expect_equal(result$testActions, c("continue", "continue", "continue", NA_character_)) expect_equal(result$conditionalRejectionProbabilities, c(0.044249457, 0.020976199, 0.060555322, NA_real_), tolerance = 1e-07) expect_equal(result$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result$repeatedConfidenceIntervalLowerBounds, c(-102.25178, -110.95946, -128.224, NA_real_), tolerance = 1e-07) expect_equal(result$repeatedConfidenceIntervalUpperBounds, c(42.251781, 50.959457, 11.069379, NA_real_), tolerance = 1e-07) expect_equal(result$repeatedPValues, c(0.25752784, 0.32556092, 0.088271965, NA_real_), tolerance = 1e-07) expect_equal(result$finalStage, NA_integer_) expect_equal(result$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result), NA))) expect_output(print(result)$show()) invisible(capture.output(expect_error(summary(result), NA))) expect_output(summary(result)$show()) resultCodeBased <- eval(parse(text = getObjectRCode(result, stringWrapParagraphWidth = NULL))) expect_equal(resultCodeBased$thetaH1, result$thetaH1, tolerance = 1e-05) expect_equal(resultCodeBased$assumedStDev, result$assumedStDev, tolerance = 1e-05) expect_equal(resultCodeBased$testActions, result$testActions, tolerance = 1e-05) expect_equal(resultCodeBased$conditionalRejectionProbabilities, result$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(resultCodeBased$conditionalPower, result$conditionalPower, tolerance = 1e-05) expect_equal(resultCodeBased$repeatedConfidenceIntervalLowerBounds, result$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(resultCodeBased$repeatedConfidenceIntervalUpperBounds, result$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(resultCodeBased$repeatedPValues, result$repeatedPValues, tolerance = 1e-05) expect_equal(resultCodeBased$finalStage, result$finalStage, tolerance = 1e-05) expect_equal(resultCodeBased$finalPValues, result$finalPValues, tolerance = 1e-05) expect_equal(resultCodeBased$finalConfidenceIntervalLowerBounds, result$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(resultCodeBased$finalConfidenceIntervalUpperBounds, result$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(resultCodeBased$medianUnbiasedEstimates, result$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result), "character") df <- as.data.frame(result) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults' for a group sequential design and a dataset of two means per stage, stages: default, 2, 3, and 4", { .skipTestIfDisabled() dataExample4 <- getDataset( n1 = c(23, 23, 22, 23), n2 = c(22, 22, 22, 21), means1 = c(1.7, 1.5, 1.8, 2.5) * 100, means2 = c(1, 1.1, 1.3, 1) * 100, stds1 = c(1.3, 2.4, 2.2, 1.3) * 100, stds2 = c(1.2, 2.2, 2.1, 1.3) * 100 ) design8 <- getDesignGroupSequential(kMax = 4, alpha = 0.025, typeOfDesign = "WT", deltaWT = 0.4) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticDifferenceMeansEqualVariances} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeGreaterEqualVariances} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCITwoMeans} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoMeansEffect} result1 <- getAnalysisResults(design = design8, dataInput = dataExample4, equalVariances = TRUE, stage = 2, nPlanned = c(15, 15), thetaH0 = 0, thetaH1 = 130, assumedStDev = 100, allocationRatioPlanned = 2) ## Comparison of the results of AnalysisResultsGroupSequential object 'result1' with expected results expect_equal(result1$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(result1$conditionalRejectionProbabilities, c(0.12319684, 0.052938347, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result1$conditionalPower, c(NA_real_, NA_real_, 0.65019157, 0.95040435), tolerance = 1e-07) expect_equal(result1$repeatedConfidenceIntervalLowerBounds, c(-30.185323, -39.416167, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result1$repeatedConfidenceIntervalUpperBounds, c(170.18532, 149.41617, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result1$repeatedPValues, c(0.10782416, 0.1777417, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result1$finalStage, NA_integer_) expect_equal(result1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result1), NA))) expect_output(print(result1)$show()) invisible(capture.output(expect_error(summary(result1), NA))) expect_output(summary(result1)$show()) result1CodeBased <- eval(parse(text = getObjectRCode(result1, stringWrapParagraphWidth = NULL))) expect_equal(result1CodeBased$testActions, result1$testActions, tolerance = 1e-05) expect_equal(result1CodeBased$conditionalRejectionProbabilities, result1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result1CodeBased$conditionalPower, result1$conditionalPower, tolerance = 1e-05) expect_equal(result1CodeBased$repeatedConfidenceIntervalLowerBounds, result1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result1CodeBased$repeatedConfidenceIntervalUpperBounds, result1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result1CodeBased$repeatedPValues, result1$repeatedPValues, tolerance = 1e-05) expect_equal(result1CodeBased$finalStage, result1$finalStage, tolerance = 1e-05) expect_equal(result1CodeBased$finalPValues, result1$finalPValues, tolerance = 1e-05) expect_equal(result1CodeBased$finalConfidenceIntervalLowerBounds, result1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result1CodeBased$finalConfidenceIntervalUpperBounds, result1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result1CodeBased$medianUnbiasedEstimates, result1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result1), "character") df <- as.data.frame(result1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticDifferenceMeansEqualVariances} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeGreaterEqualVariances} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCITwoMeans} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoMeansEffect} result4 <- getAnalysisResults(design = design8, dataInput = dataExample4, equalVariances = TRUE, stage = 3, nPlanned = 15, thetaH0 = 0, thetaH1 = 130, assumedStDev = 100, allocationRatioPlanned = 2) ## Comparison of the results of AnalysisResultsGroupSequential object 'result4' with expected results expect_equal(result4$testActions, c("continue", "continue", "continue", NA_character_)) expect_equal(result4$conditionalRejectionProbabilities, c(0.12319684, 0.052938347, 0.042196066, NA_real_), tolerance = 1e-07) expect_equal(result4$conditionalPower, c(NA_real_, NA_real_, NA_real_, 0.74141468), tolerance = 1e-07) expect_equal(result4$repeatedConfidenceIntervalLowerBounds, c(-30.185323, -39.416167, -24.461261, NA_real_), tolerance = 1e-07) expect_equal(result4$repeatedConfidenceIntervalUpperBounds, c(170.18532, 149.41617, 130.73577, NA_real_), tolerance = 1e-07) expect_equal(result4$repeatedPValues, c(0.10782416, 0.1777417, 0.11951427, NA_real_), tolerance = 1e-07) expect_equal(result4$finalStage, NA_integer_) expect_equal(result4$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result4$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result4), NA))) expect_output(print(result4)$show()) invisible(capture.output(expect_error(summary(result4), NA))) expect_output(summary(result4)$show()) result4CodeBased <- eval(parse(text = getObjectRCode(result4, stringWrapParagraphWidth = NULL))) expect_equal(result4CodeBased$testActions, result4$testActions, tolerance = 1e-05) expect_equal(result4CodeBased$conditionalRejectionProbabilities, result4$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result4CodeBased$conditionalPower, result4$conditionalPower, tolerance = 1e-05) expect_equal(result4CodeBased$repeatedConfidenceIntervalLowerBounds, result4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result4CodeBased$repeatedConfidenceIntervalUpperBounds, result4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result4CodeBased$repeatedPValues, result4$repeatedPValues, tolerance = 1e-05) expect_equal(result4CodeBased$finalStage, result4$finalStage, tolerance = 1e-05) expect_equal(result4CodeBased$finalPValues, result4$finalPValues, tolerance = 1e-05) expect_equal(result4CodeBased$finalConfidenceIntervalLowerBounds, result4$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result4CodeBased$finalConfidenceIntervalUpperBounds, result4$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result4CodeBased$medianUnbiasedEstimates, result4$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result4), "character") df <- as.data.frame(result4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticDifferenceMeansEqualVariances} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeGreaterEqualVariances} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCITwoMeans} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoMeansEffect} result7 <- getAnalysisResults(design = design8, dataInput = dataExample4, equalVariances = TRUE, stage = 4, nPlanned = numeric(0), thetaH0 = 0) ## Comparison of the results of AnalysisResultsGroupSequential object 'result7' with expected results expect_equal(result7$thetaH1, 77.467475, tolerance = 1e-07) expect_equal(result7$assumedStDev, 180.80733, tolerance = 1e-07) expect_equal(result7$testActions, c("continue", "continue", "continue", "reject")) expect_equal(result7$conditionalRejectionProbabilities, c(0.12319684, 0.052938347, 0.042196066, NA_real_), tolerance = 1e-07) expect_equal(result7$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result7$repeatedConfidenceIntervalLowerBounds, c(-30.185323, -39.416167, -24.461261, 16.408896), tolerance = 1e-07) expect_equal(result7$repeatedConfidenceIntervalUpperBounds, c(170.18532, 149.41617, 130.73577, 138.52605), tolerance = 1e-07) expect_equal(result7$repeatedPValues, c(0.10782416, 0.1777417, 0.11951427, 0.0045471564), tolerance = 1e-07) expect_equal(result7$finalStage, 4) expect_equal(result7$finalPValues, c(NA_real_, NA_real_, NA_real_, 0.019111276), tolerance = 1e-07) expect_equal(result7$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, 3.8518991), tolerance = 1e-07) expect_equal(result7$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, 122.8312), tolerance = 1e-07) expect_equal(result7$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, 65.8091), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result7), NA))) expect_output(print(result7)$show()) invisible(capture.output(expect_error(summary(result7), NA))) expect_output(summary(result7)$show()) result7CodeBased <- eval(parse(text = getObjectRCode(result7, stringWrapParagraphWidth = NULL))) expect_equal(result7CodeBased$thetaH1, result7$thetaH1, tolerance = 1e-05) expect_equal(result7CodeBased$assumedStDev, result7$assumedStDev, tolerance = 1e-05) expect_equal(result7CodeBased$testActions, result7$testActions, tolerance = 1e-05) expect_equal(result7CodeBased$conditionalRejectionProbabilities, result7$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result7CodeBased$conditionalPower, result7$conditionalPower, tolerance = 1e-05) expect_equal(result7CodeBased$repeatedConfidenceIntervalLowerBounds, result7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result7CodeBased$repeatedConfidenceIntervalUpperBounds, result7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result7CodeBased$repeatedPValues, result7$repeatedPValues, tolerance = 1e-05) expect_equal(result7CodeBased$finalStage, result7$finalStage, tolerance = 1e-05) expect_equal(result7CodeBased$finalPValues, result7$finalPValues, tolerance = 1e-05) expect_equal(result7CodeBased$finalConfidenceIntervalLowerBounds, result7$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result7CodeBased$finalConfidenceIntervalUpperBounds, result7$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result7CodeBased$medianUnbiasedEstimates, result7$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result7), "character") df <- as.data.frame(result7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults' for an inverse normal design and a dataset of two means per stage, stages: default, 2, 3, and 4", { .skipTestIfDisabled() dataExample5 <- getDataset( n1 = c(23, 13, 22, 13), n2 = c(22, 11, 22, 11), means1 = c(1.7, 1.5, 1.8, 2.5) * 100, means2 = c(1, 1.1, 1.3, 1) * 100, stds1 = c(1.3, 2.4, 2.2, 1.3) * 100, stds2 = c(1.2, 2.2, 2.1, 1.3) * 100 ) design9 <- getDesignInverseNormal(kMax = 4, alpha = 0.025, typeOfDesign = "WT", deltaWT = 0.4) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeGreaterUnequalVariances} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCITwoMeans} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoMeansEffect} result2 <- getAnalysisResults(design = design9, dataInput = dataExample5, equalVariances = FALSE, stage = 2, nPlanned = c(15, 15), thetaH0 = 0, thetaH1 = 130, assumedStDev = 100, allocationRatioPlanned = 2) ## Comparison of the results of AnalysisResultsInverseNormal object 'result2' with expected results expect_equal(result2$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(result2$conditionalRejectionProbabilities, c(0.12372016, 0.08089089, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result2$conditionalPower, c(NA_real_, NA_real_, 0.7399771, 0.96741599), tolerance = 1e-07) expect_equal(result2$repeatedConfidenceIntervalLowerBounds, c(-30.008991, -32.585516, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result2$repeatedConfidenceIntervalUpperBounds, c(170.00899, 154.76457, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result2$repeatedPValues, c(0.10725005, 0.13184907, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result2$finalStage, NA_integer_) expect_equal(result2$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result2), NA))) expect_output(print(result2)$show()) invisible(capture.output(expect_error(summary(result2), NA))) expect_output(summary(result2)$show()) result2CodeBased <- eval(parse(text = getObjectRCode(result2, stringWrapParagraphWidth = NULL))) expect_equal(result2CodeBased$testActions, result2$testActions, tolerance = 1e-05) expect_equal(result2CodeBased$conditionalRejectionProbabilities, result2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result2CodeBased$conditionalPower, result2$conditionalPower, tolerance = 1e-05) expect_equal(result2CodeBased$repeatedConfidenceIntervalLowerBounds, result2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result2CodeBased$repeatedConfidenceIntervalUpperBounds, result2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result2CodeBased$repeatedPValues, result2$repeatedPValues, tolerance = 1e-05) expect_equal(result2CodeBased$finalStage, result2$finalStage, tolerance = 1e-05) expect_equal(result2CodeBased$finalPValues, result2$finalPValues, tolerance = 1e-05) expect_equal(result2CodeBased$finalConfidenceIntervalLowerBounds, result2$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result2CodeBased$finalConfidenceIntervalUpperBounds, result2$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result2CodeBased$medianUnbiasedEstimates, result2$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result2), "character") df <- as.data.frame(result2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticDifferenceMeansUnequalVariances} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeGreaterUnequalVariances} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCITwoMeans} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoMeansEffect} result5 <- getAnalysisResults(design = design9, dataInput = dataExample5, equalVariances = FALSE, stage = 3, nPlanned = 15, thetaH0 = 0, thetaH1 = 130, assumedStDev = 100, allocationRatioPlanned = 2) ## Comparison of the results of AnalysisResultsInverseNormal object 'result5' with expected results expect_equal(result5$testActions, c("continue", "continue", "continue", NA_character_)) expect_equal(result5$conditionalRejectionProbabilities, c(0.12372016, 0.08089089, 0.073275512, NA_real_), tolerance = 1e-07) expect_equal(result5$conditionalPower, c(NA_real_, NA_real_, NA_real_, 0.82164236), tolerance = 1e-07) expect_equal(result5$repeatedConfidenceIntervalLowerBounds, c(-30.008991, -32.585516, -19.230333, NA_real_), tolerance = 1e-07) expect_equal(result5$repeatedConfidenceIntervalUpperBounds, c(170.00899, 154.76457, 134.96564, NA_real_), tolerance = 1e-07) expect_equal(result5$repeatedPValues, c(0.10725005, 0.13184907, 0.088247169, NA_real_), tolerance = 1e-07) expect_equal(result5$finalStage, NA_integer_) expect_equal(result5$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result5$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result5), NA))) expect_output(print(result5)$show()) invisible(capture.output(expect_error(summary(result5), NA))) expect_output(summary(result5)$show()) result5CodeBased <- eval(parse(text = getObjectRCode(result5, stringWrapParagraphWidth = NULL))) expect_equal(result5CodeBased$testActions, result5$testActions, tolerance = 1e-05) expect_equal(result5CodeBased$conditionalRejectionProbabilities, result5$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result5CodeBased$conditionalPower, result5$conditionalPower, tolerance = 1e-05) expect_equal(result5CodeBased$repeatedConfidenceIntervalLowerBounds, result5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result5CodeBased$repeatedConfidenceIntervalUpperBounds, result5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result5CodeBased$repeatedPValues, result5$repeatedPValues, tolerance = 1e-05) expect_equal(result5CodeBased$finalStage, result5$finalStage, tolerance = 1e-05) expect_equal(result5CodeBased$finalPValues, result5$finalPValues, tolerance = 1e-05) expect_equal(result5CodeBased$finalConfidenceIntervalLowerBounds, result5$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result5CodeBased$finalConfidenceIntervalUpperBounds, result5$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result5CodeBased$medianUnbiasedEstimates, result5$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result5), "character") df <- as.data.frame(result5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticDifferenceMeansUnequalVariances} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeGreaterUnequalVariances} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCITwoMeans} result8 <- getAnalysisResults(design = design9, dataInput = dataExample5, equalVariances = FALSE, stage = 4, nPlanned = numeric(0), thetaH0 = 0) ## Comparison of the results of AnalysisResultsInverseNormal object 'result8' with expected results expect_equal(result8$thetaH1, 72.41784, tolerance = 1e-07) expect_equal(result8$assumedStDev, 177.47472, tolerance = 1e-07) expect_equal(result8$testActions, c("continue", "continue", "continue", "reject")) expect_equal(result8$conditionalRejectionProbabilities, c(0.12372016, 0.08089089, 0.073275512, NA_real_), tolerance = 1e-07) expect_equal(result8$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result8$repeatedConfidenceIntervalLowerBounds, c(-30.008991, -32.585516, -19.230333, 16.862491), tolerance = 1e-07) expect_equal(result8$repeatedConfidenceIntervalUpperBounds, c(170.00899, 154.76457, 134.96564, 146.10543), tolerance = 1e-07) expect_equal(result8$repeatedPValues, c(0.10725005, 0.13184907, 0.088247169, 0.0050030118), tolerance = 1e-07) expect_equal(result8$finalStage, 4) expect_equal(result8$finalPValues, c(NA_real_, NA_real_, NA_real_, 0.019192988), tolerance = 1e-07) expect_equal(result8$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, 4.0866331), tolerance = 1e-07) expect_equal(result8$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, 135.35066), tolerance = 1e-07) expect_equal(result8$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, 71.819794), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result8), NA))) expect_output(print(result8)$show()) invisible(capture.output(expect_error(summary(result8), NA))) expect_output(summary(result8)$show()) result8CodeBased <- eval(parse(text = getObjectRCode(result8, stringWrapParagraphWidth = NULL))) expect_equal(result8CodeBased$thetaH1, result8$thetaH1, tolerance = 1e-05) expect_equal(result8CodeBased$assumedStDev, result8$assumedStDev, tolerance = 1e-05) expect_equal(result8CodeBased$testActions, result8$testActions, tolerance = 1e-05) expect_equal(result8CodeBased$conditionalRejectionProbabilities, result8$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result8CodeBased$conditionalPower, result8$conditionalPower, tolerance = 1e-05) expect_equal(result8CodeBased$repeatedConfidenceIntervalLowerBounds, result8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result8CodeBased$repeatedConfidenceIntervalUpperBounds, result8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result8CodeBased$repeatedPValues, result8$repeatedPValues, tolerance = 1e-05) expect_equal(result8CodeBased$finalStage, result8$finalStage, tolerance = 1e-05) expect_equal(result8CodeBased$finalPValues, result8$finalPValues, tolerance = 1e-05) expect_equal(result8CodeBased$finalConfidenceIntervalLowerBounds, result8$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result8CodeBased$finalConfidenceIntervalUpperBounds, result8$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result8CodeBased$medianUnbiasedEstimates, result8$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result8), "character") df <- as.data.frame(result8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults' for a Fisher design and a dataset of two means per stage, stages: default, 2, 3, and 4", { .skipTestIfDisabled() informationRates <- c(0.2, 0.5, 0.8, 1) dataExample6 <- getDataset( n1 = c(23, 13, 22, 13), n2 = c(22, 11, 22, 11), means1 = c(1.7, 1.5, 1.8, 2.5) * 100, means2 = c(1, 1.1, 1.3, 1) * 100, stds1 = c(1.3, 2.4, 2.2, 1.3) * 100, stds2 = c(1.2, 2.2, 2.1, 1.3) * 100 ) design10 <- getDesignFisher(kMax = 4, alpha = 0.035, informationRates = informationRates) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticDifferenceMeansEqualVariances} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeGreaterEqualVariances} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:finalPValueFisherCombinationTest} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} result3 <- getAnalysisResults(design = design10, dataInput = dataExample6, equalVariances = TRUE, stage = 2, nPlanned = c(18, 12), thetaH0 = 0, thetaH1 = 130, assumedStDev = 100, allocationRatioPlanned = 2, seed = 123456789) ## Comparison of the results of AnalysisResultsFisher object 'result3' with expected results expect_equal(result3$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(result3$conditionalRejectionProbabilities, c(0.092626641, 0.040500778, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result3$repeatedConfidenceIntervalLowerBounds, c(-14.62622, -29.188312, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result3$repeatedConfidenceIntervalUpperBounds, c(154.62622, 155.99339, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result3$repeatedPValues, c(0.078061948, 0.16270991, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result3$finalStage, NA_integer_) expect_equal(result3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result3$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.734, 0.933), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result3), NA))) expect_output(print(result3)$show()) invisible(capture.output(expect_error(summary(result3), NA))) expect_output(summary(result3)$show()) result3CodeBased <- eval(parse(text = getObjectRCode(result3, stringWrapParagraphWidth = NULL))) expect_equal(result3CodeBased$testActions, result3$testActions, tolerance = 1e-05) expect_equal(result3CodeBased$conditionalRejectionProbabilities, result3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result3CodeBased$repeatedConfidenceIntervalLowerBounds, result3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result3CodeBased$repeatedConfidenceIntervalUpperBounds, result3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result3CodeBased$repeatedPValues, result3$repeatedPValues, tolerance = 1e-05) expect_equal(result3CodeBased$finalStage, result3$finalStage, tolerance = 1e-05) expect_equal(result3CodeBased$finalPValues, result3$finalPValues, tolerance = 1e-05) expect_equal(result3CodeBased$finalConfidenceIntervalLowerBounds, result3$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result3CodeBased$finalConfidenceIntervalUpperBounds, result3$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result3CodeBased$medianUnbiasedEstimates, result3$medianUnbiasedEstimates, tolerance = 1e-05) expect_equal(result3CodeBased$conditionalPowerSimulated, result3$conditionalPowerSimulated, tolerance = 1e-05) expect_type(names(result3), "character") df <- as.data.frame(result3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticDifferenceMeansEqualVariances} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeGreaterEqualVariances} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:finalPValueFisherCombinationTest} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} result6 <- getAnalysisResults(design = design10, dataInput = dataExample6, equalVariances = TRUE, stage = 3, nPlanned = 15, thetaH0 = 0, thetaH1 = 130, assumedStDev = 100, allocationRatioPlanned = 2, seed = 123456789) ## Comparison of the results of AnalysisResultsFisher object 'result6' with expected results expect_equal(result6$testActions, c("continue", "continue", "continue", NA_character_)) expect_equal(result6$conditionalRejectionProbabilities, c(0.092626641, 0.040500778, 0.016148337, NA_real_), tolerance = 1e-07) expect_equal(result6$conditionalPower, c(NA_real_, NA_real_, NA_real_, 0.5920203), tolerance = 1e-07) expect_equal(result6$repeatedConfidenceIntervalLowerBounds, c(-14.62622, -29.188312, -25.34531, NA_real_), tolerance = 1e-07) expect_equal(result6$repeatedConfidenceIntervalUpperBounds, c(154.62622, 155.99339, 144.38935, NA_real_), tolerance = 1e-07) expect_equal(result6$repeatedPValues, c(0.078061948, 0.16270991, 0.16485567, NA_real_), tolerance = 1e-07) expect_equal(result6$finalStage, NA_integer_) expect_equal(result6$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result6$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result6), NA))) expect_output(print(result6)$show()) invisible(capture.output(expect_error(summary(result6), NA))) expect_output(summary(result6)$show()) result6CodeBased <- eval(parse(text = getObjectRCode(result6, stringWrapParagraphWidth = NULL))) expect_equal(result6CodeBased$testActions, result6$testActions, tolerance = 1e-05) expect_equal(result6CodeBased$conditionalRejectionProbabilities, result6$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result6CodeBased$conditionalPower, result6$conditionalPower, tolerance = 1e-05) expect_equal(result6CodeBased$repeatedConfidenceIntervalLowerBounds, result6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result6CodeBased$repeatedConfidenceIntervalUpperBounds, result6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result6CodeBased$repeatedPValues, result6$repeatedPValues, tolerance = 1e-05) expect_equal(result6CodeBased$finalStage, result6$finalStage, tolerance = 1e-05) expect_equal(result6CodeBased$finalPValues, result6$finalPValues, tolerance = 1e-05) expect_equal(result6CodeBased$finalConfidenceIntervalLowerBounds, result6$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result6CodeBased$finalConfidenceIntervalUpperBounds, result6$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result6CodeBased$medianUnbiasedEstimates, result6$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result6), "character") df <- as.data.frame(result6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticDifferenceMeansEqualVariances} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeGreaterEqualVariances} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:finalPValueFisherCombinationTest} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} result9 <- getAnalysisResults(design = design10, dataInput = dataExample6, equalVariances = TRUE, stage = 4, nPlanned = numeric(0), thetaH0 = 0, seed = 123456789) ## Comparison of the results of AnalysisResultsFisher object 'result9' with expected results expect_equal(result9$thetaH1, 72.41784, tolerance = 1e-07) expect_equal(result9$assumedStDev, 177.47472, tolerance = 1e-07) expect_equal(result9$testActions, c("continue", "continue", "continue", "reject")) expect_equal(result9$conditionalRejectionProbabilities, c(0.092626641, 0.040500778, 0.016148337, NA_real_), tolerance = 1e-07) expect_equal(result9$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result9$repeatedConfidenceIntervalLowerBounds, c(-14.62622, -29.188312, -25.34531, 8.7533154), tolerance = 1e-07) expect_equal(result9$repeatedConfidenceIntervalUpperBounds, c(154.62622, 155.99339, 144.38935, 151.28694), tolerance = 1e-07) expect_equal(result9$repeatedPValues, c(0.078061948, 0.16270991, 0.16485567, 0.017103207), tolerance = 1e-07) expect_equal(result9$finalStage, NA_integer_) expect_equal(result9$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result9$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result9$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result9$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result9), NA))) expect_output(print(result9)$show()) invisible(capture.output(expect_error(summary(result9), NA))) expect_output(summary(result9)$show()) result9CodeBased <- eval(parse(text = getObjectRCode(result9, stringWrapParagraphWidth = NULL))) expect_equal(result9CodeBased$thetaH1, result9$thetaH1, tolerance = 1e-05) expect_equal(result9CodeBased$assumedStDev, result9$assumedStDev, tolerance = 1e-05) expect_equal(result9CodeBased$testActions, result9$testActions, tolerance = 1e-05) expect_equal(result9CodeBased$conditionalRejectionProbabilities, result9$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result9CodeBased$conditionalPower, result9$conditionalPower, tolerance = 1e-05) expect_equal(result9CodeBased$repeatedConfidenceIntervalLowerBounds, result9$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result9CodeBased$repeatedConfidenceIntervalUpperBounds, result9$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result9CodeBased$repeatedPValues, result9$repeatedPValues, tolerance = 1e-05) expect_equal(result9CodeBased$finalStage, result9$finalStage, tolerance = 1e-05) expect_equal(result9CodeBased$finalPValues, result9$finalPValues, tolerance = 1e-05) expect_equal(result9CodeBased$finalConfidenceIntervalLowerBounds, result9$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result9CodeBased$finalConfidenceIntervalUpperBounds, result9$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result9CodeBased$medianUnbiasedEstimates, result9$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result9), "character") df <- as.data.frame(result9) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result9) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("Check that the conditional power is as expected for different designs and datasets", { .skipTestIfDisabled() informationRates <- c(0.2, 0.5, 0.8, 1) dataExample7 <- getDataset( n1 = c(22, 33, 31, 13), n2 = c(22, 31, 30, 11), means1 = c(1, 1.1, 1, 1), means2 = c(1.4, 1.5, 1, 2.5), stds1 = c(1, 2, 2, 1.3), stds2 = c(1, 2, 2, 1.3)) design11 <- getDesignGroupSequential(kMax = 4, alpha = 0.025, informationRates = informationRates, futilityBounds = rep(0.5244, 3), bindingFutility = TRUE, typeOfDesign = "WT", deltaWT = 0.45) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticDifferenceMeansEqualVariances} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeSmallerEqualVariances} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCITwoMeans} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoMeansEffect} result1 <- getAnalysisResults(design = design11, dataInput = dataExample7, equalVariances = TRUE, directionUpper = FALSE, stage = 2, thetaH0 = 0.2, thetaH1 = -0.2, nPlanned = c(96, 64), allocationRatioPlanned = 3, normalApproximation = FALSE) ## Comparison of the results of AnalysisResultsGroupSequential object 'result1' with expected results expect_equal(result1$assumedStDev, 1.6547835, tolerance = 1e-07) expect_equal(result1$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(result1$conditionalRejectionProbabilities, c(0.13790633, 0.14848468, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result1$conditionalPower, c(NA_real_, NA_real_, 0.40521176, 0.57857102), tolerance = 1e-07) expect_equal(result1$repeatedConfidenceIntervalLowerBounds, c(-1.1558731, -1.1414911, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result1$repeatedConfidenceIntervalUpperBounds, c(0.35587299, 0.34450997, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result1$repeatedPValues, c(0.06267349, 0.061334534, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result1$finalStage, NA_integer_) expect_equal(result1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result1), NA))) expect_output(print(result1)$show()) invisible(capture.output(expect_error(summary(result1), NA))) expect_output(summary(result1)$show()) result1CodeBased <- eval(parse(text = getObjectRCode(result1, stringWrapParagraphWidth = NULL))) expect_equal(result1CodeBased$assumedStDev, result1$assumedStDev, tolerance = 1e-05) expect_equal(result1CodeBased$testActions, result1$testActions, tolerance = 1e-05) expect_equal(result1CodeBased$conditionalRejectionProbabilities, result1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result1CodeBased$conditionalPower, result1$conditionalPower, tolerance = 1e-05) expect_equal(result1CodeBased$repeatedConfidenceIntervalLowerBounds, result1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result1CodeBased$repeatedConfidenceIntervalUpperBounds, result1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result1CodeBased$repeatedPValues, result1$repeatedPValues, tolerance = 1e-05) expect_equal(result1CodeBased$finalStage, result1$finalStage, tolerance = 1e-05) expect_equal(result1CodeBased$finalPValues, result1$finalPValues, tolerance = 1e-05) expect_equal(result1CodeBased$finalConfidenceIntervalLowerBounds, result1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result1CodeBased$finalConfidenceIntervalUpperBounds, result1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result1CodeBased$medianUnbiasedEstimates, result1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result1), "character") df <- as.data.frame(result1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design12 <- getDesignInverseNormal(kMax = 4, alpha = 0.025, informationRates = informationRates, typeOfDesign = "WT", deltaWT = 0.45) stageResults <- getStageResults(design = design12, dataInput = dataExample7, equalVariances = TRUE, directionUpper = TRUE, stage = 2, thetaH0 = -1) ## Comparison of the results of StageResultsMeans object 'stageResults' with expected results expect_equal(stageResults$overallTestStatistics, c(1.9899749, 1.8884638, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults$overallPValues, c(0.026564837, 0.030848764, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults$overallMeans1, c(1, 1.06, 1.0383721, 1.0333333), tolerance = 1e-07) expect_equal(stageResults$overallMeans2, c(1.4, 1.4584906, 1.2927711, 1.4340426), tolerance = 1e-07) expect_equal(stageResults$overallStDevs1, c(1, 1.6618374, 1.7796344, 1.7187442), tolerance = 1e-07) expect_equal(stageResults$overallStDevs2, c(1, 1.6474262, 1.7846078, 1.7725841), tolerance = 1e-07) expect_equal(stageResults$overallSampleSizes1, c(22, 55, NA_real_, NA_real_)) expect_equal(stageResults$overallSampleSizes2, c(22, 53, NA_real_, NA_real_)) expect_equal(stageResults$testStatistics, c(1.9899749, 1.1994139, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults$pValues, c(0.026564837, 0.11746538, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults$effectSizes, c(-0.4, -0.39849057, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults$combInverseNormal, c(1.9338654, 2.1431134, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults$weightsInverseNormal, c(0.4472136, 0.54772256, 0.54772256, 0.4472136), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(stageResults), NA))) expect_output(print(stageResults)$show()) invisible(capture.output(expect_error(summary(stageResults), NA))) expect_output(summary(stageResults)$show()) stageResultsCodeBased <- eval(parse(text = getObjectRCode(stageResults, stringWrapParagraphWidth = NULL))) expect_equal(stageResultsCodeBased$overallTestStatistics, stageResults$overallTestStatistics, tolerance = 1e-05) expect_equal(stageResultsCodeBased$overallPValues, stageResults$overallPValues, tolerance = 1e-05) expect_equal(stageResultsCodeBased$overallMeans1, stageResults$overallMeans1, tolerance = 1e-05) expect_equal(stageResultsCodeBased$overallMeans2, stageResults$overallMeans2, tolerance = 1e-05) expect_equal(stageResultsCodeBased$overallStDevs1, stageResults$overallStDevs1, tolerance = 1e-05) expect_equal(stageResultsCodeBased$overallStDevs2, stageResults$overallStDevs2, tolerance = 1e-05) expect_equal(stageResultsCodeBased$overallSampleSizes1, stageResults$overallSampleSizes1, tolerance = 1e-05) expect_equal(stageResultsCodeBased$overallSampleSizes2, stageResults$overallSampleSizes2, tolerance = 1e-05) expect_equal(stageResultsCodeBased$testStatistics, stageResults$testStatistics, tolerance = 1e-05) expect_equal(stageResultsCodeBased$pValues, stageResults$pValues, tolerance = 1e-05) expect_equal(stageResultsCodeBased$effectSizes, stageResults$effectSizes, tolerance = 1e-05) expect_equal(stageResultsCodeBased$combInverseNormal, stageResults$combInverseNormal, tolerance = 1e-05) expect_equal(stageResultsCodeBased$weightsInverseNormal, stageResults$weightsInverseNormal, tolerance = 1e-05) expect_type(names(stageResults), "character") df <- as.data.frame(stageResults) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(stageResults) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getConditionalPowerMeans} # @refFS[Formula]{fs:testStatisticDifferenceMeansEqualVariances} # @refFS[Formula]{fs:conditionalPowerTwoMeansEffect} conditionalPower <- getConditionalPower(stageResults, thetaH1 = 0.840, nPlanned = c(96,64), assumedStDev = 2) ## Comparison of the results of ConditionalPowerResultsMeans object 'conditionalPower' with expected results expect_equal(conditionalPower$conditionalPower, c(NA_real_, NA_real_, 0.99975751, 0.99999919), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(conditionalPower), NA))) expect_output(print(conditionalPower)$show()) invisible(capture.output(expect_error(summary(conditionalPower), NA))) expect_output(summary(conditionalPower)$show()) conditionalPowerCodeBased <- eval(parse(text = getObjectRCode(conditionalPower, stringWrapParagraphWidth = NULL))) expect_equal(conditionalPowerCodeBased$conditionalPower, conditionalPower$conditionalPower, tolerance = 1e-05) expect_type(names(conditionalPower), "character") df <- as.data.frame(conditionalPower) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(conditionalPower) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } conditionalPowerPlot <- .getConditionalPowerPlot(stageResults = stageResults, thetaRange = seq(-0.8,0.5,0.1), nPlanned = c(96,64), assumedStDev = 2, allocationRatioPlanned = 3) ## Comparison of the results of list object 'conditionalPowerPlot' with expected results expect_equal(conditionalPowerPlot$xValues, c(-0.8, -0.7, -0.6, -0.5, -0.4, -0.3, -0.2, -0.1, 0, 0.1, 0.2, 0.3, 0.4, 0.5), tolerance = 1e-07) expect_equal(conditionalPowerPlot$condPowerValues, c(0.37570702, 0.47532662, 0.57738365, 0.67516684, 0.76267391, 0.83573986, 0.89261201, 0.9338489, 0.96168572, 0.97917178, 0.98938899, 0.99494036, 0.99774434, 0.99906067), tolerance = 1e-07) expect_equal(conditionalPowerPlot$likelihoodValues, c(0.45180702, 0.63888737, 0.81863148, 0.95048525, 0.99998877, 0.95331773, 0.82351787, 0.64461615, 0.45721677, 0.29385692, 0.17113644, 0.090311253, 0.043185112, 0.018711949), tolerance = 1e-07) expect_equal(conditionalPowerPlot$main, "Conditional Power with Likelihood") expect_equal(conditionalPowerPlot$xlab, "Effect size") expect_equal(conditionalPowerPlot$ylab, "Conditional power / Likelihood") expect_equal(conditionalPowerPlot$sub, "Stage = 2, # of remaining subjects = 160, sd = 2, allocation ratio = 3") # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticDifferenceMeansEqualVariances} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeGreaterEqualVariances} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueLower} # @refFS[Formula]{fs:finalCITwoMeans} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoMeansEffect} result2 <- getAnalysisResults(design = design12, dataInput = dataExample7, equalVariances = TRUE, directionUpper = FALSE, stage = 2, thetaH0 = 0.2, thetaH1 = -0.2, nPlanned = c(96, 64), allocationRatioPlanned = 3, normalApproximation = FALSE) ## Comparison of the results of AnalysisResultsInverseNormal object 'result2' with expected results expect_equal(result2$assumedStDev, 1.6547835, tolerance = 1e-07) expect_equal(result2$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(result2$conditionalRejectionProbabilities, c(0.11857307, 0.20646025, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result2$conditionalPower, c(NA_real_, NA_real_, 0.50295479, 0.65954708), tolerance = 1e-07) expect_equal(result2$repeatedConfidenceIntervalLowerBounds, c(-1.182291, -1.0666303, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result2$repeatedConfidenceIntervalUpperBounds, c(0.3822909, 0.2666303, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result2$repeatedPValues, c(0.081445577, 0.043264349, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result2$finalStage, NA_integer_) expect_equal(result2$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result2), NA))) expect_output(print(result2)$show()) invisible(capture.output(expect_error(summary(result2), NA))) expect_output(summary(result2)$show()) result2CodeBased <- eval(parse(text = getObjectRCode(result2, stringWrapParagraphWidth = NULL))) expect_equal(result2CodeBased$assumedStDev, result2$assumedStDev, tolerance = 1e-05) expect_equal(result2CodeBased$testActions, result2$testActions, tolerance = 1e-05) expect_equal(result2CodeBased$conditionalRejectionProbabilities, result2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result2CodeBased$conditionalPower, result2$conditionalPower, tolerance = 1e-05) expect_equal(result2CodeBased$repeatedConfidenceIntervalLowerBounds, result2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result2CodeBased$repeatedConfidenceIntervalUpperBounds, result2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result2CodeBased$repeatedPValues, result2$repeatedPValues, tolerance = 1e-05) expect_equal(result2CodeBased$finalStage, result2$finalStage, tolerance = 1e-05) expect_equal(result2CodeBased$finalPValues, result2$finalPValues, tolerance = 1e-05) expect_equal(result2CodeBased$finalConfidenceIntervalLowerBounds, result2$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result2CodeBased$finalConfidenceIntervalUpperBounds, result2$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result2CodeBased$medianUnbiasedEstimates, result2$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(result2), "character") df <- as.data.frame(result2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticDifferenceMeansEqualVariances} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeGreaterEqualVariances} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoMeansEffect} design13 <- getDesignFisher(kMax = 4, alpha = 0.025, informationRates = informationRates) result3 <- getAnalysisResults(design = design13, dataInput = dataExample7, equalVariances = TRUE, directionUpper = FALSE, stage = 2, nPlanned = c(96, 64), thetaH1 = -0.4, allocationRatioPlanned = 2, normalApproximation = FALSE, iterations = 10000, seed = 442018) ## Comparison of the results of AnalysisResultsFisher object 'result3' with expected results expect_equal(result3$assumedStDev, 1.6547835, tolerance = 1e-07) expect_equal(result3$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(result3$conditionalRejectionProbabilities, c(0.031447357, 0.018451139, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result3$repeatedConfidenceIntervalLowerBounds, c(-1.1295139, -1.1012297, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result3$repeatedConfidenceIntervalUpperBounds, c(0.32951385, 0.30122972, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result3$repeatedPValues, c(0.19930232, 0.21960219, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(result3$finalStage, NA_integer_) expect_equal(result3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(result3$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.1239, 0.2143), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(result3), NA))) expect_output(print(result3)$show()) invisible(capture.output(expect_error(summary(result3), NA))) expect_output(summary(result3)$show()) result3CodeBased <- eval(parse(text = getObjectRCode(result3, stringWrapParagraphWidth = NULL))) expect_equal(result3CodeBased$assumedStDev, result3$assumedStDev, tolerance = 1e-05) expect_equal(result3CodeBased$testActions, result3$testActions, tolerance = 1e-05) expect_equal(result3CodeBased$conditionalRejectionProbabilities, result3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(result3CodeBased$repeatedConfidenceIntervalLowerBounds, result3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result3CodeBased$repeatedConfidenceIntervalUpperBounds, result3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result3CodeBased$repeatedPValues, result3$repeatedPValues, tolerance = 1e-05) expect_equal(result3CodeBased$finalStage, result3$finalStage, tolerance = 1e-05) expect_equal(result3CodeBased$finalPValues, result3$finalPValues, tolerance = 1e-05) expect_equal(result3CodeBased$finalConfidenceIntervalLowerBounds, result3$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(result3CodeBased$finalConfidenceIntervalUpperBounds, result3$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(result3CodeBased$medianUnbiasedEstimates, result3$medianUnbiasedEstimates, tolerance = 1e-05) expect_equal(result3CodeBased$conditionalPowerSimulated, result3$conditionalPowerSimulated, tolerance = 1e-05) expect_type(names(result3), "character") df <- as.data.frame(result3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(result3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) context("Testing 'getStageResults'") test_that("'getStageResults' for an inverse normal design and one or two treatments", { #.skipTestIfDisabled() designInverseNormal <- getDesignInverseNormal(kMax = 4, alpha = 0.025, sided = 1, typeOfDesign = "WT", deltaWT = 0.25, futilityBounds = rep(qnorm(0.7),3)) dataExample8 <- getDataset( n = c(10, 10), means = c(2, 3), stDevs = c(1, 1.5)) # @refFS[Tab.]{fs:tab:output:getStageResultsMeans} # @refFS[Formula]{fs:testStatisticOneMean} # @refFS[Formula]{fs:pValuesOneMeanAlternativeGreater} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} stageResults1 <- getStageResults(design = designInverseNormal, dataInput = dataExample8, stage = 2, thetaH0 = 0, directionUpper = TRUE, normalApproximation = FALSE, equalVariances = TRUE) ## Comparison of the results of StageResultsMeans object 'stageResults1' with expected results expect_equal(stageResults1$overallTestStatistics, c(6.3245553, 8.3272484, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$overallPValues, c(6.846828e-05, 4.5964001e-08, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$overallMeans, c(2, 2.5, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$overallStDevs, c(1, 1.3426212, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$overallSampleSizes, c(10, 20, NA_real_, NA_real_)) expect_equal(stageResults1$testStatistics, c(6.3245553, 6.3245553, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$pValues, c(6.846828e-05, 6.846828e-05, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$effectSizes, c(2, 2.5, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$combInverseNormal, c(3.813637, 5.3932972, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults1$weightsInverseNormal, c(0.5, 0.5, 0.5, 0.5), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(stageResults1), NA))) expect_output(print(stageResults1)$show()) invisible(capture.output(expect_error(summary(stageResults1), NA))) expect_output(summary(stageResults1)$show()) stageResults1CodeBased <- eval(parse(text = getObjectRCode(stageResults1, stringWrapParagraphWidth = NULL))) expect_equal(stageResults1CodeBased$overallTestStatistics, stageResults1$overallTestStatistics, tolerance = 1e-05) expect_equal(stageResults1CodeBased$overallPValues, stageResults1$overallPValues, tolerance = 1e-05) expect_equal(stageResults1CodeBased$overallMeans, stageResults1$overallMeans, tolerance = 1e-05) expect_equal(stageResults1CodeBased$overallStDevs, stageResults1$overallStDevs, tolerance = 1e-05) expect_equal(stageResults1CodeBased$overallSampleSizes, stageResults1$overallSampleSizes, tolerance = 1e-05) expect_equal(stageResults1CodeBased$testStatistics, stageResults1$testStatistics, tolerance = 1e-05) expect_equal(stageResults1CodeBased$pValues, stageResults1$pValues, tolerance = 1e-05) expect_equal(stageResults1CodeBased$effectSizes, stageResults1$effectSizes, tolerance = 1e-05) expect_equal(stageResults1CodeBased$combInverseNormal, stageResults1$combInverseNormal, tolerance = 1e-05) expect_equal(stageResults1CodeBased$weightsInverseNormal, stageResults1$weightsInverseNormal, tolerance = 1e-05) expect_type(names(stageResults1), "character") df <- as.data.frame(stageResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(stageResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } dataExample9 <- getDataset( n1 = c(22, 11, 22, 11), n2 = c(22, 13, 22, 13), means1 = c(1, 1.1, 1, 1), means2 = c(1.4, 1.5, 3, 2.5), stDevs1 = c(1, 2, 2, 1.3), stDevs2 = c(1, 2, 2, 1.3) ) # @refFS[Tab.]{fs:tab:output:getStageResultsMeans} # @refFS[Formula]{fs:testStatisticDifferenceMeansEqualVariances} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeGreaterEqualVariances} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} stageResults2 <- getStageResults(design = designInverseNormal, dataInput = dataExample9, stage = 2, thetaH0 = 0, directionUpper = TRUE, normalApproximation = FALSE, equalVariances = TRUE) ## Comparison of the results of StageResultsMeans object 'stageResults2' with expected results expect_equal(stageResults2$overallTestStatistics, c(-1.3266499, -1.1850988, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$overallPValues, c(0.90410354, 0.87988596, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$overallMeans1, c(1, 1.0333333, 1.02, 1.0166667), tolerance = 1e-07) expect_equal(stageResults2$overallMeans2, c(1.4, 1.4371429, 2.0403509, 2.1257143), tolerance = 1e-07) expect_equal(stageResults2$overallStDevs1, c(1, 1.3814998, 1.6391506, 1.5786638), tolerance = 1e-07) expect_equal(stageResults2$overallStDevs2, c(1, 1.4254175, 1.8228568, 1.7387056), tolerance = 1e-07) expect_equal(stageResults2$overallSampleSizes1, c(22, 33, NA_real_, NA_real_)) expect_equal(stageResults2$overallSampleSizes2, c(22, 35, NA_real_, NA_real_)) expect_equal(stageResults2$testStatistics, c(-1.3266499, -0.48819395, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$pValues, c(0.90410354, 0.68487854, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$effectSizes, c(-0.4, -0.40380952, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$combInverseNormal, c(-1.3052935, -1.2633725, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(stageResults2$weightsInverseNormal, c(0.5, 0.5, 0.5, 0.5), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(stageResults2), NA))) expect_output(print(stageResults2)$show()) invisible(capture.output(expect_error(summary(stageResults2), NA))) expect_output(summary(stageResults2)$show()) stageResults2CodeBased <- eval(parse(text = getObjectRCode(stageResults2, stringWrapParagraphWidth = NULL))) expect_equal(stageResults2CodeBased$overallTestStatistics, stageResults2$overallTestStatistics, tolerance = 1e-05) expect_equal(stageResults2CodeBased$overallPValues, stageResults2$overallPValues, tolerance = 1e-05) expect_equal(stageResults2CodeBased$overallMeans1, stageResults2$overallMeans1, tolerance = 1e-05) expect_equal(stageResults2CodeBased$overallMeans2, stageResults2$overallMeans2, tolerance = 1e-05) expect_equal(stageResults2CodeBased$overallStDevs1, stageResults2$overallStDevs1, tolerance = 1e-05) expect_equal(stageResults2CodeBased$overallStDevs2, stageResults2$overallStDevs2, tolerance = 1e-05) expect_equal(stageResults2CodeBased$overallSampleSizes1, stageResults2$overallSampleSizes1, tolerance = 1e-05) expect_equal(stageResults2CodeBased$overallSampleSizes2, stageResults2$overallSampleSizes2, tolerance = 1e-05) expect_equal(stageResults2CodeBased$testStatistics, stageResults2$testStatistics, tolerance = 1e-05) expect_equal(stageResults2CodeBased$pValues, stageResults2$pValues, tolerance = 1e-05) expect_equal(stageResults2CodeBased$effectSizes, stageResults2$effectSizes, tolerance = 1e-05) expect_equal(stageResults2CodeBased$combInverseNormal, stageResults2$combInverseNormal, tolerance = 1e-05) expect_equal(stageResults2CodeBased$weightsInverseNormal, stageResults2$weightsInverseNormal, tolerance = 1e-05) expect_type(names(stageResults2), "character") df <- as.data.frame(stageResults2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(stageResults2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getStageResults' for a Fisher design and one or two treatments", { .skipTestIfDisabled() designFisher <- getDesignFisher(kMax = 2, alpha = 0.025, alpha0Vec = 1, informationRates = c(0.5, 1), method = "equalAlpha") dataExample10 <- getDataset( n = c(10, 10), means = c(2, 3), stDevs = c(1, 1.5)) # @refFS[Tab.]{fs:tab:output:getStageResultsMeans} # @refFS[Formula]{fs:testStatisticOneMean} # @refFS[Formula]{fs:pValuesOneMeanAlternativeGreater} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} stageResults3 <- getStageResults(design = designFisher, dataInput = dataExample10, stage = 2, thetaH0 = 0, directionUpper = TRUE, normalApproximation = FALSE, equalVariances = TRUE) ## Comparison of the results of StageResultsMeans object 'stageResults3' with expected results expect_equal(stageResults3$overallTestStatistics, c(6.3245553, 8.3272484), tolerance = 1e-07) expect_equal(stageResults3$overallPValues, c(6.846828e-05, 4.5964001e-08), tolerance = 1e-07) expect_equal(stageResults3$overallMeans, c(2, 2.5), tolerance = 1e-07) expect_equal(stageResults3$overallStDevs, c(1, 1.3426212), tolerance = 1e-07) expect_equal(stageResults3$overallSampleSizes, c(10, 20)) expect_equal(stageResults3$testStatistics, c(6.3245553, 6.3245553), tolerance = 1e-07) expect_equal(stageResults3$pValues, c(6.846828e-05, 6.846828e-05), tolerance = 1e-07) expect_equal(stageResults3$effectSizes, c(2, 2.5), tolerance = 1e-07) expect_equal(stageResults3$combFisher, c(6.846828e-05, 4.6879053e-09), tolerance = 1e-07) expect_equal(stageResults3$weightsFisher, c(1, 1)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(stageResults3), NA))) expect_output(print(stageResults3)$show()) invisible(capture.output(expect_error(summary(stageResults3), NA))) expect_output(summary(stageResults3)$show()) stageResults3CodeBased <- eval(parse(text = getObjectRCode(stageResults3, stringWrapParagraphWidth = NULL))) expect_equal(stageResults3CodeBased$overallTestStatistics, stageResults3$overallTestStatistics, tolerance = 1e-05) expect_equal(stageResults3CodeBased$overallPValues, stageResults3$overallPValues, tolerance = 1e-05) expect_equal(stageResults3CodeBased$overallMeans, stageResults3$overallMeans, tolerance = 1e-05) expect_equal(stageResults3CodeBased$overallStDevs, stageResults3$overallStDevs, tolerance = 1e-05) expect_equal(stageResults3CodeBased$overallSampleSizes, stageResults3$overallSampleSizes, tolerance = 1e-05) expect_equal(stageResults3CodeBased$testStatistics, stageResults3$testStatistics, tolerance = 1e-05) expect_equal(stageResults3CodeBased$pValues, stageResults3$pValues, tolerance = 1e-05) expect_equal(stageResults3CodeBased$effectSizes, stageResults3$effectSizes, tolerance = 1e-05) expect_equal(stageResults3CodeBased$combFisher, stageResults3$combFisher, tolerance = 1e-05) expect_equal(stageResults3CodeBased$weightsFisher, stageResults3$weightsFisher, tolerance = 1e-05) expect_type(names(stageResults3), "character") df <- as.data.frame(stageResults3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(stageResults3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } dataExample11 <- getDataset( n1 = c(22, 11), n2 = c(22, 13), means1 = c(1, 1.1), means2 = c(1.4, 1.5), stDevs1 = c(1, 2), stDevs2 = c(1, 2) ) # @refFS[Tab.]{fs:tab:output:getStageResultsMeans} # @refFS[Formula]{fs:testStatisticDifferenceMeansEqualVariances} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeGreaterEqualVariances} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} stageResults4 <- getStageResults(design = designFisher, dataInput = dataExample11, stage = 2, thetaH0 = 0, directionUpper = TRUE, normalApproximation = FALSE, equalVariances = TRUE) ## Comparison of the results of StageResultsMeans object 'stageResults4' with expected results expect_equal(stageResults4$overallTestStatistics, c(-1.3266499, -1.1850988), tolerance = 1e-07) expect_equal(stageResults4$overallPValues, c(0.90410354, 0.87988596), tolerance = 1e-07) expect_equal(stageResults4$overallMeans1, c(1, 1.0333333), tolerance = 1e-07) expect_equal(stageResults4$overallMeans2, c(1.4, 1.4371429), tolerance = 1e-07) expect_equal(stageResults4$overallStDevs1, c(1, 1.3814998), tolerance = 1e-07) expect_equal(stageResults4$overallStDevs2, c(1, 1.4254175), tolerance = 1e-07) expect_equal(stageResults4$overallSampleSizes1, c(22, 33)) expect_equal(stageResults4$overallSampleSizes2, c(22, 35)) expect_equal(stageResults4$testStatistics, c(-1.3266499, -0.48819395), tolerance = 1e-07) expect_equal(stageResults4$pValues, c(0.90410354, 0.68487854), tolerance = 1e-07) expect_equal(stageResults4$effectSizes, c(-0.4, -0.40380952), tolerance = 1e-07) expect_equal(stageResults4$combFisher, c(0.90410354, 0.61920111), tolerance = 1e-07) expect_equal(stageResults4$weightsFisher, c(1, 1)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(stageResults4), NA))) expect_output(print(stageResults4)$show()) invisible(capture.output(expect_error(summary(stageResults4), NA))) expect_output(summary(stageResults4)$show()) stageResults4CodeBased <- eval(parse(text = getObjectRCode(stageResults4, stringWrapParagraphWidth = NULL))) expect_equal(stageResults4CodeBased$overallTestStatistics, stageResults4$overallTestStatistics, tolerance = 1e-05) expect_equal(stageResults4CodeBased$overallPValues, stageResults4$overallPValues, tolerance = 1e-05) expect_equal(stageResults4CodeBased$overallMeans1, stageResults4$overallMeans1, tolerance = 1e-05) expect_equal(stageResults4CodeBased$overallMeans2, stageResults4$overallMeans2, tolerance = 1e-05) expect_equal(stageResults4CodeBased$overallStDevs1, stageResults4$overallStDevs1, tolerance = 1e-05) expect_equal(stageResults4CodeBased$overallStDevs2, stageResults4$overallStDevs2, tolerance = 1e-05) expect_equal(stageResults4CodeBased$overallSampleSizes1, stageResults4$overallSampleSizes1, tolerance = 1e-05) expect_equal(stageResults4CodeBased$overallSampleSizes2, stageResults4$overallSampleSizes2, tolerance = 1e-05) expect_equal(stageResults4CodeBased$testStatistics, stageResults4$testStatistics, tolerance = 1e-05) expect_equal(stageResults4CodeBased$pValues, stageResults4$pValues, tolerance = 1e-05) expect_equal(stageResults4CodeBased$effectSizes, stageResults4$effectSizes, tolerance = 1e-05) expect_equal(stageResults4CodeBased$combFisher, stageResults4$combFisher, tolerance = 1e-05) expect_equal(stageResults4CodeBased$weightsFisher, stageResults4$weightsFisher, tolerance = 1e-05) expect_type(names(stageResults4), "character") df <- as.data.frame(stageResults4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(stageResults4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults' with a dataset of means and without defining a design", { .skipTestIfDisabled() data <- getDataset( n1 = c(22), n2 = c(21), means1 = c(1.63), means2 = c(1.4), stds1 = c(1.2), stds2 = c(1.3)) # @refFS[Tab.]{fs:tab:output:getStageResultsMeans} # @refFS[Formula]{fs:testStatisticDifferenceMeansEqualVariances} # @refFS[Formula]{fs:pValuesTwoMeansAlternativeGreaterEqualVariances} analysisResults1 <- getAnalysisResults(data, alpha = 0.02, sided = 2, stage = 1) ## Comparison of the results of AnalysisResultsInverseNormal object 'analysisResults1' with expected results expect_equal(analysisResults1$thetaH1, 0.23, tolerance = 1e-07) expect_equal(analysisResults1$assumedStDev, 1.2497805, tolerance = 1e-07) expect_equal(analysisResults1$testActions, "accept") expect_equal(analysisResults1$repeatedConfidenceIntervalLowerBounds, -0.69301003, tolerance = 1e-07) expect_equal(analysisResults1$repeatedConfidenceIntervalUpperBounds, 1.1530101, tolerance = 1e-07) expect_equal(analysisResults1$repeatedPValues, 0.54968031, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(analysisResults1), NA))) expect_output(print(analysisResults1)$show()) invisible(capture.output(expect_error(summary(analysisResults1), NA))) expect_output(summary(analysisResults1)$show()) analysisResults1CodeBased <- eval(parse(text = getObjectRCode(analysisResults1, stringWrapParagraphWidth = NULL))) expect_equal(analysisResults1CodeBased$thetaH1, analysisResults1$thetaH1, tolerance = 1e-05) expect_equal(analysisResults1CodeBased$assumedStDev, analysisResults1$assumedStDev, tolerance = 1e-05) expect_equal(analysisResults1CodeBased$testActions, analysisResults1$testActions, tolerance = 1e-05) expect_equal(analysisResults1CodeBased$repeatedConfidenceIntervalLowerBounds, analysisResults1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(analysisResults1CodeBased$repeatedConfidenceIntervalUpperBounds, analysisResults1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(analysisResults1CodeBased$repeatedPValues, analysisResults1$repeatedPValues, tolerance = 1e-05) expect_type(names(analysisResults1), "character") df <- as.data.frame(analysisResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(analysisResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) rpact/tests/testthat/test-f_core_plot.R0000644000175000017500000000304614154142422020114 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_core_plot.R ## | Creation date: 08 December 2021, 09:08:44 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing .reconstructSequenceCommand") test_that("The output is as exptected", { expect_equal(.reconstructSequenceCommand(seq(-1, 1, 0.02)), "seq(-1, 1, 0.02)") expect_equal(.reconstructSequenceCommand(c()), NA_character_) expect_equal(.reconstructSequenceCommand(c(1)), "1") expect_equal(.reconstructSequenceCommand(c(1, 2)), "c(1, 2)") expect_equal(.reconstructSequenceCommand(c(1, 2, 3)), "c(1, 2, 3)") expect_equal(.reconstructSequenceCommand(c(1, 2, 3, 4)), "seq(1, 4, 1)") expect_equal(.reconstructSequenceCommand(c(1, 2, 3, 5)), "c(1, 2, 3, 5)") expect_true(grepl(.getRexepSaveCharacter("x$.design"), "x$.design")) expect_true(grepl(.getRexepSaveCharacter("x$.design"), "c(x$.design, xxx)")) expect_false(grepl(.getRexepSaveCharacter("x$.design"), "c(x$design, xxx)")) }) rpact/tests/testthat/test-f_simulation_base_means.R0000644000175000017500000045065714154142422022505 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_simulation_base_means.R ## | Creation date: 08 December 2021, 09:09:23 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Simulation Means Function") test_that("'getSimulationMeans': several configurations", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationMeans} # @refFS[Formula]{fs:SimulationOneArmMeansTestStatistics} # @refFS[Formula]{fs:SimulationTwoArmMeansTestStatisticsDiff} # @refFS[Formula]{fs:SimulationTwoArmMeansTestStatisticsRatio} # @refFS[Formula]{fs:testStatisticGroupSequentialWeightedAverage} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} maxNumberOfIterations <- 100 seed <- 99123 options(width = 180) maxNumberOfSubjects <- 90 informationRates <- c(0.2, 0.5, 1) plannedSubjects <- round(informationRates * maxNumberOfSubjects) x1 <- getSimulationMeans(design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = TRUE, thetaH0 = 0.4, plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, allocationRatioPlanned = 3, stDev = 1.5, seed = seed) ## Comparison of the results of SimulationResultsMeans object 'x1' with expected results expect_equal(x1$effect, c(0.6, 0.8, 1, 1.2, 1.4, 1.6), tolerance = 1e-07) expect_equal(x1$iterations[1, ], c(100, 100, 100, 100, 100, 100)) expect_equal(x1$iterations[2, ], c(96, 100, 100, 94, 97, 95)) expect_equal(x1$iterations[3, ], c(72, 68, 37, 16, 2, 2)) expect_equal(x1$overallReject, c(0.81, 0.93, 0.99, 0.99, 1, 1), tolerance = 1e-07) expect_equal(x1$rejectPerStage[1, ], c(0, 0, 0, 0.05, 0.03, 0.05), tolerance = 1e-07) expect_equal(x1$rejectPerStage[2, ], c(0.2, 0.29, 0.62, 0.78, 0.95, 0.93), tolerance = 1e-07) expect_equal(x1$rejectPerStage[3, ], c(0.61, 0.64, 0.37, 0.16, 0.02, 0.02), tolerance = 1e-07) expect_equal(x1$futilityStop, c(0.08, 0.03, 0.01, 0.01, 0, 0), tolerance = 1e-07) expect_equal(x1$futilityPerStage[1, ], c(0.04, 0, 0, 0.01, 0, 0), tolerance = 1e-07) expect_equal(x1$futilityPerStage[2, ], c(0.04, 0.03, 0.01, 0, 0, 0), tolerance = 1e-07) expect_equal(x1$earlyStop, c(0.28, 0.32, 0.63, 0.84, 0.98, 0.98), tolerance = 1e-07) expect_equal(x1$expectedNumberOfSubjects, c(76.32, 75.6, 61.65, 50.58, 45.09, 44.55), tolerance = 1e-07) expect_equal(x1$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18)) expect_equal(x1$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27)) expect_equal(x1$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45)) expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$conditionalPowerAchieved[2, ], c(0.26405311, 0.35839614, 0.48830732, 0.63603264, 0.77682482, 0.82707873), tolerance = 1e-07) expect_equal(x1$conditionalPowerAchieved[3, ], c(0.60511343, 0.74281632, 0.84083206, 0.87094401, 0.89751119, 0.97110806), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$effect, x1$effect, tolerance = 1e-05) expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-05) expect_equal(x1CodeBased$overallReject, x1$overallReject, tolerance = 1e-05) expect_equal(x1CodeBased$rejectPerStage, x1$rejectPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$futilityStop, x1$futilityStop, tolerance = 1e-05) expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-05) expect_equal(x1CodeBased$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x1CodeBased$sampleSizes, x1$sampleSizes, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() x2 <- getSimulationMeans(design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = FALSE, thetaH0 = 0.2, plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, allocationRatioPlanned = 3, stDev = 1.5, seed = seed) ## Comparison of the results of SimulationResultsMeans object 'x2' with expected results expect_equal(x2$effect, c(-0.2, 0, 0.2, 0.4, 0.6, 0.8), tolerance = 1e-07) expect_equal(x2$iterations[1, ], c(100, 100, 100, 100, 100, 100)) expect_equal(x2$iterations[2, ], c(63, 73, 84, 83, 89, 96)) expect_equal(x2$iterations[3, ], c(15, 24, 42, 53, 69, 76)) expect_equal(x2$overallReject, c(0, 0.02, 0.07, 0.18, 0.33, 0.53), tolerance = 1e-07) expect_equal(x2$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0)) expect_equal(x2$rejectPerStage[2, ], c(0, 0, 0.02, 0.03, 0.06, 0.1), tolerance = 1e-07) expect_equal(x2$rejectPerStage[3, ], c(0, 0.02, 0.05, 0.15, 0.27, 0.43), tolerance = 1e-07) expect_equal(x2$futilityStop, c(0.85, 0.76, 0.56, 0.44, 0.25, 0.14), tolerance = 1e-07) expect_equal(x2$futilityPerStage[1, ], c(0.37, 0.27, 0.16, 0.17, 0.11, 0.04), tolerance = 1e-07) expect_equal(x2$futilityPerStage[2, ], c(0.48, 0.49, 0.4, 0.27, 0.14, 0.1), tolerance = 1e-07) expect_equal(x2$earlyStop, c(0.85, 0.76, 0.58, 0.47, 0.31, 0.24), tolerance = 1e-07) expect_equal(x2$expectedNumberOfSubjects, c(41.76, 48.51, 59.58, 64.26, 73.08, 78.12), tolerance = 1e-07) expect_equal(x2$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18)) expect_equal(x2$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27)) expect_equal(x2$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45)) expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x2$conditionalPowerAchieved[2, ], c(0.056595809, 0.082243527, 0.1171868, 0.14183443, 0.20192022, 0.18371302), tolerance = 1e-07) expect_equal(x2$conditionalPowerAchieved[3, ], c(0.36165449, 0.31543938, 0.36771185, 0.4758946, 0.54527876, 0.61204049), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$effect, x2$effect, tolerance = 1e-05) expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-05) expect_equal(x2CodeBased$overallReject, x2$overallReject, tolerance = 1e-05) expect_equal(x2CodeBased$rejectPerStage, x2$rejectPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$futilityStop, x2$futilityStop, tolerance = 1e-05) expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-05) expect_equal(x2CodeBased$expectedNumberOfSubjects, x2$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x3 <- getSimulationMeans(design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 1, thetaH0 = 0.2, plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, stDev = 1.5, seed = seed) ## Comparison of the results of SimulationResultsMeans object 'x3' with expected results expect_equal(x3$effect, c(-0.2, 0, 0.2, 0.4, 0.6, 0.8), tolerance = 1e-07) expect_equal(x3$iterations[1, ], c(100, 100, 100, 100, 100, 100)) expect_equal(x3$iterations[2, ], c(50, 71, 87, 96, 97, 99)) expect_equal(x3$iterations[3, ], c(9, 21, 63, 67, 49, 29)) expect_equal(x3$overallReject, c(0, 0.02, 0.21, 0.59, 0.94, 1), tolerance = 1e-07) expect_equal(x3$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0.01), tolerance = 1e-07) expect_equal(x3$rejectPerStage[2, ], c(0, 0, 0.03, 0.21, 0.47, 0.7), tolerance = 1e-07) expect_equal(x3$rejectPerStage[3, ], c(0, 0.02, 0.18, 0.38, 0.47, 0.29), tolerance = 1e-07) expect_equal(x3$futilityStop, c(0.91, 0.79, 0.34, 0.12, 0.04, 0), tolerance = 1e-07) expect_equal(x3$futilityPerStage[1, ], c(0.5, 0.29, 0.13, 0.04, 0.03, 0), tolerance = 1e-07) expect_equal(x3$futilityPerStage[2, ], c(0.41, 0.5, 0.21, 0.08, 0.01, 0), tolerance = 1e-07) expect_equal(x3$earlyStop, c(0.91, 0.79, 0.37, 0.33, 0.51, 0.71), tolerance = 1e-07) expect_equal(x3$expectedNumberOfSubjects, c(35.55, 46.62, 69.84, 74.07, 66.24, 57.78), tolerance = 1e-07) expect_equal(x3$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18)) expect_equal(x3$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27)) expect_equal(x3$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45)) expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$conditionalPowerAchieved[2, ], c(0.047252355, 0.074094582, 0.18424333, 0.30402818, 0.54078356, 0.67131653), tolerance = 1e-07) expect_equal(x3$conditionalPowerAchieved[3, ], c(0.27249296, 0.30454177, 0.45212728, 0.62638376, 0.84307565, 0.91215549), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$effect, x3$effect, tolerance = 1e-05) expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-05) expect_equal(x3CodeBased$overallReject, x3$overallReject, tolerance = 1e-05) expect_equal(x3CodeBased$rejectPerStage, x3$rejectPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$futilityStop, x3$futilityStop, tolerance = 1e-05) expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-05) expect_equal(x3CodeBased$expectedNumberOfSubjects, x3$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x3CodeBased$sampleSizes, x3$sampleSizes, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x4 <- getSimulationMeans(design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = TRUE, thetaH0 = 1.1, plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, allocationRatioPlanned = 3, stDev = 1.5, directionUpper = FALSE, seed = seed) ## Comparison of the results of SimulationResultsMeans object 'x4' with expected results expect_equal(x4$effect, c(-0.1, 0.1, 0.3, 0.5, 0.7, 0.9), tolerance = 1e-07) expect_equal(x4$iterations[1, ], c(100, 100, 100, 100, 100, 100)) expect_equal(x4$iterations[2, ], c(76, 71, 52, 52, 45, 23)) expect_equal(x4$iterations[3, ], c(31, 27, 10, 12, 3, 3)) expect_equal(x4$overallReject, c(0.01, 0.02, 0, 0, 0, 0), tolerance = 1e-07) expect_equal(x4$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0)) expect_equal(x4$rejectPerStage[2, ], c(0, 0, 0, 0, 0, 0)) expect_equal(x4$rejectPerStage[3, ], c(0.01, 0.02, 0, 0, 0, 0), tolerance = 1e-07) expect_equal(x4$futilityStop, c(0.69, 0.73, 0.9, 0.88, 0.97, 0.97), tolerance = 1e-07) expect_equal(x4$futilityPerStage[1, ], c(0.24, 0.29, 0.48, 0.48, 0.55, 0.77), tolerance = 1e-07) expect_equal(x4$futilityPerStage[2, ], c(0.45, 0.44, 0.42, 0.4, 0.42, 0.2), tolerance = 1e-07) expect_equal(x4$earlyStop, c(0.69, 0.73, 0.9, 0.88, 0.97, 0.97), tolerance = 1e-07) expect_equal(x4$expectedNumberOfSubjects, c(52.47, 49.32, 36.54, 37.44, 31.5, 25.56), tolerance = 1e-07) expect_equal(x4$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18)) expect_equal(x4$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27)) expect_equal(x4$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45)) expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x4$conditionalPowerAchieved[2, ], c(0.088210955, 0.073662665, 0.032364394, 0.040456333, 0.047760081, 0.047799584), tolerance = 1e-07) expect_equal(x4$conditionalPowerAchieved[3, ], c(0.34802745, 0.34204022, 0.18915629, 0.18461746, 0.36492317, 0.12863193), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$effect, x4$effect, tolerance = 1e-05) expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-05) expect_equal(x4CodeBased$overallReject, x4$overallReject, tolerance = 1e-05) expect_equal(x4CodeBased$rejectPerStage, x4$rejectPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$futilityStop, x4$futilityStop, tolerance = 1e-05) expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-05) expect_equal(x4CodeBased$expectedNumberOfSubjects, x4$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x4CodeBased$sampleSizes, x4$sampleSizes, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x5 <- getSimulationMeans(design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = FALSE, thetaH0 = 1.1, plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, allocationRatioPlanned = 3, stDev = 1.5, directionUpper = FALSE, seed = seed) ## Comparison of the results of SimulationResultsMeans object 'x5' with expected results expect_equal(x5$effect, c(-1.1, -0.9, -0.7, -0.5, -0.3, -0.1), tolerance = 1e-07) expect_equal(x5$iterations[1, ], c(100, 100, 100, 100, 100, 100)) expect_equal(x5$iterations[2, ], c(98, 96, 88, 84, 82, 79)) expect_equal(x5$iterations[3, ], c(77, 74, 69, 58, 54, 43)) expect_equal(x5$overallReject, c(0.78, 0.71, 0.51, 0.27, 0.13, 0.04), tolerance = 1e-07) expect_equal(x5$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0)) expect_equal(x5$rejectPerStage[2, ], c(0.19, 0.14, 0.08, 0.06, 0, 0), tolerance = 1e-07) expect_equal(x5$rejectPerStage[3, ], c(0.59, 0.57, 0.43, 0.21, 0.13, 0.04), tolerance = 1e-07) expect_equal(x5$futilityStop, c(0.04, 0.12, 0.23, 0.36, 0.46, 0.57), tolerance = 1e-07) expect_equal(x5$futilityPerStage[1, ], c(0.02, 0.04, 0.12, 0.16, 0.18, 0.21), tolerance = 1e-07) expect_equal(x5$futilityPerStage[2, ], c(0.02, 0.08, 0.11, 0.2, 0.28, 0.36), tolerance = 1e-07) expect_equal(x5$earlyStop, c(0.23, 0.26, 0.31, 0.42, 0.46, 0.57), tolerance = 1e-07) expect_equal(x5$expectedNumberOfSubjects, c(79.11, 77.22, 72.81, 66.78, 64.44, 58.68), tolerance = 1e-07) expect_equal(x5$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18)) expect_equal(x5$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27)) expect_equal(x5$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45)) expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x5$conditionalPowerAchieved[2, ], c(0.33588936, 0.25194744, 0.19824827, 0.19178721, 0.11444971, 0.092566355), tolerance = 1e-07) expect_equal(x5$conditionalPowerAchieved[3, ], c(0.74226501, 0.69902839, 0.55641803, 0.50033698, 0.45636572, 0.33236099), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x5), NA))) expect_output(print(x5)$show()) invisible(capture.output(expect_error(summary(x5), NA))) expect_output(summary(x5)$show()) x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) expect_equal(x5CodeBased$effect, x5$effect, tolerance = 1e-05) expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-05) expect_equal(x5CodeBased$overallReject, x5$overallReject, tolerance = 1e-05) expect_equal(x5CodeBased$rejectPerStage, x5$rejectPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$futilityStop, x5$futilityStop, tolerance = 1e-05) expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-05) expect_equal(x5CodeBased$expectedNumberOfSubjects, x5$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x5CodeBased$sampleSizes, x5$sampleSizes, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x5), "character") df <- as.data.frame(x5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x6 <- getSimulationMeans(design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 1, thetaH0 = 0.8, plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, stDev = 1.5, directionUpper = FALSE, seed = seed) ## Comparison of the results of SimulationResultsMeans object 'x6' with expected results expect_equal(x6$effect, c(-0.8, -0.6, -0.4, -0.2, 0, 0.2), tolerance = 1e-07) expect_equal(x6$iterations[1, ], c(100, 100, 100, 100, 100, 100)) expect_equal(x6$iterations[2, ], c(100, 99, 96, 81, 70, 49)) expect_equal(x6$iterations[3, ], c(22, 43, 75, 57, 27, 7)) expect_equal(x6$overallReject, c(1, 0.96, 0.66, 0.26, 0.02, 0), tolerance = 1e-07) expect_equal(x6$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0)) expect_equal(x6$rejectPerStage[2, ], c(0.78, 0.56, 0.13, 0.05, 0, 0), tolerance = 1e-07) expect_equal(x6$rejectPerStage[3, ], c(0.22, 0.4, 0.53, 0.21, 0.02, 0), tolerance = 1e-07) expect_equal(x6$futilityStop, c(0, 0.01, 0.12, 0.38, 0.73, 0.93), tolerance = 1e-07) expect_equal(x6$futilityPerStage[1, ], c(0, 0.01, 0.04, 0.19, 0.3, 0.51), tolerance = 1e-07) expect_equal(x6$futilityPerStage[2, ], c(0, 0, 0.08, 0.19, 0.43, 0.42), tolerance = 1e-07) expect_equal(x6$earlyStop, c(0.78, 0.57, 0.25, 0.43, 0.73, 0.93), tolerance = 1e-07) expect_equal(x6$expectedNumberOfSubjects, c(54.9, 64.08, 77.67, 65.52, 49.05, 34.38), tolerance = 1e-07) expect_equal(x6$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18)) expect_equal(x6$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27)) expect_equal(x6$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45)) expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x6$conditionalPowerAchieved[2, ], c(0.67267344, 0.52857476, 0.27194206, 0.18361852, 0.064769395, 0.04670856), tolerance = 1e-07) expect_equal(x6$conditionalPowerAchieved[3, ], c(0.81011604, 0.77276452, 0.65795757, 0.50391481, 0.35327029, 0.24591214), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x6), NA))) expect_output(print(x6)$show()) invisible(capture.output(expect_error(summary(x6), NA))) expect_output(summary(x6)$show()) x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) expect_equal(x6CodeBased$effect, x6$effect, tolerance = 1e-05) expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-05) expect_equal(x6CodeBased$overallReject, x6$overallReject, tolerance = 1e-05) expect_equal(x6CodeBased$rejectPerStage, x6$rejectPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$futilityStop, x6$futilityStop, tolerance = 1e-05) expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-05) expect_equal(x6CodeBased$expectedNumberOfSubjects, x6$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x6CodeBased$sampleSizes, x6$sampleSizes, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x6), "character") df <- as.data.frame(x6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x7 <- getSimulationMeans(design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 1, thetaH0 = -0.2, plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, stDev = 3.5, alternative = seq(-1.2,-0.2,0.2), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA,10,10), maxNumberOfSubjectsPerStage = c(NA, 100, 100), directionUpper = FALSE, seed = seed) ## Comparison of the results of SimulationResultsMeans object 'x7' with expected results expect_equal(x7$effect, c(-1, -0.8, -0.6, -0.4, -0.2, 0), tolerance = 1e-07) expect_equal(x7$iterations[1, ], c(100, 100, 100, 100, 100, 100)) expect_equal(x7$iterations[2, ], c(93, 97, 88, 78, 78, 74)) expect_equal(x7$iterations[3, ], c(52, 77, 69, 57, 51, 35)) expect_equal(x7$overallReject, c(0.81, 0.82, 0.59, 0.32, 0.12, 0.03), tolerance = 1e-07) expect_equal(x7$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0)) expect_equal(x7$rejectPerStage[2, ], c(0.4, 0.19, 0.12, 0.07, 0, 0), tolerance = 1e-07) expect_equal(x7$rejectPerStage[3, ], c(0.41, 0.63, 0.47, 0.25, 0.12, 0.03), tolerance = 1e-07) expect_equal(x7$futilityStop, c(0.08, 0.04, 0.19, 0.36, 0.49, 0.65), tolerance = 1e-07) expect_equal(x7$futilityPerStage[1, ], c(0.07, 0.03, 0.12, 0.22, 0.22, 0.26), tolerance = 1e-07) expect_equal(x7$futilityPerStage[2, ], c(0.01, 0.01, 0.07, 0.14, 0.27, 0.39), tolerance = 1e-07) expect_equal(x7$earlyStop, c(0.48, 0.23, 0.31, 0.43, 0.49, 0.65), tolerance = 1e-07) expect_equal(x7$expectedNumberOfSubjects, c(105.75972, 141.87769, 144.85789, 134.64079, 139.03875, 121.42333), tolerance = 1e-07) expect_equal(x7$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18)) expect_equal(x7$sampleSizes[2, ], c(74.918717, 83.151367, 90.734126, 88.517379, 94.605927, 95.502536), tolerance = 1e-07) expect_equal(x7$sampleSizes[3, ], c(34.779445, 56.130993, 68.133125, 83.503922, 92.63947, 93.575595), tolerance = 1e-07) expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x7$conditionalPowerAchieved[2, ], c(0.48960058, 0.35501907, 0.33230293, 0.3239724, 0.20164899, 0.17099815), tolerance = 1e-07) expect_equal(x7$conditionalPowerAchieved[3, ], c(0.75975737, 0.70067902, 0.61722401, 0.51061814, 0.40378864, 0.28388391), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x7), NA))) expect_output(print(x7)$show()) invisible(capture.output(expect_error(summary(x7), NA))) expect_output(summary(x7)$show()) x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) expect_equal(x7CodeBased$effect, x7$effect, tolerance = 1e-05) expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-05) expect_equal(x7CodeBased$overallReject, x7$overallReject, tolerance = 1e-05) expect_equal(x7CodeBased$rejectPerStage, x7$rejectPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$futilityStop, x7$futilityStop, tolerance = 1e-05) expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-05) expect_equal(x7CodeBased$expectedNumberOfSubjects, x7$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x7CodeBased$sampleSizes, x7$sampleSizes, tolerance = 1e-05) expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x7), "character") df <- as.data.frame(x7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x8 <- getSimulationMeans(design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5)), groups = 2, meanRatio = FALSE, thetaH0 = -0.1, plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, allocationRatioPlanned = 3, stDev = 3.5, conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA,10,10), maxNumberOfSubjectsPerStage = c(NA, 100, 100), seed = seed) ## Comparison of the results of SimulationResultsMeans object 'x8' with expected results expect_equal(x8$effect, c(0.1, 0.3, 0.5, 0.7, 0.9, 1.1), tolerance = 1e-07) expect_equal(x8$iterations[1, ], c(100, 100, 100, 100, 100, 100)) expect_equal(x8$iterations[2, ], c(74, 78, 81, 81, 90, 86)) expect_equal(x8$iterations[3, ], c(30, 33, 52, 55, 67, 65)) expect_equal(x8$overallReject, c(0.04, 0.03, 0.09, 0.19, 0.35, 0.32), tolerance = 1e-07) expect_equal(x8$rejectPerStage[1, ], c(0, 0, 0, 0.01, 0, 0), tolerance = 1e-07) expect_equal(x8$rejectPerStage[2, ], c(0.02, 0.01, 0.02, 0.06, 0.1, 0.07), tolerance = 1e-07) expect_equal(x8$rejectPerStage[3, ], c(0.02, 0.02, 0.07, 0.12, 0.25, 0.25), tolerance = 1e-07) expect_equal(x8$futilityStop, c(0.68, 0.66, 0.46, 0.38, 0.23, 0.28), tolerance = 1e-07) expect_equal(x8$futilityPerStage[1, ], c(0.26, 0.22, 0.19, 0.18, 0.1, 0.14), tolerance = 1e-07) expect_equal(x8$futilityPerStage[2, ], c(0.42, 0.44, 0.27, 0.2, 0.13, 0.14), tolerance = 1e-07) expect_equal(x8$earlyStop, c(0.7, 0.67, 0.48, 0.45, 0.33, 0.35), tolerance = 1e-07) expect_equal(x8$expectedNumberOfSubjects, c(111.53284, 119.9607, 137.10925, 136.56279, 151.62676, 145.91552), tolerance = 1e-07) expect_equal(x8$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18)) expect_equal(x8$sampleSizes[2, ], c(89.604753, 93.952606, 89.473054, 86.745314, 84.630171, 89.414885), tolerance = 1e-07) expect_equal(x8$sampleSizes[3, ], c(90.75107, 86.902014, 89.684764, 87.816529, 85.760605, 78.490341), tolerance = 1e-07) expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x8$conditionalPowerAchieved[2, ], c(0.22129636, 0.2212372, 0.27604385, 0.2610371, 0.30108411, 0.26964038), tolerance = 1e-07) expect_equal(x8$conditionalPowerAchieved[3, ], c(0.30043836, 0.34051211, 0.31802231, 0.36816554, 0.50585406, 0.52804861), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x8), NA))) expect_output(print(x8)$show()) invisible(capture.output(expect_error(summary(x8), NA))) expect_output(summary(x8)$show()) x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) expect_equal(x8CodeBased$effect, x8$effect, tolerance = 1e-05) expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-05) expect_equal(x8CodeBased$overallReject, x8$overallReject, tolerance = 1e-05) expect_equal(x8CodeBased$rejectPerStage, x8$rejectPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$futilityStop, x8$futilityStop, tolerance = 1e-05) expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-05) expect_equal(x8CodeBased$expectedNumberOfSubjects, x8$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x8CodeBased$sampleSizes, x8$sampleSizes, tolerance = 1e-05) expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x8), "character") df <- as.data.frame(x8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x9 <- getSimulationMeans(design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5)), groups = 2, meanRatio = TRUE, thetaH0 = 1.6, plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, allocationRatioPlanned = 3, stDev = 1.5, alternative = seq(0.8, 1.6, 0.2), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA,10,10), maxNumberOfSubjectsPerStage = c(NA, 100, 100), directionUpper = FALSE, seed = seed) ## Comparison of the results of SimulationResultsMeans object 'x9' with expected results expect_equal(x9$effect, c(-0.8, -0.6, -0.4, -0.2, 0), tolerance = 1e-07) expect_equal(x9$iterations[1, ], c(100, 100, 100, 100, 100)) expect_equal(x9$iterations[2, ], c(90, 86, 80, 67, 68)) expect_equal(x9$iterations[3, ], c(72, 65, 52, 42, 25)) expect_equal(x9$overallReject, c(0.51, 0.34, 0.18, 0.09, 0.02), tolerance = 1e-07) expect_equal(x9$rejectPerStage[1, ], c(0, 0, 0, 0, 0)) expect_equal(x9$rejectPerStage[2, ], c(0.1, 0.08, 0.06, 0.02, 0.01), tolerance = 1e-07) expect_equal(x9$rejectPerStage[3, ], c(0.41, 0.26, 0.12, 0.07, 0.01), tolerance = 1e-07) expect_equal(x9$futilityStop, c(0.18, 0.27, 0.42, 0.56, 0.74), tolerance = 1e-07) expect_equal(x9$futilityPerStage[1, ], c(0.1, 0.14, 0.2, 0.33, 0.32), tolerance = 1e-07) expect_equal(x9$futilityPerStage[2, ], c(0.08, 0.13, 0.22, 0.23, 0.42), tolerance = 1e-07) expect_equal(x9$earlyStop, c(0.28, 0.35, 0.48, 0.58, 0.75), tolerance = 1e-07) expect_equal(x9$expectedNumberOfSubjects, c(153.43814, 146.72246, 137.97717, 118.25728, 105.3636), tolerance = 1e-07) expect_equal(x9$sampleSizes[1, ], c(18, 18, 18, 18, 18)) expect_equal(x9$sampleSizes[2, ], c(84.396151, 86.486693, 90.951473, 92.934899, 94.926174), tolerance = 1e-07) expect_equal(x9$sampleSizes[3, ], c(82.613334, 83.606008, 90.79999, 90.454524, 91.255188), tolerance = 1e-07) expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x9$conditionalPowerAchieved[2, ], c(0.44090193, 0.35212758, 0.36163755, 0.29178438, 0.19458749), tolerance = 1e-07) expect_equal(x9$conditionalPowerAchieved[3, ], c(0.62623215, 0.54530553, 0.37547827, 0.42766542, 0.36373939), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x9), NA))) expect_output(print(x9)$show()) invisible(capture.output(expect_error(summary(x9), NA))) expect_output(summary(x9)$show()) x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) expect_equal(x9CodeBased$effect, x9$effect, tolerance = 1e-05) expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-05) expect_equal(x9CodeBased$overallReject, x9$overallReject, tolerance = 1e-05) expect_equal(x9CodeBased$rejectPerStage, x9$rejectPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$futilityStop, x9$futilityStop, tolerance = 1e-05) expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-05) expect_equal(x9CodeBased$expectedNumberOfSubjects, x9$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x9CodeBased$sampleSizes, x9$sampleSizes, tolerance = 1e-05) expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x9), "character") df <- as.data.frame(x9) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x9) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } calcSubjectsFunctionSimulationBaseMeans <- function(..., stage, thetaH0, allocationRatioPlanned, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage, sampleSizesPerStage, thetaH1, conditionalPower, conditionalCriticalValue) { mult <- 1 if (stage == 2) { stageSubjects <- (1 + 1/allocationRatioPlanned + thetaH0^2 * (1 + allocationRatioPlanned))* (max(0, conditionalCriticalValue + stats::qnorm(conditionalPower)))^2 * mult / (max(1e-12, thetaH1))^2 stageSubjects <- min(max(minNumberOfSubjectsPerStage[stage], stageSubjects), maxNumberOfSubjectsPerStage[stage]) } else { stageSubjects <- sampleSizesPerStage[stage - 1] } return(stageSubjects) } x10 <- getSimulationMeans(design = getDesignInverseNormal(futilityBounds = c(0.5,0.5)), groups = 2, meanRatio = TRUE, thetaH0 = 1.6, plannedSubjects = c(80, 160, 240), maxNumberOfIterations = maxNumberOfIterations, stDev = 1.5, alternative = seq(0.8, 1.6, 0.2), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA, 40, 40), maxNumberOfSubjectsPerStage = c(NA, 400, 400), allocationRatioPlanned = 3, directionUpper = FALSE, seed = seed, calcSubjectsFunction = calcSubjectsFunctionSimulationBaseMeans) ## Comparison of the results of SimulationResultsMeans object 'x10' with expected results expect_equal(x10$effect, c(-0.8, -0.6, -0.4, -0.2, 0), tolerance = 1e-07) expect_equal(x10$iterations[1, ], c(100, 100, 100, 100, 100)) expect_equal(x10$iterations[2, ], c(80, 73, 59, 46, 29)) expect_equal(x10$iterations[3, ], c(47, 49, 53, 37, 23)) expect_equal(x10$overallReject, c(0.71, 0.59, 0.3, 0.16, 0.03), tolerance = 1e-07) expect_equal(x10$rejectPerStage[1, ], c(0.01, 0, 0, 0, 0), tolerance = 1e-07) expect_equal(x10$rejectPerStage[2, ], c(0.33, 0.24, 0.05, 0.03, 0.02), tolerance = 1e-07) expect_equal(x10$rejectPerStage[3, ], c(0.37, 0.35, 0.25, 0.13, 0.01), tolerance = 1e-07) expect_equal(x10$futilityStop, c(0.19, 0.27, 0.42, 0.6, 0.75), tolerance = 1e-07) expect_equal(x10$futilityPerStage[1, ], c(0.19, 0.27, 0.41, 0.54, 0.71), tolerance = 1e-07) expect_equal(x10$futilityPerStage[2, ], c(0, 0, 0.01, 0.06, 0.04), tolerance = 1e-07) expect_equal(x10$earlyStop, c(0.53, 0.51, 0.47, 0.63, 0.77), tolerance = 1e-07) expect_equal(x10$expectedNumberOfSubjects, c(275.20455, 279.99813, 331.87372, 312.93302, 202.36219), tolerance = 1e-07) expect_equal(x10$sampleSizes[1, ], c(80, 80, 80, 80, 80)) expect_equal(x10$sampleSizes[2, ], c(160.20991, 162.95615, 228.62104, 285.92049, 236.43279), tolerance = 1e-07) expect_equal(x10$sampleSizes[3, ], c(142.63111, 165.38805, 220.73076, 274.07999, 233.89861), tolerance = 1e-07) expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x10$conditionalPowerAchieved[2, ], c(0.61849372, 0.63239423, 0.52503669, 0.48190934, 0.5387573), tolerance = 1e-07) expect_equal(x10$conditionalPowerAchieved[3, ], c(0.77627313, 0.69241344, 0.58084669, 0.41531587, 0.35026151), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x10), NA))) expect_output(print(x10)$show()) invisible(capture.output(expect_error(summary(x10), NA))) expect_output(summary(x10)$show()) x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) expect_equal(x10CodeBased$effect, x10$effect, tolerance = 1e-05) expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-05) expect_equal(x10CodeBased$overallReject, x10$overallReject, tolerance = 1e-05) expect_equal(x10CodeBased$rejectPerStage, x10$rejectPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$futilityStop, x10$futilityStop, tolerance = 1e-05) expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-05) expect_equal(x10CodeBased$expectedNumberOfSubjects, x10$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x10CodeBased$sampleSizes, x10$sampleSizes, tolerance = 1e-05) expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x10), "character") df <- as.data.frame(x10) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x10) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) context("Testing Simulation Means Function in a Systematic Way ") test_that("'getSimulationMeans': Fisher design with several configurations", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationMeans} # @refFS[Formula]{fs:SimulationOneArmMeansTestStatistics} # @refFS[Formula]{fs:SimulationTwoArmMeansTestStatisticsDiff} # @refFS[Formula]{fs:SimulationTwoArmMeansTestStatisticsRatio} # @refFS[Formula]{fs:testStatisticGroupSequentialWeightedAverage} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} x1 <- getSimulationMeans(seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x1' with expected results expect_equal(x1$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x1$iterations[1, ], c(100, 100, 100)) expect_equal(x1$iterations[2, ], c(100, 91, 53)) expect_equal(x1$overallReject, c(0.01, 0.67, 0.93), tolerance = 1e-07) expect_equal(x1$rejectPerStage[1, ], c(0, 0.09, 0.47), tolerance = 1e-07) expect_equal(x1$rejectPerStage[2, ], c(0.01, 0.58, 0.46), tolerance = 1e-07) expect_equal(x1$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x1$earlyStop, c(0, 0.09, 0.47), tolerance = 1e-07) expect_equal(x1$expectedNumberOfSubjects, c(100.13629, 75.286263, 37.754027), tolerance = 1e-07) expect_equal(x1$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x1$sampleSizes[2, ], c(90.136293, 71.743146, 52.366088), tolerance = 1e-07) expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$conditionalPowerAchieved[2, ], c(0.20283076, 0.49941507, 0.64819831), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$effect, x1$effect, tolerance = 1e-05) expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-05) expect_equal(x1CodeBased$overallReject, x1$overallReject, tolerance = 1e-05) expect_equal(x1CodeBased$rejectPerStage, x1$rejectPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-05) expect_equal(x1CodeBased$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x1CodeBased$sampleSizes, x1$sampleSizes, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() x2 <- getSimulationMeans(seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x2' with expected results expect_equal(x2$effect, c(-0.8, -0.4, 0), tolerance = 1e-07) expect_equal(x2$iterations[1, ], c(100, 100, 100)) expect_equal(x2$iterations[2, ], c(38, 94, 97)) expect_equal(x2$overallReject, c(0.96, 0.74, 0.06), tolerance = 1e-07) expect_equal(x2$rejectPerStage[1, ], c(0.62, 0.06, 0.03), tolerance = 1e-07) expect_equal(x2$rejectPerStage[2, ], c(0.34, 0.68, 0.03), tolerance = 1e-07) expect_equal(x2$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x2$earlyStop, c(0.62, 0.06, 0.03), tolerance = 1e-07) expect_equal(x2$expectedNumberOfSubjects, c(25.921375, 81.226383, 97.518855), tolerance = 1e-07) expect_equal(x2$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x2$sampleSizes[2, ], c(41.898355, 75.772748, 90.225624), tolerance = 1e-07) expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$conditionalPowerAchieved[2, ], c(0.66927179, 0.47487279, 0.2338584), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$effect, x2$effect, tolerance = 1e-05) expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-05) expect_equal(x2CodeBased$overallReject, x2$overallReject, tolerance = 1e-05) expect_equal(x2CodeBased$rejectPerStage, x2$rejectPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-05) expect_equal(x2CodeBased$expectedNumberOfSubjects, x2$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x3 <- getSimulationMeans(seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x3' with expected results expect_equal(x3$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x3$iterations[1, ], c(100, 100, 100)) expect_equal(x3$iterations[2, ], c(100, 92, 64)) expect_equal(x3$overallReject, c(0, 0.62, 0.92), tolerance = 1e-07) expect_equal(x3$rejectPerStage[1, ], c(0, 0.08, 0.36), tolerance = 1e-07) expect_equal(x3$rejectPerStage[2, ], c(0, 0.54, 0.56), tolerance = 1e-07) expect_equal(x3$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x3$earlyStop, c(0, 0.08, 0.36), tolerance = 1e-07) expect_equal(x3$expectedNumberOfSubjects, c(101.14709, 82.477228, 37.608934), tolerance = 1e-07) expect_equal(x3$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x3$sampleSizes[2, ], c(91.147091, 78.779596, 43.13896), tolerance = 1e-07) expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$conditionalPowerAchieved[2, ], c(0.15986579, 0.45599322, 0.69664803), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$effect, x3$effect, tolerance = 1e-05) expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-05) expect_equal(x3CodeBased$overallReject, x3$overallReject, tolerance = 1e-05) expect_equal(x3CodeBased$rejectPerStage, x3$rejectPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-05) expect_equal(x3CodeBased$expectedNumberOfSubjects, x3$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x3CodeBased$sampleSizes, x3$sampleSizes, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x4 <- getSimulationMeans(seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x4' with expected results expect_equal(x4$effect, c(-0.8, -0.4, 0), tolerance = 1e-07) expect_equal(x4$iterations[1, ], c(100, 100, 100)) expect_equal(x4$iterations[2, ], c(65, 91, 100)) expect_equal(x4$overallReject, c(0.91, 0.73, 0.01), tolerance = 1e-07) expect_equal(x4$rejectPerStage[1, ], c(0.35, 0.09, 0), tolerance = 1e-07) expect_equal(x4$rejectPerStage[2, ], c(0.56, 0.64, 0.01), tolerance = 1e-07) expect_equal(x4$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x4$earlyStop, c(0.35, 0.09, 0), tolerance = 1e-07) expect_equal(x4$expectedNumberOfSubjects, c(38.729726, 74.553457, 106.20499), tolerance = 1e-07) expect_equal(x4$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x4$sampleSizes[2, ], c(44.199579, 70.937865, 96.204991), tolerance = 1e-07) expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x4$conditionalPowerAchieved[2, ], c(0.65544931, 0.50900228, 0.13524564), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$effect, x4$effect, tolerance = 1e-05) expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-05) expect_equal(x4CodeBased$overallReject, x4$overallReject, tolerance = 1e-05) expect_equal(x4CodeBased$rejectPerStage, x4$rejectPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-05) expect_equal(x4CodeBased$expectedNumberOfSubjects, x4$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x4CodeBased$sampleSizes, x4$sampleSizes, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x5 <- getSimulationMeans(seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x5' with expected results expect_equal(x5$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x5$iterations[1, ], c(100, 100, 100)) expect_equal(x5$iterations[2, ], c(100, 94, 85)) expect_equal(x5$overallReject, c(0.02, 0.3, 0.65), tolerance = 1e-07) expect_equal(x5$rejectPerStage[1, ], c(0, 0.06, 0.15), tolerance = 1e-07) expect_equal(x5$rejectPerStage[2, ], c(0.02, 0.24, 0.5), tolerance = 1e-07) expect_equal(x5$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x5$earlyStop, c(0, 0.06, 0.15), tolerance = 1e-07) expect_equal(x5$expectedNumberOfSubjects, c(99.262844, 92.628587, 72.466684), tolerance = 1e-07) expect_equal(x5$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x5$sampleSizes[2, ], c(89.262844, 87.902752, 73.490217), tolerance = 1e-07) expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x5$conditionalPowerAchieved[2, ], c(0.21679818, 0.32589621, 0.46073426), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x5), NA))) expect_output(print(x5)$show()) invisible(capture.output(expect_error(summary(x5), NA))) expect_output(summary(x5)$show()) x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) expect_equal(x5CodeBased$effect, x5$effect, tolerance = 1e-05) expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-05) expect_equal(x5CodeBased$overallReject, x5$overallReject, tolerance = 1e-05) expect_equal(x5CodeBased$rejectPerStage, x5$rejectPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-05) expect_equal(x5CodeBased$expectedNumberOfSubjects, x5$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x5CodeBased$sampleSizes, x5$sampleSizes, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x5), "character") df <- as.data.frame(x5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x6 <- getSimulationMeans(seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, meanRatio = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x6' with expected results expect_equal(x6$effect, c(-0.8, -0.4, 0), tolerance = 1e-07) expect_equal(x6$iterations[1, ], c(100, 100, 100)) expect_equal(x6$iterations[2, ], c(85, 94, 97)) expect_equal(x6$overallReject, c(0.73, 0.2, 0.05), tolerance = 1e-07) expect_equal(x6$rejectPerStage[1, ], c(0.15, 0.06, 0.03), tolerance = 1e-07) expect_equal(x6$rejectPerStage[2, ], c(0.58, 0.14, 0.02), tolerance = 1e-07) expect_equal(x6$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x6$earlyStop, c(0.15, 0.06, 0.03), tolerance = 1e-07) expect_equal(x6$expectedNumberOfSubjects, c(62.256855, 90.679118, 97.117191), tolerance = 1e-07) expect_equal(x6$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x6$sampleSizes[2, ], c(61.478653, 85.828849, 89.811537), tolerance = 1e-07) expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x6$conditionalPowerAchieved[2, ], c(0.5750772, 0.31560556, 0.25161462), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x6), NA))) expect_output(print(x6)$show()) invisible(capture.output(expect_error(summary(x6), NA))) expect_output(summary(x6)$show()) x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) expect_equal(x6CodeBased$effect, x6$effect, tolerance = 1e-05) expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-05) expect_equal(x6CodeBased$overallReject, x6$overallReject, tolerance = 1e-05) expect_equal(x6CodeBased$rejectPerStage, x6$rejectPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-05) expect_equal(x6CodeBased$expectedNumberOfSubjects, x6$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x6CodeBased$sampleSizes, x6$sampleSizes, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x6), "character") df <- as.data.frame(x6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x7 <- getSimulationMeans(seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x7' with expected results expect_equal(x7$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x7$iterations[1, ], c(100, 100, 100)) expect_equal(x7$iterations[2, ], c(100, 98, 89)) expect_equal(x7$overallReject, c(0, 0.15, 0.75), tolerance = 1e-07) expect_equal(x7$rejectPerStage[1, ], c(0, 0.02, 0.11), tolerance = 1e-07) expect_equal(x7$rejectPerStage[2, ], c(0, 0.13, 0.64), tolerance = 1e-07) expect_equal(x7$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x7$earlyStop, c(0, 0.02, 0.11), tolerance = 1e-07) expect_equal(x7$expectedNumberOfSubjects, c(99.499784, 89.67646, 74.321885), tolerance = 1e-07) expect_equal(x7$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x7$sampleSizes[2, ], c(89.499784, 81.30251, 72.27178), tolerance = 1e-07) expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x7$conditionalPowerAchieved[2, ], c(0.19464679, 0.38425169, 0.50691811), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x7), NA))) expect_output(print(x7)$show()) invisible(capture.output(expect_error(summary(x7), NA))) expect_output(summary(x7)$show()) x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) expect_equal(x7CodeBased$effect, x7$effect, tolerance = 1e-05) expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-05) expect_equal(x7CodeBased$overallReject, x7$overallReject, tolerance = 1e-05) expect_equal(x7CodeBased$rejectPerStage, x7$rejectPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-05) expect_equal(x7CodeBased$expectedNumberOfSubjects, x7$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x7CodeBased$sampleSizes, x7$sampleSizes, tolerance = 1e-05) expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x7), "character") df <- as.data.frame(x7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x8 <- getSimulationMeans(seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x8' with expected results expect_equal(x8$effect, c(-0.7, -0.4, 0), tolerance = 1e-07) expect_equal(x8$iterations[1, ], c(100, 100, 100)) expect_equal(x8$iterations[2, ], c(92, 96, 100)) expect_equal(x8$overallReject, c(0.6, 0.28, 0.01), tolerance = 1e-07) expect_equal(x8$rejectPerStage[1, ], c(0.08, 0.04, 0), tolerance = 1e-07) expect_equal(x8$rejectPerStage[2, ], c(0.52, 0.24, 0.01), tolerance = 1e-07) expect_equal(x8$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x8$earlyStop, c(0.08, 0.04, 0), tolerance = 1e-07) expect_equal(x8$expectedNumberOfSubjects, c(75.059866, 89.365281, 105.96832), tolerance = 1e-07) expect_equal(x8$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x8$sampleSizes[2, ], c(70.717246, 82.672167, 95.968315), tolerance = 1e-07) expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x8$conditionalPowerAchieved[2, ], c(0.47813695, 0.33190551, 0.14267564), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x8), NA))) expect_output(print(x8)$show()) invisible(capture.output(expect_error(summary(x8), NA))) expect_output(summary(x8)$show()) x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) expect_equal(x8CodeBased$effect, x8$effect, tolerance = 1e-05) expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-05) expect_equal(x8CodeBased$overallReject, x8$overallReject, tolerance = 1e-05) expect_equal(x8CodeBased$rejectPerStage, x8$rejectPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-05) expect_equal(x8CodeBased$expectedNumberOfSubjects, x8$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x8CodeBased$sampleSizes, x8$sampleSizes, tolerance = 1e-05) expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x8), "character") df <- as.data.frame(x8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x9 <- getSimulationMeans(seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x9' with expected results expect_equal(x9$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x9$iterations[1, ], c(100, 100, 100)) expect_equal(x9$iterations[2, ], c(99, 94, 80)) expect_equal(x9$overallReject, c(0.06, 0.4, 0.86), tolerance = 1e-07) expect_equal(x9$rejectPerStage[1, ], c(0.01, 0.06, 0.2), tolerance = 1e-07) expect_equal(x9$rejectPerStage[2, ], c(0.05, 0.34, 0.66), tolerance = 1e-07) expect_equal(x9$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x9$earlyStop, c(0.01, 0.06, 0.2), tolerance = 1e-07) expect_equal(x9$expectedNumberOfSubjects, c(96.293417, 87.052198, 59.545442), tolerance = 1e-07) expect_equal(x9$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x9$sampleSizes[2, ], c(87.165067, 81.970424, 61.931803), tolerance = 1e-07) expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x9$conditionalPowerAchieved[2, ], c(0.23503536, 0.37772778, 0.53734864), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x9), NA))) expect_output(print(x9)$show()) invisible(capture.output(expect_error(summary(x9), NA))) expect_output(summary(x9)$show()) x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) expect_equal(x9CodeBased$effect, x9$effect, tolerance = 1e-05) expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-05) expect_equal(x9CodeBased$overallReject, x9$overallReject, tolerance = 1e-05) expect_equal(x9CodeBased$rejectPerStage, x9$rejectPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-05) expect_equal(x9CodeBased$expectedNumberOfSubjects, x9$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x9CodeBased$sampleSizes, x9$sampleSizes, tolerance = 1e-05) expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x9), "character") df <- as.data.frame(x9) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x9) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x10 <- getSimulationMeans(seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x10' with expected results expect_equal(x10$effect, c(-0.7, -0.4, 0), tolerance = 1e-07) expect_equal(x10$iterations[1, ], c(100, 100, 100)) expect_equal(x10$iterations[2, ], c(89, 93, 98)) expect_equal(x10$overallReject, c(0.66, 0.31, 0.04), tolerance = 1e-07) expect_equal(x10$rejectPerStage[1, ], c(0.11, 0.07, 0.02), tolerance = 1e-07) expect_equal(x10$rejectPerStage[2, ], c(0.55, 0.24, 0.02), tolerance = 1e-07) expect_equal(x10$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x10$earlyStop, c(0.11, 0.07, 0.02), tolerance = 1e-07) expect_equal(x10$expectedNumberOfSubjects, c(64.458245, 88.745903, 98.117191), tolerance = 1e-07) expect_equal(x10$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x10$sampleSizes[2, ], c(61.189039, 84.673014, 89.915501), tolerance = 1e-07) expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x10$conditionalPowerAchieved[2, ], c(0.53544626, 0.3174792, 0.23558604), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x10), NA))) expect_output(print(x10)$show()) invisible(capture.output(expect_error(summary(x10), NA))) expect_output(summary(x10)$show()) x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) expect_equal(x10CodeBased$effect, x10$effect, tolerance = 1e-05) expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-05) expect_equal(x10CodeBased$overallReject, x10$overallReject, tolerance = 1e-05) expect_equal(x10CodeBased$rejectPerStage, x10$rejectPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-05) expect_equal(x10CodeBased$expectedNumberOfSubjects, x10$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x10CodeBased$sampleSizes, x10$sampleSizes, tolerance = 1e-05) expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x10), "character") df <- as.data.frame(x10) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x10) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x11 <- getSimulationMeans(seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x11' with expected results expect_equal(x11$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x11$iterations[1, ], c(100, 100, 100)) expect_equal(x11$iterations[2, ], c(98, 96, 79)) expect_equal(x11$overallReject, c(0.03, 0.32, 0.77), tolerance = 1e-07) expect_equal(x11$rejectPerStage[1, ], c(0.02, 0.04, 0.21), tolerance = 1e-07) expect_equal(x11$rejectPerStage[2, ], c(0.01, 0.28, 0.56), tolerance = 1e-07) expect_equal(x11$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x11$earlyStop, c(0.02, 0.04, 0.21), tolerance = 1e-07) expect_equal(x11$expectedNumberOfSubjects, c(96.685833, 88.962444, 54.461927), tolerance = 1e-07) expect_equal(x11$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x11$sampleSizes[2, ], c(88.454932, 82.252546, 56.28092), tolerance = 1e-07) expect_equal(x11$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x11$conditionalPowerAchieved[2, ], c(0.21899188, 0.34972634, 0.63085287), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x11), NA))) expect_output(print(x11)$show()) invisible(capture.output(expect_error(summary(x11), NA))) expect_output(summary(x11)$show()) x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) expect_equal(x11CodeBased$effect, x11$effect, tolerance = 1e-05) expect_equal(x11CodeBased$iterations, x11$iterations, tolerance = 1e-05) expect_equal(x11CodeBased$overallReject, x11$overallReject, tolerance = 1e-05) expect_equal(x11CodeBased$rejectPerStage, x11$rejectPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$futilityPerStage, x11$futilityPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$earlyStop, x11$earlyStop, tolerance = 1e-05) expect_equal(x11CodeBased$expectedNumberOfSubjects, x11$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x11CodeBased$sampleSizes, x11$sampleSizes, tolerance = 1e-05) expect_equal(x11CodeBased$conditionalPowerAchieved, x11$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x11), "character") df <- as.data.frame(x11) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x11) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x12 <- getSimulationMeans(seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x12' with expected results expect_equal(x12$effect, c(-0.7, -0.4, 0), tolerance = 1e-07) expect_equal(x12$iterations[1, ], c(100, 100, 100)) expect_equal(x12$iterations[2, ], c(92, 96, 100)) expect_equal(x12$overallReject, c(0.6, 0.28, 0.01), tolerance = 1e-07) expect_equal(x12$rejectPerStage[1, ], c(0.08, 0.04, 0), tolerance = 1e-07) expect_equal(x12$rejectPerStage[2, ], c(0.52, 0.24, 0.01), tolerance = 1e-07) expect_equal(x12$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x12$earlyStop, c(0.08, 0.04, 0), tolerance = 1e-07) expect_equal(x12$expectedNumberOfSubjects, c(75.059866, 89.365281, 105.96832), tolerance = 1e-07) expect_equal(x12$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x12$sampleSizes[2, ], c(70.717246, 82.672167, 95.968315), tolerance = 1e-07) expect_equal(x12$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x12$conditionalPowerAchieved[2, ], c(0.47813695, 0.33190551, 0.14267564), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x12), NA))) expect_output(print(x12)$show()) invisible(capture.output(expect_error(summary(x12), NA))) expect_output(summary(x12)$show()) x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) expect_equal(x12CodeBased$effect, x12$effect, tolerance = 1e-05) expect_equal(x12CodeBased$iterations, x12$iterations, tolerance = 1e-05) expect_equal(x12CodeBased$overallReject, x12$overallReject, tolerance = 1e-05) expect_equal(x12CodeBased$rejectPerStage, x12$rejectPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$futilityPerStage, x12$futilityPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$earlyStop, x12$earlyStop, tolerance = 1e-05) expect_equal(x12CodeBased$expectedNumberOfSubjects, x12$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x12CodeBased$sampleSizes, x12$sampleSizes, tolerance = 1e-05) expect_equal(x12CodeBased$conditionalPowerAchieved, x12$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x12), "character") df <- as.data.frame(x12) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x12) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationMeans': inverse normal design with several configurations", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationMeans} # @refFS[Formula]{fs:SimulationOneArmMeansTestStatistics} # @refFS[Formula]{fs:SimulationTwoArmMeansTestStatisticsDiff} # @refFS[Formula]{fs:SimulationTwoArmMeansTestStatisticsRatio} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} x1 <- getSimulationMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x1' with expected results expect_equal(x1$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x1$iterations[1, ], c(100, 100, 100)) expect_equal(x1$iterations[2, ], c(100, 99, 93)) expect_equal(x1$overallReject, c(0.01, 0.62, 0.84), tolerance = 1e-07) expect_equal(x1$rejectPerStage[1, ], c(0, 0.01, 0.07), tolerance = 1e-07) expect_equal(x1$rejectPerStage[2, ], c(0.01, 0.61, 0.77), tolerance = 1e-07) expect_equal(x1$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x1$earlyStop, c(0, 0.01, 0.07), tolerance = 1e-07) expect_equal(x1$expectedNumberOfSubjects, c(97.726214, 61.386317, 35.456429), tolerance = 1e-07) expect_equal(x1$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x1$sampleSizes[2, ], c(87.726214, 51.905371, 27.372504), tolerance = 1e-07) expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$conditionalPowerAchieved[2, ], c(0.21948944, 0.59945542, 0.74761937), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$effect, x1$effect, tolerance = 1e-05) expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-05) expect_equal(x1CodeBased$overallReject, x1$overallReject, tolerance = 1e-05) expect_equal(x1CodeBased$rejectPerStage, x1$rejectPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-05) expect_equal(x1CodeBased$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x1CodeBased$sampleSizes, x1$sampleSizes, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() x2 <- getSimulationMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x2' with expected results expect_equal(x2$effect, c(-0.8, -0.4, 0), tolerance = 1e-07) expect_equal(x2$iterations[1, ], c(100, 100, 100)) expect_equal(x2$iterations[2, ], c(92, 98, 100)) expect_equal(x2$overallReject, c(0.88, 0.7, 0.05), tolerance = 1e-07) expect_equal(x2$rejectPerStage[1, ], c(0.08, 0.02, 0), tolerance = 1e-07) expect_equal(x2$rejectPerStage[2, ], c(0.8, 0.68, 0.05), tolerance = 1e-07) expect_equal(x2$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x2$earlyStop, c(0.08, 0.02, 0), tolerance = 1e-07) expect_equal(x2$expectedNumberOfSubjects, c(30.529806, 74.585778, 94.761842), tolerance = 1e-07) expect_equal(x2$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x2$sampleSizes[2, ], c(22.315007, 65.903855, 84.761842), tolerance = 1e-07) expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$conditionalPowerAchieved[2, ], c(0.78002751, 0.51035441, 0.27866093), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$effect, x2$effect, tolerance = 1e-05) expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-05) expect_equal(x2CodeBased$overallReject, x2$overallReject, tolerance = 1e-05) expect_equal(x2CodeBased$rejectPerStage, x2$rejectPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-05) expect_equal(x2CodeBased$expectedNumberOfSubjects, x2$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x3 <- getSimulationMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x3' with expected results expect_equal(x3$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x3$iterations[1, ], c(100, 100, 100)) expect_equal(x3$iterations[2, ], c(100, 100, 98)) expect_equal(x3$overallReject, c(0.01, 0.58, 0.86), tolerance = 1e-07) expect_equal(x3$rejectPerStage[1, ], c(0, 0, 0.02), tolerance = 1e-07) expect_equal(x3$rejectPerStage[2, ], c(0.01, 0.58, 0.84), tolerance = 1e-07) expect_equal(x3$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x3$earlyStop, c(0, 0, 0.02), tolerance = 1e-07) expect_equal(x3$expectedNumberOfSubjects, c(99.571933, 69.623473, 35.859349), tolerance = 1e-07) expect_equal(x3$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x3$sampleSizes[2, ], c(89.571933, 59.623473, 26.38709), tolerance = 1e-07) expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$conditionalPowerAchieved[2, ], c(0.17531256, 0.54483038, 0.79325539), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$effect, x3$effect, tolerance = 1e-05) expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-05) expect_equal(x3CodeBased$overallReject, x3$overallReject, tolerance = 1e-05) expect_equal(x3CodeBased$rejectPerStage, x3$rejectPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-05) expect_equal(x3CodeBased$expectedNumberOfSubjects, x3$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x3CodeBased$sampleSizes, x3$sampleSizes, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x4 <- getSimulationMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x4' with expected results expect_equal(x4$effect, c(-0.8, -0.4, 0), tolerance = 1e-07) expect_equal(x4$iterations[1, ], c(100, 100, 100)) expect_equal(x4$iterations[2, ], c(97, 100, 100)) expect_equal(x4$overallReject, c(0.83, 0.69, 0.01), tolerance = 1e-07) expect_equal(x4$rejectPerStage[1, ], c(0.03, 0, 0), tolerance = 1e-07) expect_equal(x4$rejectPerStage[2, ], c(0.8, 0.69, 0.01), tolerance = 1e-07) expect_equal(x4$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x4$earlyStop, c(0.03, 0, 0), tolerance = 1e-07) expect_equal(x4$expectedNumberOfSubjects, c(34.808208, 66.656932, 104.30185), tolerance = 1e-07) expect_equal(x4$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x4$sampleSizes[2, ], c(25.575472, 56.656932, 94.301853), tolerance = 1e-07) expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x4$conditionalPowerAchieved[2, ], c(0.78184392, 0.58902983, 0.17869551), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$effect, x4$effect, tolerance = 1e-05) expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-05) expect_equal(x4CodeBased$overallReject, x4$overallReject, tolerance = 1e-05) expect_equal(x4CodeBased$rejectPerStage, x4$rejectPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-05) expect_equal(x4CodeBased$expectedNumberOfSubjects, x4$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x4CodeBased$sampleSizes, x4$sampleSizes, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x5 <- getSimulationMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x5' with expected results expect_equal(x5$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x5$iterations[1, ], c(100, 100, 100)) expect_equal(x5$iterations[2, ], c(100, 100, 100)) expect_equal(x5$overallReject, c(0.02, 0.29, 0.63), tolerance = 1e-07) expect_equal(x5$rejectPerStage[1, ], c(0, 0, 0)) expect_equal(x5$rejectPerStage[2, ], c(0.02, 0.29, 0.63), tolerance = 1e-07) expect_equal(x5$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x5$earlyStop, c(0, 0, 0)) expect_equal(x5$expectedNumberOfSubjects, c(96.372889, 89.619156, 71.907268), tolerance = 1e-07) expect_equal(x5$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x5$sampleSizes[2, ], c(86.372889, 79.619156, 61.907268), tolerance = 1e-07) expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x5$conditionalPowerAchieved[2, ], c(0.23254121, 0.37156759, 0.50696796), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x5), NA))) expect_output(print(x5)$show()) invisible(capture.output(expect_error(summary(x5), NA))) expect_output(summary(x5)$show()) x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) expect_equal(x5CodeBased$effect, x5$effect, tolerance = 1e-05) expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-05) expect_equal(x5CodeBased$overallReject, x5$overallReject, tolerance = 1e-05) expect_equal(x5CodeBased$rejectPerStage, x5$rejectPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-05) expect_equal(x5CodeBased$expectedNumberOfSubjects, x5$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x5CodeBased$sampleSizes, x5$sampleSizes, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x5), "character") df <- as.data.frame(x5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x6 <- getSimulationMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, meanRatio = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x6' with expected results expect_equal(x6$effect, c(-0.8, -0.4, 0), tolerance = 1e-07) expect_equal(x6$iterations[1, ], c(100, 100, 100)) expect_equal(x6$iterations[2, ], c(98, 98, 100)) expect_equal(x6$overallReject, c(0.71, 0.28, 0.05), tolerance = 1e-07) expect_equal(x6$rejectPerStage[1, ], c(0.02, 0.02, 0), tolerance = 1e-07) expect_equal(x6$rejectPerStage[2, ], c(0.69, 0.26, 0.05), tolerance = 1e-07) expect_equal(x6$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x6$earlyStop, c(0.02, 0.02, 0), tolerance = 1e-07) expect_equal(x6$expectedNumberOfSubjects, c(61.262488, 89.754099, 94.761842), tolerance = 1e-07) expect_equal(x6$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x6$sampleSizes[2, ], c(52.308661, 81.381734, 84.761842), tolerance = 1e-07) expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x6$conditionalPowerAchieved[2, ], c(0.57015973, 0.32347024, 0.27139992), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x6), NA))) expect_output(print(x6)$show()) invisible(capture.output(expect_error(summary(x6), NA))) expect_output(summary(x6)$show()) x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) expect_equal(x6CodeBased$effect, x6$effect, tolerance = 1e-05) expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-05) expect_equal(x6CodeBased$overallReject, x6$overallReject, tolerance = 1e-05) expect_equal(x6CodeBased$rejectPerStage, x6$rejectPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-05) expect_equal(x6CodeBased$expectedNumberOfSubjects, x6$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x6CodeBased$sampleSizes, x6$sampleSizes, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x6), "character") df <- as.data.frame(x6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x7 <- getSimulationMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x7' with expected results expect_equal(x7$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x7$iterations[1, ], c(100, 100, 100)) expect_equal(x7$iterations[2, ], c(100, 100, 99)) expect_equal(x7$overallReject, c(0.01, 0.2, 0.7), tolerance = 1e-07) expect_equal(x7$rejectPerStage[1, ], c(0, 0, 0.01), tolerance = 1e-07) expect_equal(x7$rejectPerStage[2, ], c(0.01, 0.2, 0.69), tolerance = 1e-07) expect_equal(x7$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x7$earlyStop, c(0, 0, 0.01), tolerance = 1e-07) expect_equal(x7$expectedNumberOfSubjects, c(99.874349, 85.385224, 62.337209), tolerance = 1e-07) expect_equal(x7$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x7$sampleSizes[2, ], c(89.874349, 75.385224, 52.865867), tolerance = 1e-07) expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x7$conditionalPowerAchieved[2, ], c(0.19979349, 0.40152955, 0.59344307), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x7), NA))) expect_output(print(x7)$show()) invisible(capture.output(expect_error(summary(x7), NA))) expect_output(summary(x7)$show()) x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) expect_equal(x7CodeBased$effect, x7$effect, tolerance = 1e-05) expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-05) expect_equal(x7CodeBased$overallReject, x7$overallReject, tolerance = 1e-05) expect_equal(x7CodeBased$rejectPerStage, x7$rejectPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-05) expect_equal(x7CodeBased$expectedNumberOfSubjects, x7$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x7CodeBased$sampleSizes, x7$sampleSizes, tolerance = 1e-05) expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x7), "character") df <- as.data.frame(x7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x8 <- getSimulationMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x8' with expected results expect_equal(x8$effect, c(-0.7, -0.4, 0), tolerance = 1e-07) expect_equal(x8$iterations[1, ], c(100, 100, 100)) expect_equal(x8$iterations[2, ], c(99, 100, 100)) expect_equal(x8$overallReject, c(0.57, 0.35, 0.01), tolerance = 1e-07) expect_equal(x8$rejectPerStage[1, ], c(0.01, 0, 0), tolerance = 1e-07) expect_equal(x8$rejectPerStage[2, ], c(0.56, 0.35, 0.01), tolerance = 1e-07) expect_equal(x8$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x8$earlyStop, c(0.01, 0, 0), tolerance = 1e-07) expect_equal(x8$expectedNumberOfSubjects, c(65.632546, 86.865451, 105.50507), tolerance = 1e-07) expect_equal(x8$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x8$sampleSizes[2, ], c(56.194491, 76.865451, 95.50507), tolerance = 1e-07) expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x8$conditionalPowerAchieved[2, ], c(0.52087291, 0.38731069, 0.15906003), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x8), NA))) expect_output(print(x8)$show()) invisible(capture.output(expect_error(summary(x8), NA))) expect_output(summary(x8)$show()) x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) expect_equal(x8CodeBased$effect, x8$effect, tolerance = 1e-05) expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-05) expect_equal(x8CodeBased$overallReject, x8$overallReject, tolerance = 1e-05) expect_equal(x8CodeBased$rejectPerStage, x8$rejectPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-05) expect_equal(x8CodeBased$expectedNumberOfSubjects, x8$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x8CodeBased$sampleSizes, x8$sampleSizes, tolerance = 1e-05) expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x8), "character") df <- as.data.frame(x8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x9 <- getSimulationMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x9' with expected results expect_equal(x9$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x9$iterations[1, ], c(100, 100, 100)) expect_equal(x9$iterations[2, ], c(100, 99, 98)) expect_equal(x9$overallReject, c(0.04, 0.36, 0.79), tolerance = 1e-07) expect_equal(x9$rejectPerStage[1, ], c(0, 0.01, 0.02), tolerance = 1e-07) expect_equal(x9$rejectPerStage[2, ], c(0.04, 0.35, 0.77), tolerance = 1e-07) expect_equal(x9$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x9$earlyStop, c(0, 0.01, 0.02), tolerance = 1e-07) expect_equal(x9$expectedNumberOfSubjects, c(93.166381, 72.993336, 56.443486), tolerance = 1e-07) expect_equal(x9$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x9$sampleSizes[2, ], c(83.166381, 63.629633, 47.391312), tolerance = 1e-07) expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x9$conditionalPowerAchieved[2, ], c(0.26023971, 0.52016331, 0.61018937), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x9), NA))) expect_output(print(x9)$show()) invisible(capture.output(expect_error(summary(x9), NA))) expect_output(summary(x9)$show()) x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) expect_equal(x9CodeBased$effect, x9$effect, tolerance = 1e-05) expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-05) expect_equal(x9CodeBased$overallReject, x9$overallReject, tolerance = 1e-05) expect_equal(x9CodeBased$rejectPerStage, x9$rejectPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-05) expect_equal(x9CodeBased$expectedNumberOfSubjects, x9$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x9CodeBased$sampleSizes, x9$sampleSizes, tolerance = 1e-05) expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x9), "character") df <- as.data.frame(x9) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x9) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x10 <- getSimulationMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x10' with expected results expect_equal(x10$effect, c(-0.7, -0.4, 0), tolerance = 1e-07) expect_equal(x10$iterations[1, ], c(100, 100, 100)) expect_equal(x10$iterations[2, ], c(98, 98, 100)) expect_equal(x10$overallReject, c(0.71, 0.32, 0.05), tolerance = 1e-07) expect_equal(x10$rejectPerStage[1, ], c(0.02, 0.02, 0), tolerance = 1e-07) expect_equal(x10$rejectPerStage[2, ], c(0.69, 0.3, 0.05), tolerance = 1e-07) expect_equal(x10$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x10$earlyStop, c(0.02, 0.02, 0), tolerance = 1e-07) expect_equal(x10$expectedNumberOfSubjects, c(62.435526, 88.169977, 94.761842), tolerance = 1e-07) expect_equal(x10$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x10$sampleSizes[2, ], c(53.505639, 79.765282, 84.761842), tolerance = 1e-07) expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x10$conditionalPowerAchieved[2, ], c(0.54108822, 0.32455187, 0.25936079), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x10), NA))) expect_output(print(x10)$show()) invisible(capture.output(expect_error(summary(x10), NA))) expect_output(summary(x10)$show()) x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) expect_equal(x10CodeBased$effect, x10$effect, tolerance = 1e-05) expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-05) expect_equal(x10CodeBased$overallReject, x10$overallReject, tolerance = 1e-05) expect_equal(x10CodeBased$rejectPerStage, x10$rejectPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-05) expect_equal(x10CodeBased$expectedNumberOfSubjects, x10$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x10CodeBased$sampleSizes, x10$sampleSizes, tolerance = 1e-05) expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x10), "character") df <- as.data.frame(x10) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x10) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x11 <- getSimulationMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x11' with expected results expect_equal(x11$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x11$iterations[1, ], c(100, 100, 100)) expect_equal(x11$iterations[2, ], c(100, 100, 98)) expect_equal(x11$overallReject, c(0.04, 0.33, 0.76), tolerance = 1e-07) expect_equal(x11$rejectPerStage[1, ], c(0, 0, 0.02), tolerance = 1e-07) expect_equal(x11$rejectPerStage[2, ], c(0.04, 0.33, 0.74), tolerance = 1e-07) expect_equal(x11$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x11$earlyStop, c(0, 0, 0.02), tolerance = 1e-07) expect_equal(x11$expectedNumberOfSubjects, c(97.820553, 79.30135, 45.942964), tolerance = 1e-07) expect_equal(x11$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x11$sampleSizes[2, ], c(87.820553, 69.30135, 36.676494), tolerance = 1e-07) expect_equal(x11$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x11$conditionalPowerAchieved[2, ], c(0.24110629, 0.45389272, 0.70091861), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x11), NA))) expect_output(print(x11)$show()) invisible(capture.output(expect_error(summary(x11), NA))) expect_output(summary(x11)$show()) x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) expect_equal(x11CodeBased$effect, x11$effect, tolerance = 1e-05) expect_equal(x11CodeBased$iterations, x11$iterations, tolerance = 1e-05) expect_equal(x11CodeBased$overallReject, x11$overallReject, tolerance = 1e-05) expect_equal(x11CodeBased$rejectPerStage, x11$rejectPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$futilityPerStage, x11$futilityPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$earlyStop, x11$earlyStop, tolerance = 1e-05) expect_equal(x11CodeBased$expectedNumberOfSubjects, x11$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x11CodeBased$sampleSizes, x11$sampleSizes, tolerance = 1e-05) expect_equal(x11CodeBased$conditionalPowerAchieved, x11$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x11), "character") df <- as.data.frame(x11) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x11) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x12 <- getSimulationMeans(seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x12' with expected results expect_equal(x12$effect, c(-0.7, -0.4, 0), tolerance = 1e-07) expect_equal(x12$iterations[1, ], c(100, 100, 100)) expect_equal(x12$iterations[2, ], c(99, 100, 100)) expect_equal(x12$overallReject, c(0.57, 0.35, 0.01), tolerance = 1e-07) expect_equal(x12$rejectPerStage[1, ], c(0.01, 0, 0), tolerance = 1e-07) expect_equal(x12$rejectPerStage[2, ], c(0.56, 0.35, 0.01), tolerance = 1e-07) expect_equal(x12$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x12$earlyStop, c(0.01, 0, 0), tolerance = 1e-07) expect_equal(x12$expectedNumberOfSubjects, c(65.632546, 86.865451, 105.50507), tolerance = 1e-07) expect_equal(x12$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x12$sampleSizes[2, ], c(56.194491, 76.865451, 95.50507), tolerance = 1e-07) expect_equal(x12$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x12$conditionalPowerAchieved[2, ], c(0.52087291, 0.38731069, 0.15906003), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x12), NA))) expect_output(print(x12)$show()) invisible(capture.output(expect_error(summary(x12), NA))) expect_output(summary(x12)$show()) x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) expect_equal(x12CodeBased$effect, x12$effect, tolerance = 1e-05) expect_equal(x12CodeBased$iterations, x12$iterations, tolerance = 1e-05) expect_equal(x12CodeBased$overallReject, x12$overallReject, tolerance = 1e-05) expect_equal(x12CodeBased$rejectPerStage, x12$rejectPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$futilityPerStage, x12$futilityPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$earlyStop, x12$earlyStop, tolerance = 1e-05) expect_equal(x12CodeBased$expectedNumberOfSubjects, x12$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x12CodeBased$sampleSizes, x12$sampleSizes, tolerance = 1e-05) expect_equal(x12CodeBased$conditionalPowerAchieved, x12$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x12), "character") df <- as.data.frame(x12) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x12) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationMeans': group sequential design with several configurations", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationMeans} # @refFS[Formula]{fs:SimulationOneArmMeansTestStatistics} # @refFS[Formula]{fs:SimulationTwoArmMeansTestStatisticsDiff} # @refFS[Formula]{fs:SimulationTwoArmMeansTestStatisticsRatio} # @refFS[Formula]{fs:testStatisticGroupSequentialWeightedAverage} x1 <- getSimulationMeans(seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x1' with expected results expect_equal(x1$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x1$iterations[1, ], c(100, 100, 100)) expect_equal(x1$iterations[2, ], c(100, 99, 93)) expect_equal(x1$overallReject, c(0.02, 0.71, 0.93), tolerance = 1e-07) expect_equal(x1$rejectPerStage[1, ], c(0, 0.01, 0.07), tolerance = 1e-07) expect_equal(x1$rejectPerStage[2, ], c(0.02, 0.7, 0.86), tolerance = 1e-07) expect_equal(x1$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x1$earlyStop, c(0, 0.01, 0.07), tolerance = 1e-07) expect_equal(x1$expectedNumberOfSubjects, c(97.726214, 61.386317, 35.456429), tolerance = 1e-07) expect_equal(x1$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x1$sampleSizes[2, ], c(87.726214, 51.905371, 27.372504), tolerance = 1e-07) expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$conditionalPowerAchieved[2, ], c(0.21948944, 0.59945542, 0.74761937), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$effect, x1$effect, tolerance = 1e-05) expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-05) expect_equal(x1CodeBased$overallReject, x1$overallReject, tolerance = 1e-05) expect_equal(x1CodeBased$rejectPerStage, x1$rejectPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-05) expect_equal(x1CodeBased$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x1CodeBased$sampleSizes, x1$sampleSizes, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() x2 <- getSimulationMeans(seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x2' with expected results expect_equal(x2$effect, c(-0.8, -0.4, 0), tolerance = 1e-07) expect_equal(x2$iterations[1, ], c(100, 100, 100)) expect_equal(x2$iterations[2, ], c(92, 98, 100)) expect_equal(x2$overallReject, c(0.94, 0.81, 0.07), tolerance = 1e-07) expect_equal(x2$rejectPerStage[1, ], c(0.08, 0.02, 0), tolerance = 1e-07) expect_equal(x2$rejectPerStage[2, ], c(0.86, 0.79, 0.07), tolerance = 1e-07) expect_equal(x2$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x2$earlyStop, c(0.08, 0.02, 0), tolerance = 1e-07) expect_equal(x2$expectedNumberOfSubjects, c(30.529806, 74.585778, 94.761842), tolerance = 1e-07) expect_equal(x2$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x2$sampleSizes[2, ], c(22.315007, 65.903855, 84.761842), tolerance = 1e-07) expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$conditionalPowerAchieved[2, ], c(0.78002751, 0.51035441, 0.27866093), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$effect, x2$effect, tolerance = 1e-05) expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-05) expect_equal(x2CodeBased$overallReject, x2$overallReject, tolerance = 1e-05) expect_equal(x2CodeBased$rejectPerStage, x2$rejectPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-05) expect_equal(x2CodeBased$expectedNumberOfSubjects, x2$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x3 <- getSimulationMeans(seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x3' with expected results expect_equal(x3$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x3$iterations[1, ], c(100, 100, 100)) expect_equal(x3$iterations[2, ], c(100, 100, 98)) expect_equal(x3$overallReject, c(0.01, 0.68, 0.94), tolerance = 1e-07) expect_equal(x3$rejectPerStage[1, ], c(0, 0, 0.02), tolerance = 1e-07) expect_equal(x3$rejectPerStage[2, ], c(0.01, 0.68, 0.92), tolerance = 1e-07) expect_equal(x3$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x3$earlyStop, c(0, 0, 0.02), tolerance = 1e-07) expect_equal(x3$expectedNumberOfSubjects, c(99.571933, 69.623473, 35.859349), tolerance = 1e-07) expect_equal(x3$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x3$sampleSizes[2, ], c(89.571933, 59.623473, 26.38709), tolerance = 1e-07) expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$conditionalPowerAchieved[2, ], c(0.17531256, 0.54483038, 0.79325539), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$effect, x3$effect, tolerance = 1e-05) expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-05) expect_equal(x3CodeBased$overallReject, x3$overallReject, tolerance = 1e-05) expect_equal(x3CodeBased$rejectPerStage, x3$rejectPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-05) expect_equal(x3CodeBased$expectedNumberOfSubjects, x3$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x3CodeBased$sampleSizes, x3$sampleSizes, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x4 <- getSimulationMeans(seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x4' with expected results expect_equal(x4$effect, c(-0.8, -0.4, 0), tolerance = 1e-07) expect_equal(x4$iterations[1, ], c(100, 100, 100)) expect_equal(x4$iterations[2, ], c(97, 100, 100)) expect_equal(x4$overallReject, c(0.92, 0.78, 0.02), tolerance = 1e-07) expect_equal(x4$rejectPerStage[1, ], c(0.03, 0, 0), tolerance = 1e-07) expect_equal(x4$rejectPerStage[2, ], c(0.89, 0.78, 0.02), tolerance = 1e-07) expect_equal(x4$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x4$earlyStop, c(0.03, 0, 0), tolerance = 1e-07) expect_equal(x4$expectedNumberOfSubjects, c(34.808208, 66.656932, 104.30185), tolerance = 1e-07) expect_equal(x4$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x4$sampleSizes[2, ], c(25.575472, 56.656932, 94.301853), tolerance = 1e-07) expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x4$conditionalPowerAchieved[2, ], c(0.78184392, 0.58902983, 0.17869551), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$effect, x4$effect, tolerance = 1e-05) expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-05) expect_equal(x4CodeBased$overallReject, x4$overallReject, tolerance = 1e-05) expect_equal(x4CodeBased$rejectPerStage, x4$rejectPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-05) expect_equal(x4CodeBased$expectedNumberOfSubjects, x4$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x4CodeBased$sampleSizes, x4$sampleSizes, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x5 <- getSimulationMeans(seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x5' with expected results expect_equal(x5$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x5$iterations[1, ], c(100, 100, 100)) expect_equal(x5$iterations[2, ], c(100, 100, 100)) expect_equal(x5$overallReject, c(0.03, 0.36, 0.74), tolerance = 1e-07) expect_equal(x5$rejectPerStage[1, ], c(0, 0, 0)) expect_equal(x5$rejectPerStage[2, ], c(0.03, 0.36, 0.74), tolerance = 1e-07) expect_equal(x5$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x5$earlyStop, c(0, 0, 0)) expect_equal(x5$expectedNumberOfSubjects, c(96.372889, 89.619156, 71.907268), tolerance = 1e-07) expect_equal(x5$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x5$sampleSizes[2, ], c(86.372889, 79.619156, 61.907268), tolerance = 1e-07) expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x5$conditionalPowerAchieved[2, ], c(0.23254121, 0.37156759, 0.50696796), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x5), NA))) expect_output(print(x5)$show()) invisible(capture.output(expect_error(summary(x5), NA))) expect_output(summary(x5)$show()) x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) expect_equal(x5CodeBased$effect, x5$effect, tolerance = 1e-05) expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-05) expect_equal(x5CodeBased$overallReject, x5$overallReject, tolerance = 1e-05) expect_equal(x5CodeBased$rejectPerStage, x5$rejectPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-05) expect_equal(x5CodeBased$expectedNumberOfSubjects, x5$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x5CodeBased$sampleSizes, x5$sampleSizes, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x5), "character") df <- as.data.frame(x5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x6 <- getSimulationMeans(seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, meanRatio = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x6' with expected results expect_equal(x6$effect, c(-0.8, -0.4, 0), tolerance = 1e-07) expect_equal(x6$iterations[1, ], c(100, 100, 100)) expect_equal(x6$iterations[2, ], c(98, 98, 100)) expect_equal(x6$overallReject, c(0.79, 0.36, 0.06), tolerance = 1e-07) expect_equal(x6$rejectPerStage[1, ], c(0.02, 0.02, 0), tolerance = 1e-07) expect_equal(x6$rejectPerStage[2, ], c(0.77, 0.34, 0.06), tolerance = 1e-07) expect_equal(x6$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x6$earlyStop, c(0.02, 0.02, 0), tolerance = 1e-07) expect_equal(x6$expectedNumberOfSubjects, c(61.262488, 89.754099, 94.761842), tolerance = 1e-07) expect_equal(x6$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x6$sampleSizes[2, ], c(52.308661, 81.381734, 84.761842), tolerance = 1e-07) expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x6$conditionalPowerAchieved[2, ], c(0.57015973, 0.32347024, 0.27139992), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x6), NA))) expect_output(print(x6)$show()) invisible(capture.output(expect_error(summary(x6), NA))) expect_output(summary(x6)$show()) x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) expect_equal(x6CodeBased$effect, x6$effect, tolerance = 1e-05) expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-05) expect_equal(x6CodeBased$overallReject, x6$overallReject, tolerance = 1e-05) expect_equal(x6CodeBased$rejectPerStage, x6$rejectPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-05) expect_equal(x6CodeBased$expectedNumberOfSubjects, x6$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x6CodeBased$sampleSizes, x6$sampleSizes, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x6), "character") df <- as.data.frame(x6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x7 <- getSimulationMeans(seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x7' with expected results expect_equal(x7$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x7$iterations[1, ], c(100, 100, 100)) expect_equal(x7$iterations[2, ], c(100, 100, 99)) expect_equal(x7$overallReject, c(0.01, 0.23, 0.83), tolerance = 1e-07) expect_equal(x7$rejectPerStage[1, ], c(0, 0, 0.01), tolerance = 1e-07) expect_equal(x7$rejectPerStage[2, ], c(0.01, 0.23, 0.82), tolerance = 1e-07) expect_equal(x7$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x7$earlyStop, c(0, 0, 0.01), tolerance = 1e-07) expect_equal(x7$expectedNumberOfSubjects, c(99.874349, 85.385224, 62.337209), tolerance = 1e-07) expect_equal(x7$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x7$sampleSizes[2, ], c(89.874349, 75.385224, 52.865867), tolerance = 1e-07) expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x7$conditionalPowerAchieved[2, ], c(0.19979349, 0.40152955, 0.59344307), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x7), NA))) expect_output(print(x7)$show()) invisible(capture.output(expect_error(summary(x7), NA))) expect_output(summary(x7)$show()) x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) expect_equal(x7CodeBased$effect, x7$effect, tolerance = 1e-05) expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-05) expect_equal(x7CodeBased$overallReject, x7$overallReject, tolerance = 1e-05) expect_equal(x7CodeBased$rejectPerStage, x7$rejectPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-05) expect_equal(x7CodeBased$expectedNumberOfSubjects, x7$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x7CodeBased$sampleSizes, x7$sampleSizes, tolerance = 1e-05) expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x7), "character") df <- as.data.frame(x7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x8 <- getSimulationMeans(seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x8' with expected results expect_equal(x8$effect, c(-0.7, -0.4, 0), tolerance = 1e-07) expect_equal(x8$iterations[1, ], c(100, 100, 100)) expect_equal(x8$iterations[2, ], c(99, 100, 100)) expect_equal(x8$overallReject, c(0.72, 0.45, 0.01), tolerance = 1e-07) expect_equal(x8$rejectPerStage[1, ], c(0.01, 0, 0), tolerance = 1e-07) expect_equal(x8$rejectPerStage[2, ], c(0.71, 0.45, 0.01), tolerance = 1e-07) expect_equal(x8$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x8$earlyStop, c(0.01, 0, 0), tolerance = 1e-07) expect_equal(x8$expectedNumberOfSubjects, c(65.632546, 86.865451, 105.50507), tolerance = 1e-07) expect_equal(x8$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x8$sampleSizes[2, ], c(56.194491, 76.865451, 95.50507), tolerance = 1e-07) expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x8$conditionalPowerAchieved[2, ], c(0.52087291, 0.38731069, 0.15906003), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x8), NA))) expect_output(print(x8)$show()) invisible(capture.output(expect_error(summary(x8), NA))) expect_output(summary(x8)$show()) x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) expect_equal(x8CodeBased$effect, x8$effect, tolerance = 1e-05) expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-05) expect_equal(x8CodeBased$overallReject, x8$overallReject, tolerance = 1e-05) expect_equal(x8CodeBased$rejectPerStage, x8$rejectPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-05) expect_equal(x8CodeBased$expectedNumberOfSubjects, x8$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x8CodeBased$sampleSizes, x8$sampleSizes, tolerance = 1e-05) expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x8), "character") df <- as.data.frame(x8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x9 <- getSimulationMeans(seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x9' with expected results expect_equal(x9$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x9$iterations[1, ], c(100, 100, 100)) expect_equal(x9$iterations[2, ], c(100, 99, 98)) expect_equal(x9$overallReject, c(0.09, 0.44, 0.85), tolerance = 1e-07) expect_equal(x9$rejectPerStage[1, ], c(0, 0.01, 0.02), tolerance = 1e-07) expect_equal(x9$rejectPerStage[2, ], c(0.09, 0.43, 0.83), tolerance = 1e-07) expect_equal(x9$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x9$earlyStop, c(0, 0.01, 0.02), tolerance = 1e-07) expect_equal(x9$expectedNumberOfSubjects, c(93.166381, 72.993336, 56.443486), tolerance = 1e-07) expect_equal(x9$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x9$sampleSizes[2, ], c(83.166381, 63.629633, 47.391312), tolerance = 1e-07) expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x9$conditionalPowerAchieved[2, ], c(0.26023971, 0.52016331, 0.61018937), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x9), NA))) expect_output(print(x9)$show()) invisible(capture.output(expect_error(summary(x9), NA))) expect_output(summary(x9)$show()) x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) expect_equal(x9CodeBased$effect, x9$effect, tolerance = 1e-05) expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-05) expect_equal(x9CodeBased$overallReject, x9$overallReject, tolerance = 1e-05) expect_equal(x9CodeBased$rejectPerStage, x9$rejectPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-05) expect_equal(x9CodeBased$expectedNumberOfSubjects, x9$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x9CodeBased$sampleSizes, x9$sampleSizes, tolerance = 1e-05) expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x9), "character") df <- as.data.frame(x9) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x9) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x10 <- getSimulationMeans(seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x10' with expected results expect_equal(x10$effect, c(-0.7, -0.4, 0), tolerance = 1e-07) expect_equal(x10$iterations[1, ], c(100, 100, 100)) expect_equal(x10$iterations[2, ], c(98, 98, 100)) expect_equal(x10$overallReject, c(0.76, 0.42, 0.06), tolerance = 1e-07) expect_equal(x10$rejectPerStage[1, ], c(0.02, 0.02, 0), tolerance = 1e-07) expect_equal(x10$rejectPerStage[2, ], c(0.74, 0.4, 0.06), tolerance = 1e-07) expect_equal(x10$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x10$earlyStop, c(0.02, 0.02, 0), tolerance = 1e-07) expect_equal(x10$expectedNumberOfSubjects, c(62.435526, 88.169977, 94.761842), tolerance = 1e-07) expect_equal(x10$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x10$sampleSizes[2, ], c(53.505639, 79.765282, 84.761842), tolerance = 1e-07) expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x10$conditionalPowerAchieved[2, ], c(0.54108822, 0.32455187, 0.25936079), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x10), NA))) expect_output(print(x10)$show()) invisible(capture.output(expect_error(summary(x10), NA))) expect_output(summary(x10)$show()) x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) expect_equal(x10CodeBased$effect, x10$effect, tolerance = 1e-05) expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-05) expect_equal(x10CodeBased$overallReject, x10$overallReject, tolerance = 1e-05) expect_equal(x10CodeBased$rejectPerStage, x10$rejectPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-05) expect_equal(x10CodeBased$expectedNumberOfSubjects, x10$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x10CodeBased$sampleSizes, x10$sampleSizes, tolerance = 1e-05) expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x10), "character") df <- as.data.frame(x10) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x10) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x11 <- getSimulationMeans(seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05) ## Comparison of the results of SimulationResultsMeans object 'x11' with expected results expect_equal(x11$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07) expect_equal(x11$iterations[1, ], c(100, 100, 100)) expect_equal(x11$iterations[2, ], c(100, 100, 98)) expect_equal(x11$overallReject, c(0.12, 0.39, 0.87), tolerance = 1e-07) expect_equal(x11$rejectPerStage[1, ], c(0, 0, 0.02), tolerance = 1e-07) expect_equal(x11$rejectPerStage[2, ], c(0.12, 0.39, 0.85), tolerance = 1e-07) expect_equal(x11$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x11$earlyStop, c(0, 0, 0.02), tolerance = 1e-07) expect_equal(x11$expectedNumberOfSubjects, c(97.820553, 79.30135, 45.942964), tolerance = 1e-07) expect_equal(x11$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x11$sampleSizes[2, ], c(87.820553, 69.30135, 36.676494), tolerance = 1e-07) expect_equal(x11$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x11$conditionalPowerAchieved[2, ], c(0.24110629, 0.45389272, 0.70091861), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x11), NA))) expect_output(print(x11)$show()) invisible(capture.output(expect_error(summary(x11), NA))) expect_output(summary(x11)$show()) x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) expect_equal(x11CodeBased$effect, x11$effect, tolerance = 1e-05) expect_equal(x11CodeBased$iterations, x11$iterations, tolerance = 1e-05) expect_equal(x11CodeBased$overallReject, x11$overallReject, tolerance = 1e-05) expect_equal(x11CodeBased$rejectPerStage, x11$rejectPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$futilityPerStage, x11$futilityPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$earlyStop, x11$earlyStop, tolerance = 1e-05) expect_equal(x11CodeBased$expectedNumberOfSubjects, x11$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x11CodeBased$sampleSizes, x11$sampleSizes, tolerance = 1e-05) expect_equal(x11CodeBased$conditionalPowerAchieved, x11$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x11), "character") df <- as.data.frame(x11) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x11) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x12 <- getSimulationMeans(seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.8) ## Comparison of the results of SimulationResultsMeans object 'x12' with expected results expect_equal(x12$effect, c(-0.7, -0.4, 0), tolerance = 1e-07) expect_equal(x12$iterations[1, ], c(100, 100, 100)) expect_equal(x12$iterations[2, ], c(99, 100, 100)) expect_equal(x12$overallReject, c(0.72, 0.45, 0.01), tolerance = 1e-07) expect_equal(x12$rejectPerStage[1, ], c(0.01, 0, 0), tolerance = 1e-07) expect_equal(x12$rejectPerStage[2, ], c(0.71, 0.45, 0.01), tolerance = 1e-07) expect_equal(x12$futilityPerStage[1, ], c(0, 0, 0)) expect_equal(x12$earlyStop, c(0.01, 0, 0), tolerance = 1e-07) expect_equal(x12$expectedNumberOfSubjects, c(65.632546, 86.865451, 105.50507), tolerance = 1e-07) expect_equal(x12$sampleSizes[1, ], c(10, 10, 10)) expect_equal(x12$sampleSizes[2, ], c(56.194491, 76.865451, 95.50507), tolerance = 1e-07) expect_equal(x12$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x12$conditionalPowerAchieved[2, ], c(0.52087291, 0.38731069, 0.15906003), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x12), NA))) expect_output(print(x12)$show()) invisible(capture.output(expect_error(summary(x12), NA))) expect_output(summary(x12)$show()) x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) expect_equal(x12CodeBased$effect, x12$effect, tolerance = 1e-05) expect_equal(x12CodeBased$iterations, x12$iterations, tolerance = 1e-05) expect_equal(x12CodeBased$overallReject, x12$overallReject, tolerance = 1e-05) expect_equal(x12CodeBased$rejectPerStage, x12$rejectPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$futilityPerStage, x12$futilityPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$earlyStop, x12$earlyStop, tolerance = 1e-05) expect_equal(x12CodeBased$expectedNumberOfSubjects, x12$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x12CodeBased$sampleSizes, x12$sampleSizes, tolerance = 1e-05) expect_equal(x12CodeBased$conditionalPowerAchieved, x12$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x12), "character") df <- as.data.frame(x12) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x12) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationMeans': comparison with getPowerMeans() results", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} # @refFS[Tab.]{fs:tab:output:getSimulationMeans} # @refFS[Formula]{fs:SimulationOneArmMeansTestStatistics} # @refFS[Formula]{fs:SimulationTwoArmMeansTestStatisticsDiff} # @refFS[Formula]{fs:SimulationTwoArmMeansTestStatisticsRatio} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} .skipTestIfDisabled() x1 <- getSimulationMeans(seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5,0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = TRUE, thetaH0 = 0.4, plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, allocationRatioPlanned = 3, stDev = 1.5) y1 <- getPowerMeans(design = getDesignInverseNormal(futilityBounds = c(-0.5,0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = TRUE, thetaH0 = 0.4, maxNumberOfSubjects = 200, allocationRatioPlanned = 3, stDev = 1.5, normalApproximation = TRUE) expectedNumberOfSubjectsDiff <- round((x1$expectedNumberOfSubjects - y1$expectedNumberOfSubjects) / 200, 4) ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results expect_equal(expectedNumberOfSubjectsDiff, c(0.0027, 0.0092, 0.0016, -0.0071, 0.0018, 0.0013), tolerance = 1e-07) overallRejectDiff1 <- round(x1$overallReject - y1$overallReject, 4) ## Comparison of the results of numeric object 'overallRejectDiff1' with expected results expect_equal(overallRejectDiff1, c(-0.0018, 0.0015, 2e-04, 0, 0, 0), tolerance = 1e-07) futilityStopDiff1 <- round(x1$futilityStop - y1$futilityStop, 4) ## Comparison of the results of numeric object 'futilityStopDiff1' with expected results expect_equal(futilityStopDiff1, c(0.003, -0.0012, -2e-04, 0, 0, 0), tolerance = 1e-07) x2 <- getSimulationMeans(seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5,0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = FALSE, thetaH0 = 0.2, plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, allocationRatioPlanned = 3, stDev = 1.5) y2 <- getPowerMeans(design = getDesignInverseNormal(futilityBounds = c(-0.5,0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = FALSE, thetaH0 = 0.2, maxNumberOfSubjects = 200, allocationRatioPlanned = 3, stDev = 1.5, normalApproximation = TRUE) expectedNumberOfSubjectsDiff <- round((x2$expectedNumberOfSubjects - y2$expectedNumberOfSubjects) / 200, 4) ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results expect_equal(expectedNumberOfSubjectsDiff, c(-0.0117, 0.0015, -4e-04, 4e-04, -0.0018, 0.0065), tolerance = 1e-07) overallRejectDiff2 <- round(x2$overallReject - y2$overallReject, 4) ## Comparison of the results of numeric object 'overallRejectDiff2' with expected results expect_equal(overallRejectDiff2, c(-0.0016, 0.0111, 0.0023, 0.0198, 0.0107, -0.0071), tolerance = 1e-07) futilityStopDiff2 <- round(x2$futilityStop - y2$futilityStop, 4) ## Comparison of the results of numeric object 'futilityStopDiff2' with expected results expect_equal(futilityStopDiff2, c(0.0132, -0.0034, 0.0147, -3e-04, 0.0035, 0.0013), tolerance = 1e-07) x4 <- getSimulationMeans(seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5,0.5), informationRates = c(0.2, 0.5, 1)), groups = 1, thetaH0 = 0.2, plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, stDev = 1.5) y4 <- getPowerMeans(design = getDesignInverseNormal(futilityBounds = c(-0.5,0.5), informationRates = c(0.2, 0.5, 1)), groups = 1, thetaH0 = 0.2, maxNumberOfSubjects = 200, stDev = 1.5, normalApproximation = TRUE) expectedNumberOfSubjectsDiff <- round((x4$expectedNumberOfSubjects - y4$expectedNumberOfSubjects) / 200, 4) ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results expect_equal(expectedNumberOfSubjectsDiff, c(-0.0038, 0.0042, 0.0102, -0.0074, -0.002, -0.0036), tolerance = 1e-07) overallRejectDiff4 <- round(x4$overallReject - y4$overallReject, 4) ## Comparison of the results of numeric object 'overallRejectDiff4' with expected results expect_equal(overallRejectDiff4, c(-1e-04, 0.0121, -0.0064, 0.0131, -0.0015, 1e-04), tolerance = 1e-07) futilityStopDiff4 <- round(x4$futilityStop - y4$futilityStop, 4) ## Comparison of the results of numeric object 'futilityStopDiff4' with expected results expect_equal(futilityStopDiff4, c(0.0013, -0.0094, -0.0191, -0.007, 0.0016, -1e-04), tolerance = 1e-07) x5 <- getSimulationMeans(seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5,0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = TRUE, thetaH0 = 1.1, plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, allocationRatioPlanned = 3, stDev = 1.5, directionUpper = FALSE) y5 <- getPowerMeans(design = getDesignInverseNormal(futilityBounds = c(-0.5,0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = TRUE, thetaH0 = 1.1, maxNumberOfSubjects = 200, allocationRatioPlanned = 3, stDev = 1.5, normalApproximation = TRUE, directionUpper = FALSE) expectedNumberOfSubjectsDiff <- round((x5$expectedNumberOfSubjects - y5$expectedNumberOfSubjects) / 200, 4) ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results expect_equal(expectedNumberOfSubjectsDiff, c(0.008, -0.0088, 0.0023, -0.001, -0.0062, -0.0039), tolerance = 1e-07) overallRejectDiff5 <- round(x5$overallReject - y5$overallReject, 4) ## Comparison of the results of numeric object 'overallRejectDiff5' with expected results expect_equal(overallRejectDiff5, c(0, -0.0019, -9e-04, -1e-04, 0, 0), tolerance = 1e-07) futilityStopDiff5 <- round(x5$futilityStop - y5$futilityStop, 4) ## Comparison of the results of numeric object 'futilityStopDiff5' with expected results expect_equal(futilityStopDiff5, c(-0.0164, 0.0103, 0.0038, 0.0057, 0.0018, 6e-04), tolerance = 1e-07) x6 <- getSimulationMeans(seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5,0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = FALSE, thetaH0 = 1.1, plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, allocationRatioPlanned = 3, stDev = 1.5, directionUpper = FALSE) y6 <- getPowerMeans(design = getDesignInverseNormal(futilityBounds = c(-0.5,0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = FALSE, thetaH0 = 1.1, maxNumberOfSubjects = 200, allocationRatioPlanned = 3, stDev = 1.5, normalApproximation = TRUE, directionUpper = FALSE) expectedNumberOfSubjectsDiff <- round((x6$expectedNumberOfSubjects - y6$expectedNumberOfSubjects) / 200, 4) ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results expect_equal(expectedNumberOfSubjectsDiff, c(0.0029, -0.0013, 0.0079, 0.023, -0.003, -0.0132), tolerance = 1e-07) overallRejectDiff6 <- round(x6$overallReject - y6$overallReject, 4) ## Comparison of the results of numeric object 'overallRejectDiff6' with expected results expect_equal(overallRejectDiff6, c(0.0036, 0.003, -0.0112, -0.0033, -0.0108, -0.0031), tolerance = 1e-07) futilityStopDiff6 <- round(x6$futilityStop - y6$futilityStop, 4) ## Comparison of the results of numeric object 'futilityStopDiff6' with expected results expect_equal(futilityStopDiff6, c(-0.004, 2e-04, 0.0083, -0.0213, -4e-04, 0.0232), tolerance = 1e-07) x7 <- getSimulationMeans(seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5,0.5), informationRates = c(0.2, 0.5, 1)), groups = 1, thetaH0 = 0.8, plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, stDev = 1.5, directionUpper = FALSE) y7 <- getPowerMeans(design = getDesignInverseNormal(futilityBounds = c(-0.5,0.5), informationRates = c(0.2, 0.5, 1)), groups = 1, thetaH0 = 0.8, maxNumberOfSubjects = 200, stDev = 1.5, normalApproximation = TRUE, directionUpper = FALSE) expectedNumberOfSubjectsDiff <- round((x7$expectedNumberOfSubjects - y7$expectedNumberOfSubjects) / 200, 4) ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results expect_equal(expectedNumberOfSubjectsDiff, c(0.0012, 6e-04, -0.0061, -3e-04, 0.0091, 0.0036), tolerance = 1e-07) overallRejectDiff7 <- round(x7$overallReject - y7$overallReject, 4) ## Comparison of the results of numeric object 'overallRejectDiff7' with expected results expect_equal(overallRejectDiff7, c(1e-04, 5e-04, -9e-04, -0.0224, -9e-04, -1e-04), tolerance = 1e-07) futilityStopDiff7 <- round(x7$futilityStop - y7$futilityStop, 4) ## Comparison of the results of numeric object 'futilityStopDiff7' with expected results expect_equal(futilityStopDiff7, c(-1e-04, -4e-04, -0.003, 0.0059, -4e-04, 0.0033), tolerance = 1e-07) }) rpact/tests/testthat/helper-f_analysis_base_rates.R0000644000175000017500000000360214145656365022457 0ustar nileshnilesh## | ## | *Unit tests helper functions* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | testGetAnalysisResultsPlotData <- function(x, ..., nPlanned = NA_real_, stage = NA_integer_, allocationRatioPlanned = NA_real_) { plotArgs <- .getAnalysisResultsPlotArguments(x = x, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned) if (x$getDataInput()$isDatasetMeans()) { assumedStDev <- .getOptionalArgument("assumedStDev", ...) if (is.null(assumedStDev)) { assumedStDev <- x$assumedStDev return(.getConditionalPowerPlot(stageResults = plotArgs$stageResults, nPlanned = plotArgs$nPlanned, allocationRatioPlanned = plotArgs$allocationRatioPlanned, assumedStDev = assumedStDev, ...)) } } else if (x$getDataInput()$isDatasetRates()) { pi2 <- .getOptionalArgument("pi2", ...) if (is.null(pi2)) { pi2 <- x$pi2 return(.getConditionalPowerPlot(stageResults = plotArgs$stageResults, nPlanned = plotArgs$nPlanned, allocationRatioPlanned = plotArgs$allocationRatioPlanned, pi2 = pi2, ...)) } } return(.getConditionalPowerPlot(stageResults = plotArgs$stageResults, nPlanned = plotArgs$nPlanned, allocationRatioPlanned = plotArgs$allocationRatioPlanned, ...)) } rpact/tests/testthat/test-class_analysis_dataset.R0000644000175000017500000055337614154142422022356 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-class_analysis_dataset.R ## | Creation date: 08 December 2021, 08:59:06 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing the Class 'Dataset'") test_that("Usage of 'getDataset'", { # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetMeans} datasetOfMeans1 <- getDataset( n1 = c(22, 11, 22, 11), n2 = c(22, 13, 22, 13), means1 = c(1, 1.1, 1, 1), means2 = c(1.4, 1.5, 3, 2.5), stDevs1 = c(1, 2, 2, 1.3), stDevs2 = c(1, 2, 2, 1.3) ) ## Comparison of the results of DatasetMeans object 'datasetOfMeans1' with expected results expect_equal(datasetOfMeans1$stages, c(1, 1, 2, 2, 3, 3, 4, 4)) expect_equal(datasetOfMeans1$groups, c(1, 2, 1, 2, 1, 2, 1, 2)) expect_equal(datasetOfMeans1$subsets, c(NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_)) expect_equal(datasetOfMeans1$sampleSizes, c(22, 22, 11, 13, 22, 22, 11, 13)) expect_equal(datasetOfMeans1$means, c(1, 1.4, 1.1, 1.5, 1, 3, 1, 2.5), tolerance = 1e-07) expect_equal(datasetOfMeans1$stDevs, c(1, 1, 2, 2, 2, 2, 1.3, 1.3), tolerance = 1e-07) expect_equal(datasetOfMeans1$overallSampleSizes, c(22, 22, 33, 35, 55, 57, 66, 70)) expect_equal(datasetOfMeans1$overallMeans, c(1, 1.4, 1.0333333, 1.4371429, 1.02, 2.0403509, 1.0166667, 2.1257143), tolerance = 1e-07) expect_equal(datasetOfMeans1$overallStDevs, c(1, 1, 1.3814998, 1.4254175, 1.6391506, 1.8228568, 1.5786638, 1.7387056), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(datasetOfMeans1), NA))) expect_output(print(datasetOfMeans1)$show()) invisible(capture.output(expect_error(summary(datasetOfMeans1), NA))) expect_output(summary(datasetOfMeans1)$show()) datasetOfMeans1CodeBased <- eval(parse(text = getObjectRCode(datasetOfMeans1, stringWrapParagraphWidth = NULL))) expect_equal(datasetOfMeans1CodeBased$stages, datasetOfMeans1$stages, tolerance = 1e-05) expect_equal(datasetOfMeans1CodeBased$groups, datasetOfMeans1$groups, tolerance = 1e-05) expect_equal(datasetOfMeans1CodeBased$subsets, datasetOfMeans1$subsets, tolerance = 1e-05) expect_equal(datasetOfMeans1CodeBased$sampleSizes, datasetOfMeans1$sampleSizes, tolerance = 1e-05) expect_equal(datasetOfMeans1CodeBased$means, datasetOfMeans1$means, tolerance = 1e-05) expect_equal(datasetOfMeans1CodeBased$stDevs, datasetOfMeans1$stDevs, tolerance = 1e-05) expect_equal(datasetOfMeans1CodeBased$overallSampleSizes, datasetOfMeans1$overallSampleSizes, tolerance = 1e-05) expect_equal(datasetOfMeans1CodeBased$overallMeans, datasetOfMeans1$overallMeans, tolerance = 1e-05) expect_equal(datasetOfMeans1CodeBased$overallStDevs, datasetOfMeans1$overallStDevs, tolerance = 1e-05) expect_type(names(datasetOfMeans1), "character") df <- as.data.frame(datasetOfMeans1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(datasetOfMeans1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of data.frame object 'datasetOfMeans1$.data' with expected results expect_equal(datasetOfMeans1$.data$stage, factor(c(1, 1, 2, 2, 3, 3, 4, 4))) expect_equal(datasetOfMeans1$.data$group, factor(c(1, 2, 1, 2, 1, 2, 1, 2))) expect_equal(datasetOfMeans1$.data$subset, factor(c(NA, NA, NA, NA, NA, NA, NA, NA))) expect_equal(datasetOfMeans1$.data$sampleSize, c(22, 22, 11, 13, 22, 22, 11, 13)) expect_equal(datasetOfMeans1$.data$mean, c(1, 1.4, 1.1, 1.5, 1, 3, 1, 2.5), tolerance = 1e-07) expect_equal(datasetOfMeans1$.data$stDev, c(1, 1, 2, 2, 2, 2, 1.3, 1.3), tolerance = 1e-07) expect_equal(datasetOfMeans1$.data$overallSampleSize, c(22, 22, 33, 35, 55, 57, 66, 70)) expect_equal(datasetOfMeans1$.data$overallMean, c(1, 1.4, 1.0333333, 1.4371429, 1.02, 2.0403509, 1.0166667, 2.1257143), tolerance = 1e-07) expect_equal(datasetOfMeans1$.data$overallStDev, c(1, 1, 1.3814998, 1.4254175, 1.6391506, 1.8228568, 1.5786638, 1.7387056), tolerance = 1e-07) expect_equal(factor(datasetOfMeans1$stages), datasetOfMeans1$.data$stage, tolerance = 1e-07) expect_equal(factor(datasetOfMeans1$groups), datasetOfMeans1$.data$group, tolerance = 1e-07) expect_equal(datasetOfMeans1$sampleSizes, datasetOfMeans1$.data$sampleSize, tolerance = 1e-07) expect_equal(datasetOfMeans1$means, datasetOfMeans1$.data$mean, tolerance = 1e-07) expect_equal(datasetOfMeans1$stDevs, datasetOfMeans1$.data$stDev, tolerance = 1e-07) expect_equal(datasetOfMeans1$overallSampleSizes, datasetOfMeans1$.data$overallSampleSize, tolerance = 1e-07) expect_equal(datasetOfMeans1$overallMeans, datasetOfMeans1$.data$overallMean, tolerance = 1e-07) expect_equal(datasetOfMeans1$overallStDevs, datasetOfMeans1$.data$overallStDev, tolerance = 1e-07) .skipTestIfDisabled() x <- getMultipleStageResultsForDataset(datasetOfMeans1) ## Comparison of the results of StageResultsMeans object 'x$stageResults1' with expected results expect_equal(x$stageResults1$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallMeans1, c(1, 1.0333333, 1.02, 1.0166667, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallMeans2, c(1.4, 1.4371429, 2.0403509, 2.1257143, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallStDevs1, c(1, 1.3814998, 1.6391506, 1.5786638, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallStDevs2, c(1, 1.4254175, 1.8228568, 1.7387056, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallSampleSizes1, c(22, 33, 55, 66, NA_real_)) expect_equal(x$stageResults1$overallSampleSizes2, c(22, 35, 57, 70, NA_real_)) expect_equal(x$stageResults1$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$effectSizes, c(-0.4, -0.40380952, -1.0203509, -1.1090476, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults1), NA))) expect_output(print(x$stageResults1)$show()) invisible(capture.output(expect_error(summary(x$stageResults1), NA))) expect_output(summary(x$stageResults1)$show()) x$stageResults1CodeBased <- eval(parse(text = getObjectRCode(x$stageResults1, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults1CodeBased$overallTestStatistics, x$stageResults1$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPValues, x$stageResults1$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallMeans1, x$stageResults1$overallMeans1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallMeans2, x$stageResults1$overallMeans2, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallStDevs1, x$stageResults1$overallStDevs1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallStDevs2, x$stageResults1$overallStDevs2, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallSampleSizes1, x$stageResults1$overallSampleSizes1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallSampleSizes2, x$stageResults1$overallSampleSizes2, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$testStatistics, x$stageResults1$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$pValues, x$stageResults1$pValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$effectSizes, x$stageResults1$effectSizes, tolerance = 1e-05) expect_type(names(x$stageResults1), "character") df <- as.data.frame(x$stageResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsMeans object 'x$stageResults2' with expected results expect_equal(x$stageResults2$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallMeans1, c(1, 1.0333333, 1.02, 1.0166667, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallMeans2, c(1.4, 1.4371429, 2.0403509, 2.1257143, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallStDevs1, c(1, 1.3814998, 1.6391506, 1.5786638, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallStDevs2, c(1, 1.4254175, 1.8228568, 1.7387056, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallSampleSizes1, c(22, 33, 55, 66, NA_real_)) expect_equal(x$stageResults2$overallSampleSizes2, c(22, 35, 57, 70, NA_real_)) expect_equal(x$stageResults2$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$effectSizes, c(-0.4, -0.40380952, -1.0203509, -1.1090476, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$combInverseNormal, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$weightsInverseNormal, c(0.4472136, 0.4472136, 0.4472136, 0.4472136, 0.4472136), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults2), NA))) expect_output(print(x$stageResults2)$show()) invisible(capture.output(expect_error(summary(x$stageResults2), NA))) expect_output(summary(x$stageResults2)$show()) x$stageResults2CodeBased <- eval(parse(text = getObjectRCode(x$stageResults2, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults2CodeBased$overallTestStatistics, x$stageResults2$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPValues, x$stageResults2$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallMeans1, x$stageResults2$overallMeans1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallMeans2, x$stageResults2$overallMeans2, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallStDevs1, x$stageResults2$overallStDevs1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallStDevs2, x$stageResults2$overallStDevs2, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallSampleSizes1, x$stageResults2$overallSampleSizes1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallSampleSizes2, x$stageResults2$overallSampleSizes2, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$testStatistics, x$stageResults2$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$pValues, x$stageResults2$pValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$effectSizes, x$stageResults2$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$combInverseNormal, x$stageResults2$combInverseNormal, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$weightsInverseNormal, x$stageResults2$weightsInverseNormal, tolerance = 1e-05) expect_type(names(x$stageResults2), "character") df <- as.data.frame(x$stageResults2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsMeans object 'x$stageResults3' with expected results expect_equal(x$stageResults3$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallMeans1, c(1, 1.0333333, 1.02, 1.0166667, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallMeans2, c(1.4, 1.4371429, 2.0403509, 2.1257143, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallStDevs1, c(1, 1.3814998, 1.6391506, 1.5786638, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallStDevs2, c(1, 1.4254175, 1.8228568, 1.7387056, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallSampleSizes1, c(22, 33, 55, 66, NA_real_)) expect_equal(x$stageResults3$overallSampleSizes2, c(22, 35, 57, 70, NA_real_)) expect_equal(x$stageResults3$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$effectSizes, c(-0.4, -0.40380952, -1.0203509, -1.1090476, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$combFisher, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$weightsFisher, c(1, 1, 1, 1, 1), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults3), NA))) expect_output(print(x$stageResults3)$show()) invisible(capture.output(expect_error(summary(x$stageResults3), NA))) expect_output(summary(x$stageResults3)$show()) x$stageResults3CodeBased <- eval(parse(text = getObjectRCode(x$stageResults3, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults3CodeBased$overallTestStatistics, x$stageResults3$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPValues, x$stageResults3$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallMeans1, x$stageResults3$overallMeans1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallMeans2, x$stageResults3$overallMeans2, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallStDevs1, x$stageResults3$overallStDevs1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallStDevs2, x$stageResults3$overallStDevs2, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallSampleSizes1, x$stageResults3$overallSampleSizes1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallSampleSizes2, x$stageResults3$overallSampleSizes2, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$testStatistics, x$stageResults3$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$pValues, x$stageResults3$pValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$effectSizes, x$stageResults3$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$combFisher, x$stageResults3$combFisher, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$weightsFisher, x$stageResults3$weightsFisher, tolerance = 1e-05) expect_type(names(x$stageResults3), "character") df <- as.data.frame(x$stageResults3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } datasetOfMeans2 <- getDataset(data.frame( stages = 1:4, n1 = c(22, 11, 22, 11), n2 = c(22, 13, 22, 13), means1 = c(1, 1.1, 1, 1), means2 = c(1.4, 1.5, 3, 2.5), stDevs1 = c(1, 2, 2, 1.3), stDevs2 = c(1, 2, 2, 1.3) )) x <- getMultipleStageResultsForDataset(datasetOfMeans2) ## Comparison of the results of StageResultsMeans object 'x$stageResults1' with expected results expect_equal(x$stageResults1$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallMeans1, c(1, 1.0333333, 1.02, 1.0166667, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallMeans2, c(1.4, 1.4371429, 2.0403509, 2.1257143, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallStDevs1, c(1, 1.3814998, 1.6391506, 1.5786638, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallStDevs2, c(1, 1.4254175, 1.8228568, 1.7387056, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallSampleSizes1, c(22, 33, 55, 66, NA_real_)) expect_equal(x$stageResults1$overallSampleSizes2, c(22, 35, 57, 70, NA_real_)) expect_equal(x$stageResults1$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$effectSizes, c(-0.4, -0.40380952, -1.0203509, -1.1090476, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults1), NA))) expect_output(print(x$stageResults1)$show()) invisible(capture.output(expect_error(summary(x$stageResults1), NA))) expect_output(summary(x$stageResults1)$show()) x$stageResults1CodeBased <- eval(parse(text = getObjectRCode(x$stageResults1, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults1CodeBased$overallTestStatistics, x$stageResults1$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPValues, x$stageResults1$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallMeans1, x$stageResults1$overallMeans1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallMeans2, x$stageResults1$overallMeans2, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallStDevs1, x$stageResults1$overallStDevs1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallStDevs2, x$stageResults1$overallStDevs2, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallSampleSizes1, x$stageResults1$overallSampleSizes1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallSampleSizes2, x$stageResults1$overallSampleSizes2, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$testStatistics, x$stageResults1$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$pValues, x$stageResults1$pValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$effectSizes, x$stageResults1$effectSizes, tolerance = 1e-05) expect_type(names(x$stageResults1), "character") df <- as.data.frame(x$stageResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsMeans object 'x$stageResults2' with expected results expect_equal(x$stageResults2$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallMeans1, c(1, 1.0333333, 1.02, 1.0166667, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallMeans2, c(1.4, 1.4371429, 2.0403509, 2.1257143, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallStDevs1, c(1, 1.3814998, 1.6391506, 1.5786638, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallStDevs2, c(1, 1.4254175, 1.8228568, 1.7387056, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallSampleSizes1, c(22, 33, 55, 66, NA_real_)) expect_equal(x$stageResults2$overallSampleSizes2, c(22, 35, 57, 70, NA_real_)) expect_equal(x$stageResults2$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$effectSizes, c(-0.4, -0.40380952, -1.0203509, -1.1090476, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$combInverseNormal, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$weightsInverseNormal, c(0.4472136, 0.4472136, 0.4472136, 0.4472136, 0.4472136), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults2), NA))) expect_output(print(x$stageResults2)$show()) invisible(capture.output(expect_error(summary(x$stageResults2), NA))) expect_output(summary(x$stageResults2)$show()) x$stageResults2CodeBased <- eval(parse(text = getObjectRCode(x$stageResults2, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults2CodeBased$overallTestStatistics, x$stageResults2$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPValues, x$stageResults2$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallMeans1, x$stageResults2$overallMeans1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallMeans2, x$stageResults2$overallMeans2, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallStDevs1, x$stageResults2$overallStDevs1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallStDevs2, x$stageResults2$overallStDevs2, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallSampleSizes1, x$stageResults2$overallSampleSizes1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallSampleSizes2, x$stageResults2$overallSampleSizes2, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$testStatistics, x$stageResults2$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$pValues, x$stageResults2$pValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$effectSizes, x$stageResults2$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$combInverseNormal, x$stageResults2$combInverseNormal, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$weightsInverseNormal, x$stageResults2$weightsInverseNormal, tolerance = 1e-05) expect_type(names(x$stageResults2), "character") df <- as.data.frame(x$stageResults2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsMeans object 'x$stageResults3' with expected results expect_equal(x$stageResults3$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallMeans1, c(1, 1.0333333, 1.02, 1.0166667, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallMeans2, c(1.4, 1.4371429, 2.0403509, 2.1257143, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallStDevs1, c(1, 1.3814998, 1.6391506, 1.5786638, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallStDevs2, c(1, 1.4254175, 1.8228568, 1.7387056, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallSampleSizes1, c(22, 33, 55, 66, NA_real_)) expect_equal(x$stageResults3$overallSampleSizes2, c(22, 35, 57, 70, NA_real_)) expect_equal(x$stageResults3$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$effectSizes, c(-0.4, -0.40380952, -1.0203509, -1.1090476, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$combFisher, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$weightsFisher, c(1, 1, 1, 1, 1), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults3), NA))) expect_output(print(x$stageResults3)$show()) invisible(capture.output(expect_error(summary(x$stageResults3), NA))) expect_output(summary(x$stageResults3)$show()) x$stageResults3CodeBased <- eval(parse(text = getObjectRCode(x$stageResults3, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults3CodeBased$overallTestStatistics, x$stageResults3$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPValues, x$stageResults3$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallMeans1, x$stageResults3$overallMeans1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallMeans2, x$stageResults3$overallMeans2, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallStDevs1, x$stageResults3$overallStDevs1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallStDevs2, x$stageResults3$overallStDevs2, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallSampleSizes1, x$stageResults3$overallSampleSizes1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallSampleSizes2, x$stageResults3$overallSampleSizes2, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$testStatistics, x$stageResults3$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$pValues, x$stageResults3$pValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$effectSizes, x$stageResults3$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$combFisher, x$stageResults3$combFisher, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$weightsFisher, x$stageResults3$weightsFisher, tolerance = 1e-05) expect_type(names(x$stageResults3), "character") df <- as.data.frame(x$stageResults3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } datasetOfMeans3 <- getDataset( overallSampleSizes1 = c(22, 33, 55, 66), overallSampleSizes2 = c(22, 35, 57, 70), overallMeans1 = c(1, 1.033333, 1.02, 1.016667), overallMeans2 = c(1.4, 1.437143, 2.040351, 2.125714), overallStDevs1 = c(1, 1.381500, 1.639151, 1.578664), overallStDevs2 = c(1, 1.425418, 1.822857, 1.738706) ) ## Comparison of the results of DatasetMeans object 'datasetOfMeans3' with expected results expect_equal(datasetOfMeans3$stages, c(1, 1, 2, 2, 3, 3, 4, 4)) expect_equal(datasetOfMeans3$groups, c(1, 2, 1, 2, 1, 2, 1, 2)) expect_equal(datasetOfMeans3$subsets, c(NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_)) expect_equal(datasetOfMeans3$sampleSizes, c(22, 22, 11, 13, 22, 22, 11, 13)) expect_equal(datasetOfMeans3$means, c(1, 1.4, 1.099999, 1.5000004, 1.0000005, 3.0000001, 1.000002, 2.4999979), tolerance = 1e-07) expect_equal(datasetOfMeans3$stDevs, c(1, 1, 2.0000005, 2.0000009, 2.0000005, 1.9999999, 1.2999989, 1.3000023), tolerance = 1e-07) expect_equal(datasetOfMeans3$overallSampleSizes, c(22, 22, 33, 35, 55, 57, 66, 70)) expect_equal(datasetOfMeans3$overallMeans, c(1, 1.4, 1.033333, 1.437143, 1.02, 2.040351, 1.016667, 2.125714), tolerance = 1e-07) expect_equal(datasetOfMeans3$overallStDevs, c(1, 1, 1.3815, 1.425418, 1.639151, 1.822857, 1.578664, 1.738706), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(datasetOfMeans3), NA))) expect_output(print(datasetOfMeans3)$show()) invisible(capture.output(expect_error(summary(datasetOfMeans3), NA))) expect_output(summary(datasetOfMeans3)$show()) datasetOfMeans3CodeBased <- eval(parse(text = getObjectRCode(datasetOfMeans3, stringWrapParagraphWidth = NULL))) expect_equal(datasetOfMeans3CodeBased$stages, datasetOfMeans3$stages, tolerance = 1e-05) expect_equal(datasetOfMeans3CodeBased$groups, datasetOfMeans3$groups, tolerance = 1e-05) expect_equal(datasetOfMeans3CodeBased$subsets, datasetOfMeans3$subsets, tolerance = 1e-05) expect_equal(datasetOfMeans3CodeBased$sampleSizes, datasetOfMeans3$sampleSizes, tolerance = 1e-05) expect_equal(datasetOfMeans3CodeBased$means, datasetOfMeans3$means, tolerance = 1e-05) expect_equal(datasetOfMeans3CodeBased$stDevs, datasetOfMeans3$stDevs, tolerance = 1e-05) expect_equal(datasetOfMeans3CodeBased$overallSampleSizes, datasetOfMeans3$overallSampleSizes, tolerance = 1e-05) expect_equal(datasetOfMeans3CodeBased$overallMeans, datasetOfMeans3$overallMeans, tolerance = 1e-05) expect_equal(datasetOfMeans3CodeBased$overallStDevs, datasetOfMeans3$overallStDevs, tolerance = 1e-05) expect_type(names(datasetOfMeans3), "character") df <- as.data.frame(datasetOfMeans3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(datasetOfMeans3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of data.frame object 'datasetOfMeans3$.data' with expected results expect_equal(datasetOfMeans3$.data$stage, factor(c(1, 1, 2, 2, 3, 3, 4, 4))) expect_equal(datasetOfMeans3$.data$group, factor(c(1, 2, 1, 2, 1, 2, 1, 2))) expect_equal(datasetOfMeans3$.data$subset, factor(c(NA, NA, NA, NA, NA, NA, NA, NA))) expect_equal(datasetOfMeans3$.data$sampleSize, c(22, 22, 11, 13, 22, 22, 11, 13)) expect_equal(datasetOfMeans3$.data$mean, c(1, 1.4, 1.099999, 1.5000004, 1.0000005, 3.0000001, 1.000002, 2.4999979), tolerance = 1e-07) expect_equal(datasetOfMeans3$.data$stDev, c(1, 1, 2.0000005, 2.0000009, 2.0000005, 1.9999999, 1.2999989, 1.3000023), tolerance = 1e-07) expect_equal(datasetOfMeans3$.data$overallSampleSize, c(22, 22, 33, 35, 55, 57, 66, 70)) expect_equal(datasetOfMeans3$.data$overallMean, c(1, 1.4, 1.033333, 1.437143, 1.02, 2.040351, 1.016667, 2.125714), tolerance = 1e-07) expect_equal(datasetOfMeans3$.data$overallStDev, c(1, 1, 1.3815, 1.425418, 1.639151, 1.822857, 1.578664, 1.738706), tolerance = 1e-07) x <- getMultipleStageResultsForDataset(datasetOfMeans3) ## Comparison of the results of StageResultsMeans object 'x$stageResults1' with expected results expect_equal(x$stageResults1$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallMeans1, c(1, 1.033333, 1.02, 1.016667, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallMeans2, c(1.4, 1.437143, 2.040351, 2.125714, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallStDevs1, c(1, 1.3815, 1.639151, 1.578664, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallStDevs2, c(1, 1.425418, 1.822857, 1.738706, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallSampleSizes1, c(22, 33, 55, 66, NA_real_)) expect_equal(x$stageResults1$overallSampleSizes2, c(22, 35, 57, 70, NA_real_)) expect_equal(x$stageResults1$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$effectSizes, c(-0.4, -0.40381, -1.020351, -1.109047, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults1), NA))) expect_output(print(x$stageResults1)$show()) invisible(capture.output(expect_error(summary(x$stageResults1), NA))) expect_output(summary(x$stageResults1)$show()) x$stageResults1CodeBased <- eval(parse(text = getObjectRCode(x$stageResults1, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults1CodeBased$overallTestStatistics, x$stageResults1$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPValues, x$stageResults1$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallMeans1, x$stageResults1$overallMeans1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallMeans2, x$stageResults1$overallMeans2, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallStDevs1, x$stageResults1$overallStDevs1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallStDevs2, x$stageResults1$overallStDevs2, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallSampleSizes1, x$stageResults1$overallSampleSizes1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallSampleSizes2, x$stageResults1$overallSampleSizes2, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$testStatistics, x$stageResults1$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$pValues, x$stageResults1$pValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$effectSizes, x$stageResults1$effectSizes, tolerance = 1e-05) expect_type(names(x$stageResults1), "character") df <- as.data.frame(x$stageResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsMeans object 'x$stageResults2' with expected results expect_equal(x$stageResults2$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallMeans1, c(1, 1.033333, 1.02, 1.016667, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallMeans2, c(1.4, 1.437143, 2.040351, 2.125714, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallStDevs1, c(1, 1.3815, 1.639151, 1.578664, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallStDevs2, c(1, 1.425418, 1.822857, 1.738706, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallSampleSizes1, c(22, 33, 55, 66, NA_real_)) expect_equal(x$stageResults2$overallSampleSizes2, c(22, 35, 57, 70, NA_real_)) expect_equal(x$stageResults2$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$effectSizes, c(-0.4, -0.40381, -1.020351, -1.109047, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$combInverseNormal, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$weightsInverseNormal, c(0.4472136, 0.4472136, 0.4472136, 0.4472136, 0.4472136), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults2), NA))) expect_output(print(x$stageResults2)$show()) invisible(capture.output(expect_error(summary(x$stageResults2), NA))) expect_output(summary(x$stageResults2)$show()) x$stageResults2CodeBased <- eval(parse(text = getObjectRCode(x$stageResults2, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults2CodeBased$overallTestStatistics, x$stageResults2$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPValues, x$stageResults2$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallMeans1, x$stageResults2$overallMeans1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallMeans2, x$stageResults2$overallMeans2, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallStDevs1, x$stageResults2$overallStDevs1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallStDevs2, x$stageResults2$overallStDevs2, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallSampleSizes1, x$stageResults2$overallSampleSizes1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallSampleSizes2, x$stageResults2$overallSampleSizes2, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$testStatistics, x$stageResults2$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$pValues, x$stageResults2$pValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$effectSizes, x$stageResults2$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$combInverseNormal, x$stageResults2$combInverseNormal, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$weightsInverseNormal, x$stageResults2$weightsInverseNormal, tolerance = 1e-05) expect_type(names(x$stageResults2), "character") df <- as.data.frame(x$stageResults2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsMeans object 'x$stageResults3' with expected results expect_equal(x$stageResults3$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallMeans1, c(1, 1.033333, 1.02, 1.016667, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallMeans2, c(1.4, 1.437143, 2.040351, 2.125714, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallStDevs1, c(1, 1.3815, 1.639151, 1.578664, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallStDevs2, c(1, 1.425418, 1.822857, 1.738706, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallSampleSizes1, c(22, 33, 55, 66, NA_real_)) expect_equal(x$stageResults3$overallSampleSizes2, c(22, 35, 57, 70, NA_real_)) expect_equal(x$stageResults3$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$effectSizes, c(-0.4, -0.40381, -1.020351, -1.109047, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$combFisher, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$weightsFisher, c(1, 1, 1, 1, 1), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults3), NA))) expect_output(print(x$stageResults3)$show()) invisible(capture.output(expect_error(summary(x$stageResults3), NA))) expect_output(summary(x$stageResults3)$show()) x$stageResults3CodeBased <- eval(parse(text = getObjectRCode(x$stageResults3, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults3CodeBased$overallTestStatistics, x$stageResults3$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPValues, x$stageResults3$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallMeans1, x$stageResults3$overallMeans1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallMeans2, x$stageResults3$overallMeans2, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallStDevs1, x$stageResults3$overallStDevs1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallStDevs2, x$stageResults3$overallStDevs2, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallSampleSizes1, x$stageResults3$overallSampleSizes1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallSampleSizes2, x$stageResults3$overallSampleSizes2, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$testStatistics, x$stageResults3$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$pValues, x$stageResults3$pValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$effectSizes, x$stageResults3$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$combFisher, x$stageResults3$combFisher, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$weightsFisher, x$stageResults3$weightsFisher, tolerance = 1e-05) expect_type(names(x$stageResults3), "character") df <- as.data.frame(x$stageResults3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("Creation of a dataset of means using stage wise data (one group)", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetMeans} datasetOfMeans4 <- getDataset( n = c(22, 11, 22, 11), means = c(1, 1.1, 1, 1), stDevs = c(1, 2, 2, 1.3) ) ## Comparison of the results of DatasetMeans object 'datasetOfMeans4' with expected results expect_equal(datasetOfMeans4$stages, c(1, 2, 3, 4)) expect_equal(datasetOfMeans4$groups, c(1, 1, 1, 1)) expect_equal(datasetOfMeans4$subsets, c(NA_character_, NA_character_, NA_character_, NA_character_)) expect_equal(datasetOfMeans4$sampleSizes, c(22, 11, 22, 11)) expect_equal(datasetOfMeans4$means, c(1, 1.1, 1, 1), tolerance = 1e-07) expect_equal(datasetOfMeans4$stDevs, c(1, 2, 2, 1.3), tolerance = 1e-07) expect_equal(datasetOfMeans4$overallSampleSizes, c(22, 33, 55, 66)) expect_equal(datasetOfMeans4$overallMeans, c(1, 1.0333333, 1.02, 1.0166667), tolerance = 1e-07) expect_equal(datasetOfMeans4$overallStDevs, c(1, 1.3814998, 1.6391506, 1.5786638), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(datasetOfMeans4), NA))) expect_output(print(datasetOfMeans4)$show()) invisible(capture.output(expect_error(summary(datasetOfMeans4), NA))) expect_output(summary(datasetOfMeans4)$show()) datasetOfMeans4CodeBased <- eval(parse(text = getObjectRCode(datasetOfMeans4, stringWrapParagraphWidth = NULL))) expect_equal(datasetOfMeans4CodeBased$stages, datasetOfMeans4$stages, tolerance = 1e-05) expect_equal(datasetOfMeans4CodeBased$groups, datasetOfMeans4$groups, tolerance = 1e-05) expect_equal(datasetOfMeans4CodeBased$subsets, datasetOfMeans4$subsets, tolerance = 1e-05) expect_equal(datasetOfMeans4CodeBased$sampleSizes, datasetOfMeans4$sampleSizes, tolerance = 1e-05) expect_equal(datasetOfMeans4CodeBased$means, datasetOfMeans4$means, tolerance = 1e-05) expect_equal(datasetOfMeans4CodeBased$stDevs, datasetOfMeans4$stDevs, tolerance = 1e-05) expect_equal(datasetOfMeans4CodeBased$overallSampleSizes, datasetOfMeans4$overallSampleSizes, tolerance = 1e-05) expect_equal(datasetOfMeans4CodeBased$overallMeans, datasetOfMeans4$overallMeans, tolerance = 1e-05) expect_equal(datasetOfMeans4CodeBased$overallStDevs, datasetOfMeans4$overallStDevs, tolerance = 1e-05) expect_type(names(datasetOfMeans4), "character") df <- as.data.frame(datasetOfMeans4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(datasetOfMeans4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of data.frame object 'datasetOfMeans4$.data' with expected results expect_equal(datasetOfMeans4$.data$stage, factor(c(1, 2, 3, 4))) expect_equal(datasetOfMeans4$.data$group, factor(c(1, 1, 1, 1))) expect_equal(datasetOfMeans4$.data$subset, factor(c(NA, NA, NA, NA))) expect_equal(datasetOfMeans4$.data$sampleSize, c(22, 11, 22, 11)) expect_equal(datasetOfMeans4$.data$mean, c(1, 1.1, 1, 1), tolerance = 1e-07) expect_equal(datasetOfMeans4$.data$stDev, c(1, 2, 2, 1.3), tolerance = 1e-07) expect_equal(datasetOfMeans4$.data$overallSampleSize, c(22, 33, 55, 66)) expect_equal(datasetOfMeans4$.data$overallMean, c(1, 1.0333333, 1.02, 1.0166667), tolerance = 1e-07) expect_equal(datasetOfMeans4$.data$overallStDev, c(1, 1.3814998, 1.6391506, 1.5786638), tolerance = 1e-07) x <- getMultipleStageResultsForDataset(datasetOfMeans4) ## Comparison of the results of StageResultsMeans object 'x$stageResults1' with expected results expect_equal(x$stageResults1$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallMeans, c(1, 1.0333333, 1.02, 1.0166667, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallStDevs, c(1, 1.3814998, 1.6391506, 1.5786638, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallSampleSizes, c(22, 33, 55, 66, NA_real_)) expect_equal(x$stageResults1$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$effectSizes, c(1, 1.0333333, 1.02, 1.0166667, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults1), NA))) expect_output(print(x$stageResults1)$show()) invisible(capture.output(expect_error(summary(x$stageResults1), NA))) expect_output(summary(x$stageResults1)$show()) x$stageResults1CodeBased <- eval(parse(text = getObjectRCode(x$stageResults1, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults1CodeBased$overallTestStatistics, x$stageResults1$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPValues, x$stageResults1$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallMeans, x$stageResults1$overallMeans, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallStDevs, x$stageResults1$overallStDevs, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallSampleSizes, x$stageResults1$overallSampleSizes, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$testStatistics, x$stageResults1$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$pValues, x$stageResults1$pValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$effectSizes, x$stageResults1$effectSizes, tolerance = 1e-05) expect_type(names(x$stageResults1), "character") df <- as.data.frame(x$stageResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsMeans object 'x$stageResults2' with expected results expect_equal(x$stageResults2$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallMeans, c(1, 1.0333333, 1.02, 1.0166667, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallStDevs, c(1, 1.3814998, 1.6391506, 1.5786638, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallSampleSizes, c(22, 33, 55, 66, NA_real_)) expect_equal(x$stageResults2$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$effectSizes, c(1, 1.0333333, 1.02, 1.0166667, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$combInverseNormal, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$weightsInverseNormal, c(0.4472136, 0.4472136, 0.4472136, 0.4472136, 0.4472136), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults2), NA))) expect_output(print(x$stageResults2)$show()) invisible(capture.output(expect_error(summary(x$stageResults2), NA))) expect_output(summary(x$stageResults2)$show()) x$stageResults2CodeBased <- eval(parse(text = getObjectRCode(x$stageResults2, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults2CodeBased$overallTestStatistics, x$stageResults2$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPValues, x$stageResults2$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallMeans, x$stageResults2$overallMeans, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallStDevs, x$stageResults2$overallStDevs, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallSampleSizes, x$stageResults2$overallSampleSizes, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$testStatistics, x$stageResults2$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$pValues, x$stageResults2$pValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$effectSizes, x$stageResults2$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$combInverseNormal, x$stageResults2$combInverseNormal, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$weightsInverseNormal, x$stageResults2$weightsInverseNormal, tolerance = 1e-05) expect_type(names(x$stageResults2), "character") df <- as.data.frame(x$stageResults2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsMeans object 'x$stageResults3' with expected results expect_equal(x$stageResults3$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallMeans, c(1, 1.0333333, 1.02, 1.0166667, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallStDevs, c(1, 1.3814998, 1.6391506, 1.5786638, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallSampleSizes, c(22, 33, 55, 66, NA_real_)) expect_equal(x$stageResults3$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$effectSizes, c(1, 1.0333333, 1.02, 1.0166667, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$combFisher, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$weightsFisher, c(1, 1, 1, 1, 1), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults3), NA))) expect_output(print(x$stageResults3)$show()) invisible(capture.output(expect_error(summary(x$stageResults3), NA))) expect_output(summary(x$stageResults3)$show()) x$stageResults3CodeBased <- eval(parse(text = getObjectRCode(x$stageResults3, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults3CodeBased$overallTestStatistics, x$stageResults3$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPValues, x$stageResults3$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallMeans, x$stageResults3$overallMeans, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallStDevs, x$stageResults3$overallStDevs, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallSampleSizes, x$stageResults3$overallSampleSizes, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$testStatistics, x$stageResults3$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$pValues, x$stageResults3$pValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$effectSizes, x$stageResults3$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$combFisher, x$stageResults3$combFisher, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$weightsFisher, x$stageResults3$weightsFisher, tolerance = 1e-05) expect_type(names(x$stageResults3), "character") df <- as.data.frame(x$stageResults3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("Creation of a dataset of means using overall data (one group)", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetMeans} datasetOfMeans5 <- getDataset( overallSampleSizes = c(22, 33, 55, 66), overallMeans = c(1.000, 1.033, 1.020, 1.017 ), overallStDevs = c(1.00, 1.38, 1.64, 1.58) ) ## Comparison of the results of DatasetMeans object 'datasetOfMeans5' with expected results expect_equal(datasetOfMeans5$stages, c(1, 2, 3, 4)) expect_equal(datasetOfMeans5$groups, c(1, 1, 1, 1)) expect_equal(datasetOfMeans5$subsets, c(NA_character_, NA_character_, NA_character_, NA_character_)) expect_equal(datasetOfMeans5$sampleSizes, c(22, 11, 22, 11)) expect_equal(datasetOfMeans5$means, c(1, 1.099, 1.0005, 1.002), tolerance = 1e-07) expect_equal(datasetOfMeans5$stDevs, c(1, 1.9967205, 2.003374, 1.3047847), tolerance = 1e-07) expect_equal(datasetOfMeans5$overallSampleSizes, c(22, 33, 55, 66)) expect_equal(datasetOfMeans5$overallMeans, c(1, 1.033, 1.02, 1.017), tolerance = 1e-07) expect_equal(datasetOfMeans5$overallStDevs, c(1, 1.38, 1.64, 1.58), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(datasetOfMeans5), NA))) expect_output(print(datasetOfMeans5)$show()) invisible(capture.output(expect_error(summary(datasetOfMeans5), NA))) expect_output(summary(datasetOfMeans5)$show()) datasetOfMeans5CodeBased <- eval(parse(text = getObjectRCode(datasetOfMeans5, stringWrapParagraphWidth = NULL))) expect_equal(datasetOfMeans5CodeBased$stages, datasetOfMeans5$stages, tolerance = 1e-05) expect_equal(datasetOfMeans5CodeBased$groups, datasetOfMeans5$groups, tolerance = 1e-05) expect_equal(datasetOfMeans5CodeBased$subsets, datasetOfMeans5$subsets, tolerance = 1e-05) expect_equal(datasetOfMeans5CodeBased$sampleSizes, datasetOfMeans5$sampleSizes, tolerance = 1e-05) expect_equal(datasetOfMeans5CodeBased$means, datasetOfMeans5$means, tolerance = 1e-05) expect_equal(datasetOfMeans5CodeBased$stDevs, datasetOfMeans5$stDevs, tolerance = 1e-05) expect_equal(datasetOfMeans5CodeBased$overallSampleSizes, datasetOfMeans5$overallSampleSizes, tolerance = 1e-05) expect_equal(datasetOfMeans5CodeBased$overallMeans, datasetOfMeans5$overallMeans, tolerance = 1e-05) expect_equal(datasetOfMeans5CodeBased$overallStDevs, datasetOfMeans5$overallStDevs, tolerance = 1e-05) expect_type(names(datasetOfMeans5), "character") df <- as.data.frame(datasetOfMeans5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(datasetOfMeans5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of data.frame object 'datasetOfMeans5$.data' with expected results expect_equal(datasetOfMeans5$.data$stage, factor(c(1, 2, 3, 4))) expect_equal(datasetOfMeans5$.data$group, factor(c(1, 1, 1, 1))) expect_equal(datasetOfMeans5$.data$subset, factor(c(NA, NA, NA, NA))) expect_equal(datasetOfMeans5$.data$sampleSize, c(22, 11, 22, 11)) expect_equal(datasetOfMeans5$.data$mean, c(1, 1.099, 1.0005, 1.002), tolerance = 1e-07) expect_equal(datasetOfMeans5$.data$stDev, c(1, 1.9967205, 2.003374, 1.3047847), tolerance = 1e-07) expect_equal(datasetOfMeans5$.data$overallSampleSize, c(22, 33, 55, 66)) expect_equal(datasetOfMeans5$.data$overallMean, c(1, 1.033, 1.02, 1.017), tolerance = 1e-07) expect_equal(datasetOfMeans5$.data$overallStDev, c(1, 1.38, 1.64, 1.58), tolerance = 1e-07) x <- getMultipleStageResultsForDataset(datasetOfMeans5) ## Comparison of the results of StageResultsMeans object 'x$stageResults1' with expected results expect_equal(x$stageResults1$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallMeans, c(1, 1.033, 1.02, 1.017, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallStDevs, c(1, 1.38, 1.64, 1.58, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallSampleSizes, c(22, 33, 55, 66, NA_real_)) expect_equal(x$stageResults1$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$effectSizes, c(1, 1.033, 1.02, 1.017, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults1), NA))) expect_output(print(x$stageResults1)$show()) invisible(capture.output(expect_error(summary(x$stageResults1), NA))) expect_output(summary(x$stageResults1)$show()) x$stageResults1CodeBased <- eval(parse(text = getObjectRCode(x$stageResults1, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults1CodeBased$overallTestStatistics, x$stageResults1$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPValues, x$stageResults1$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallMeans, x$stageResults1$overallMeans, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallStDevs, x$stageResults1$overallStDevs, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallSampleSizes, x$stageResults1$overallSampleSizes, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$testStatistics, x$stageResults1$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$pValues, x$stageResults1$pValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$effectSizes, x$stageResults1$effectSizes, tolerance = 1e-05) expect_type(names(x$stageResults1), "character") df <- as.data.frame(x$stageResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsMeans object 'x$stageResults2' with expected results expect_equal(x$stageResults2$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallMeans, c(1, 1.033, 1.02, 1.017, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallStDevs, c(1, 1.38, 1.64, 1.58, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallSampleSizes, c(22, 33, 55, 66, NA_real_)) expect_equal(x$stageResults2$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$effectSizes, c(1, 1.033, 1.02, 1.017, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$combInverseNormal, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$weightsInverseNormal, c(0.4472136, 0.4472136, 0.4472136, 0.4472136, 0.4472136), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults2), NA))) expect_output(print(x$stageResults2)$show()) invisible(capture.output(expect_error(summary(x$stageResults2), NA))) expect_output(summary(x$stageResults2)$show()) x$stageResults2CodeBased <- eval(parse(text = getObjectRCode(x$stageResults2, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults2CodeBased$overallTestStatistics, x$stageResults2$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPValues, x$stageResults2$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallMeans, x$stageResults2$overallMeans, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallStDevs, x$stageResults2$overallStDevs, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallSampleSizes, x$stageResults2$overallSampleSizes, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$testStatistics, x$stageResults2$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$pValues, x$stageResults2$pValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$effectSizes, x$stageResults2$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$combInverseNormal, x$stageResults2$combInverseNormal, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$weightsInverseNormal, x$stageResults2$weightsInverseNormal, tolerance = 1e-05) expect_type(names(x$stageResults2), "character") df <- as.data.frame(x$stageResults2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsMeans object 'x$stageResults3' with expected results expect_equal(x$stageResults3$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallMeans, c(1, 1.033, 1.02, 1.017, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallStDevs, c(1, 1.38, 1.64, 1.58, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallSampleSizes, c(22, 33, 55, 66, NA_real_)) expect_equal(x$stageResults3$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$effectSizes, c(1, 1.033, 1.02, 1.017, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$combFisher, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$weightsFisher, c(1, 1, 1, 1, 1), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults3), NA))) expect_output(print(x$stageResults3)$show()) invisible(capture.output(expect_error(summary(x$stageResults3), NA))) expect_output(summary(x$stageResults3)$show()) x$stageResults3CodeBased <- eval(parse(text = getObjectRCode(x$stageResults3, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults3CodeBased$overallTestStatistics, x$stageResults3$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPValues, x$stageResults3$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallMeans, x$stageResults3$overallMeans, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallStDevs, x$stageResults3$overallStDevs, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallSampleSizes, x$stageResults3$overallSampleSizes, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$testStatistics, x$stageResults3$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$pValues, x$stageResults3$pValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$effectSizes, x$stageResults3$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$combFisher, x$stageResults3$combFisher, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$weightsFisher, x$stageResults3$weightsFisher, tolerance = 1e-05) expect_type(names(x$stageResults3), "character") df <- as.data.frame(x$stageResults3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("Trim command works as expected for means", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetMeans} datasetOfMeansExpected <- getDataset( n1 = c(13, 25), n2 = c(15, NA), n3 = c(14, 27), n4 = c(12, 29), means1 = c(24.2, 22.2), means2 = c(18.8, NA), means3 = c(26.7, 27.7), means4 = c(9.2, 12.2), stDevs1 = c(24.4, 22.1), stDevs2 = c(21.2, NA), stDevs3 = c(25.6, 23.2), stDevs4 = c(21.5, 22.7) ) datasetOfMeans <- getDataset( n1 = c(13, 25), n2 = c(15, NA), n3 = c(14, 27), n4 = c(12, 29), means1 = c(24.2, 22.2), means2 = c(18.8, NA), means3 = c(26.7, 27.7), means4 = c(9.2, 12.2), stDevs1 = c(24.4, 22.1), stDevs2 = c(21.2, NA), stDevs3 = c(25.6, 23.2), stDevs4 = c(21.5, 22.7) ) datasetOfMeans$.fillWithNAs(4) datasetOfMeans$.trim(2) expect_equal(datasetOfMeans$stages, datasetOfMeansExpected$stages) expect_equal(datasetOfMeans$groups, datasetOfMeansExpected$groups) expect_equal(datasetOfMeans$overallMeans, datasetOfMeansExpected$overallMeans) expect_equal(datasetOfMeans$means, datasetOfMeansExpected$means) expect_equal(datasetOfMeans$overallStDevs, datasetOfMeansExpected$overallStDevs) expect_equal(datasetOfMeans$stDevs, datasetOfMeansExpected$stDevs) expect_equal(datasetOfMeans$.data$stage, datasetOfMeansExpected$.data$stage) expect_equal(datasetOfMeans$.data$group, datasetOfMeansExpected$.data$group) expect_equal(datasetOfMeans$.data$overallMeans, datasetOfMeansExpected$.data$overallMeans) expect_equal(datasetOfMeans$.data$means, datasetOfMeansExpected$.data$means) expect_equal(datasetOfMeans$.data$overallStDevs, datasetOfMeansExpected$.data$overallStDevs) expect_equal(datasetOfMeans$.data$stDevs, datasetOfMeansExpected$.data$stDevs) }) test_that("Creation of a dataset of rates using stage wise data (one group)", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetRates} datasetOfRates1 <- getDataset( n = c(8, 10, 9, 11), events = c(4, 5, 5, 6) ) ## Comparison of the results of DatasetRates object 'datasetOfRates1' with expected results expect_equal(datasetOfRates1$stages, c(1, 2, 3, 4)) expect_equal(datasetOfRates1$groups, c(1, 1, 1, 1)) expect_equal(datasetOfRates1$subsets, c(NA_character_, NA_character_, NA_character_, NA_character_)) expect_equal(datasetOfRates1$sampleSizes, c(8, 10, 9, 11)) expect_equal(datasetOfRates1$events, c(4, 5, 5, 6)) expect_equal(datasetOfRates1$overallSampleSizes, c(8, 18, 27, 38)) expect_equal(datasetOfRates1$overallEvents, c(4, 9, 14, 20)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(datasetOfRates1), NA))) expect_output(print(datasetOfRates1)$show()) invisible(capture.output(expect_error(summary(datasetOfRates1), NA))) expect_output(summary(datasetOfRates1)$show()) datasetOfRates1CodeBased <- eval(parse(text = getObjectRCode(datasetOfRates1, stringWrapParagraphWidth = NULL))) expect_equal(datasetOfRates1CodeBased$stages, datasetOfRates1$stages, tolerance = 1e-05) expect_equal(datasetOfRates1CodeBased$groups, datasetOfRates1$groups, tolerance = 1e-05) expect_equal(datasetOfRates1CodeBased$subsets, datasetOfRates1$subsets, tolerance = 1e-05) expect_equal(datasetOfRates1CodeBased$sampleSizes, datasetOfRates1$sampleSizes, tolerance = 1e-05) expect_equal(datasetOfRates1CodeBased$events, datasetOfRates1$events, tolerance = 1e-05) expect_equal(datasetOfRates1CodeBased$overallSampleSizes, datasetOfRates1$overallSampleSizes, tolerance = 1e-05) expect_equal(datasetOfRates1CodeBased$overallEvents, datasetOfRates1$overallEvents, tolerance = 1e-05) expect_type(names(datasetOfRates1), "character") df <- as.data.frame(datasetOfRates1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(datasetOfRates1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of data.frame object 'datasetOfRates1$.data' with expected results expect_equal(datasetOfRates1$.data$stage, factor(c(1, 2, 3, 4))) expect_equal(datasetOfRates1$.data$group, factor(c(1, 1, 1, 1))) expect_equal(datasetOfRates1$.data$subset, factor(c(NA, NA, NA, NA))) expect_equal(datasetOfRates1$.data$sampleSize, c(8, 10, 9, 11)) expect_equal(datasetOfRates1$.data$event, c(4, 5, 5, 6)) expect_equal(datasetOfRates1$.data$overallSampleSize, c(8, 18, 27, 38)) expect_equal(datasetOfRates1$.data$overallEvent, c(4, 9, 14, 20)) x <- getMultipleStageResultsForDataset(datasetOfRates1, thetaH0 = 0.99) ## Comparison of the results of StageResultsRates object 'x$stageResults1' with expected results expect_equal(x$stageResults1$overallTestStatistics, c(-13.929113, -20.89367, -24.622317, -28.727412, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallPValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults1$overallEvents, c(4, 9, 14, 20, NA_real_)) expect_equal(x$stageResults1$overallSampleSizes, c(8, 18, 27, 38, NA_real_)) expect_equal(x$stageResults1$overallPi1, c(0.5, 0.5, 0.51851852, 0.52631579, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$testStatistics, c(-13.929113, -15.573222, -13.098993, -14.818182, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$pValues, c(1, 1, 1, 1, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults1), NA))) expect_output(print(x$stageResults1)$show()) invisible(capture.output(expect_error(summary(x$stageResults1), NA))) expect_output(summary(x$stageResults1)$show()) x$stageResults1CodeBased <- eval(parse(text = getObjectRCode(x$stageResults1, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults1CodeBased$overallTestStatistics, x$stageResults1$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPValues, x$stageResults1$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallEvents, x$stageResults1$overallEvents, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallSampleSizes, x$stageResults1$overallSampleSizes, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPi1, x$stageResults1$overallPi1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$testStatistics, x$stageResults1$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$pValues, x$stageResults1$pValues, tolerance = 1e-05) expect_type(names(x$stageResults1), "character") df <- as.data.frame(x$stageResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsRates object 'x$stageResults2' with expected results expect_equal(x$stageResults2$overallTestStatistics, c(-13.929113, -20.89367, -24.622317, -28.727412, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallPValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults2$overallEvents, c(4, 9, 14, 20, NA_real_)) expect_equal(x$stageResults2$overallSampleSizes, c(8, 18, 27, 38, NA_real_)) expect_equal(x$stageResults2$overallPi1, c(0.5, 0.5, 0.51851852, 0.52631579, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$testStatistics, c(-13.929113, -15.573222, -13.098993, -14.818182, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$pValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults2$combInverseNormal, c(-38.449394, -54.375655, -66.596305, -76.898789, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$weightsInverseNormal, c(0.4472136, 0.4472136, 0.4472136, 0.4472136, 0.4472136), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults2), NA))) expect_output(print(x$stageResults2)$show()) invisible(capture.output(expect_error(summary(x$stageResults2), NA))) expect_output(summary(x$stageResults2)$show()) x$stageResults2CodeBased <- eval(parse(text = getObjectRCode(x$stageResults2, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults2CodeBased$overallTestStatistics, x$stageResults2$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPValues, x$stageResults2$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallEvents, x$stageResults2$overallEvents, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallSampleSizes, x$stageResults2$overallSampleSizes, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPi1, x$stageResults2$overallPi1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$testStatistics, x$stageResults2$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$pValues, x$stageResults2$pValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$combInverseNormal, x$stageResults2$combInverseNormal, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$weightsInverseNormal, x$stageResults2$weightsInverseNormal, tolerance = 1e-05) expect_type(names(x$stageResults2), "character") df <- as.data.frame(x$stageResults2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsRates object 'x$stageResults3' with expected results expect_equal(x$stageResults3$overallTestStatistics, c(-13.929113, -20.89367, -24.622317, -28.727412, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallPValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults3$overallEvents, c(4, 9, 14, 20, NA_real_)) expect_equal(x$stageResults3$overallSampleSizes, c(8, 18, 27, 38, NA_real_)) expect_equal(x$stageResults3$overallPi1, c(0.5, 0.5, 0.51851852, 0.52631579, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$testStatistics, c(-13.929113, -15.573222, -13.098993, -14.818182, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$pValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults3$combFisher, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults3$weightsFisher, c(1, 1, 1, 1, 1), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults3), NA))) expect_output(print(x$stageResults3)$show()) invisible(capture.output(expect_error(summary(x$stageResults3), NA))) expect_output(summary(x$stageResults3)$show()) x$stageResults3CodeBased <- eval(parse(text = getObjectRCode(x$stageResults3, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults3CodeBased$overallTestStatistics, x$stageResults3$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPValues, x$stageResults3$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallEvents, x$stageResults3$overallEvents, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallSampleSizes, x$stageResults3$overallSampleSizes, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPi1, x$stageResults3$overallPi1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$testStatistics, x$stageResults3$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$pValues, x$stageResults3$pValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$combFisher, x$stageResults3$combFisher, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$weightsFisher, x$stageResults3$weightsFisher, tolerance = 1e-05) expect_type(names(x$stageResults3), "character") df <- as.data.frame(x$stageResults3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("Creation of a dataset of rates using stage wise data (two groups)", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetRates} datasetOfRates2 <- getDataset( n2 = c(8, 10, 9, 11), n1 = c(11, 13, 12, 13), events2 = c(3, 5, 5, 6), events1 = c(10, 10, 12, 12) ) ## Comparison of the results of DatasetRates object 'datasetOfRates2' with expected results expect_equal(datasetOfRates2$stages, c(1, 1, 2, 2, 3, 3, 4, 4)) expect_equal(datasetOfRates2$groups, c(1, 2, 1, 2, 1, 2, 1, 2)) expect_equal(datasetOfRates2$subsets, c(NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_)) expect_equal(datasetOfRates2$sampleSizes, c(11, 8, 13, 10, 12, 9, 13, 11)) expect_equal(datasetOfRates2$events, c(10, 3, 10, 5, 12, 5, 12, 6)) expect_equal(datasetOfRates2$overallSampleSizes, c(11, 8, 24, 18, 36, 27, 49, 38)) expect_equal(datasetOfRates2$overallEvents, c(10, 3, 20, 8, 32, 13, 44, 19)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(datasetOfRates2), NA))) expect_output(print(datasetOfRates2)$show()) invisible(capture.output(expect_error(summary(datasetOfRates2), NA))) expect_output(summary(datasetOfRates2)$show()) datasetOfRates2CodeBased <- eval(parse(text = getObjectRCode(datasetOfRates2, stringWrapParagraphWidth = NULL))) expect_equal(datasetOfRates2CodeBased$stages, datasetOfRates2$stages, tolerance = 1e-05) expect_equal(datasetOfRates2CodeBased$groups, datasetOfRates2$groups, tolerance = 1e-05) expect_equal(datasetOfRates2CodeBased$subsets, datasetOfRates2$subsets, tolerance = 1e-05) expect_equal(datasetOfRates2CodeBased$sampleSizes, datasetOfRates2$sampleSizes, tolerance = 1e-05) expect_equal(datasetOfRates2CodeBased$events, datasetOfRates2$events, tolerance = 1e-05) expect_equal(datasetOfRates2CodeBased$overallSampleSizes, datasetOfRates2$overallSampleSizes, tolerance = 1e-05) expect_equal(datasetOfRates2CodeBased$overallEvents, datasetOfRates2$overallEvents, tolerance = 1e-05) expect_type(names(datasetOfRates2), "character") df <- as.data.frame(datasetOfRates2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(datasetOfRates2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of data.frame object 'datasetOfRates2$.data' with expected results expect_equal(datasetOfRates2$.data$stage, factor(c(1, 1, 2, 2, 3, 3, 4, 4))) expect_equal(datasetOfRates2$.data$group, factor(c(1, 2, 1, 2, 1, 2, 1, 2))) expect_equal(datasetOfRates2$.data$subset, factor(c(NA, NA, NA, NA, NA, NA, NA, NA))) expect_equal(datasetOfRates2$.data$sampleSize, c(11, 8, 13, 10, 12, 9, 13, 11)) expect_equal(datasetOfRates2$.data$event, c(10, 3, 10, 5, 12, 5, 12, 6)) expect_equal(datasetOfRates2$.data$overallSampleSize, c(11, 8, 24, 18, 36, 27, 49, 38)) expect_equal(datasetOfRates2$.data$overallEvent, c(10, 3, 20, 8, 32, 13, 44, 19)) x <- getMultipleStageResultsForDataset(datasetOfRates2, thetaH0 = 0.99) ## Comparison of the results of StageResultsRates object 'x$stageResults1' with expected results expect_equal(x$stageResults1$overallTestStatistics, c(-13.397899, -26.707477, -31.300879, -37.503444, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallPValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults1$overallEvents1, c(10, 20, 32, 44, NA_real_)) expect_equal(x$stageResults1$overallEvents2, c(3, 8, 13, 19, NA_real_)) expect_equal(x$stageResults1$overallSampleSizes1, c(11, 24, 36, 49, NA_real_)) expect_equal(x$stageResults1$overallSampleSizes2, c(8, 18, 27, 38, NA_real_)) expect_equal(x$stageResults1$overallPi1, c(0.90909091, 0.83333333, 0.88888889, 0.89795918, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallPi2, c(0.375, 0.44444444, 0.48148148, 0.5, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$testStatistics, c(-13.397899, -23.909016, -16.449119, -20.614826, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$pValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults1$effectSizes, c(0.53409091, 0.38888889, 0.40740741, 0.39795918, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults1), NA))) expect_output(print(x$stageResults1)$show()) invisible(capture.output(expect_error(summary(x$stageResults1), NA))) expect_output(summary(x$stageResults1)$show()) x$stageResults1CodeBased <- eval(parse(text = getObjectRCode(x$stageResults1, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults1CodeBased$overallTestStatistics, x$stageResults1$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPValues, x$stageResults1$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallEvents1, x$stageResults1$overallEvents1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallEvents2, x$stageResults1$overallEvents2, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallSampleSizes1, x$stageResults1$overallSampleSizes1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallSampleSizes2, x$stageResults1$overallSampleSizes2, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPi1, x$stageResults1$overallPi1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPi2, x$stageResults1$overallPi2, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$testStatistics, x$stageResults1$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$pValues, x$stageResults1$pValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$effectSizes, x$stageResults1$effectSizes, tolerance = 1e-05) expect_type(names(x$stageResults1), "character") df <- as.data.frame(x$stageResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsRates object 'x$stageResults2' with expected results expect_equal(x$stageResults2$overallTestStatistics, c(-13.397899, -26.707477, -31.300879, -37.503444, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallPValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults2$overallEvents1, c(10, 20, 32, 44, NA_real_)) expect_equal(x$stageResults2$overallEvents2, c(3, 8, 13, 19, NA_real_)) expect_equal(x$stageResults2$overallSampleSizes1, c(11, 24, 36, 49, NA_real_)) expect_equal(x$stageResults2$overallSampleSizes2, c(8, 18, 27, 38, NA_real_)) expect_equal(x$stageResults2$overallPi1, c(0.90909091, 0.83333333, 0.88888889, 0.89795918, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallPi2, c(0.375, 0.44444444, 0.48148148, 0.5, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$testStatistics, c(-13.397899, -23.909016, -16.449119, -20.614826, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$pValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults2$effectSizes, c(0.53409091, 0.38888889, 0.40740741, 0.39795918, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$combInverseNormal, c(-38.449394, -54.375655, -66.596305, -76.898789, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$weightsInverseNormal, c(0.4472136, 0.4472136, 0.4472136, 0.4472136, 0.4472136), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults2), NA))) expect_output(print(x$stageResults2)$show()) invisible(capture.output(expect_error(summary(x$stageResults2), NA))) expect_output(summary(x$stageResults2)$show()) x$stageResults2CodeBased <- eval(parse(text = getObjectRCode(x$stageResults2, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults2CodeBased$overallTestStatistics, x$stageResults2$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPValues, x$stageResults2$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallEvents1, x$stageResults2$overallEvents1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallEvents2, x$stageResults2$overallEvents2, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallSampleSizes1, x$stageResults2$overallSampleSizes1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallSampleSizes2, x$stageResults2$overallSampleSizes2, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPi1, x$stageResults2$overallPi1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPi2, x$stageResults2$overallPi2, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$testStatistics, x$stageResults2$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$pValues, x$stageResults2$pValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$effectSizes, x$stageResults2$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$combInverseNormal, x$stageResults2$combInverseNormal, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$weightsInverseNormal, x$stageResults2$weightsInverseNormal, tolerance = 1e-05) expect_type(names(x$stageResults2), "character") df <- as.data.frame(x$stageResults2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsRates object 'x$stageResults3' with expected results expect_equal(x$stageResults3$overallTestStatistics, c(-13.397899, -26.707477, -31.300879, -37.503444, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallPValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults3$overallEvents1, c(10, 20, 32, 44, NA_real_)) expect_equal(x$stageResults3$overallEvents2, c(3, 8, 13, 19, NA_real_)) expect_equal(x$stageResults3$overallSampleSizes1, c(11, 24, 36, 49, NA_real_)) expect_equal(x$stageResults3$overallSampleSizes2, c(8, 18, 27, 38, NA_real_)) expect_equal(x$stageResults3$overallPi1, c(0.90909091, 0.83333333, 0.88888889, 0.89795918, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallPi2, c(0.375, 0.44444444, 0.48148148, 0.5, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$testStatistics, c(-13.397899, -23.909016, -16.449119, -20.614826, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$pValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults3$effectSizes, c(0.53409091, 0.38888889, 0.40740741, 0.39795918, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$combFisher, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults3$weightsFisher, c(1, 1, 1, 1, 1), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults3), NA))) expect_output(print(x$stageResults3)$show()) invisible(capture.output(expect_error(summary(x$stageResults3), NA))) expect_output(summary(x$stageResults3)$show()) x$stageResults3CodeBased <- eval(parse(text = getObjectRCode(x$stageResults3, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults3CodeBased$overallTestStatistics, x$stageResults3$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPValues, x$stageResults3$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallEvents1, x$stageResults3$overallEvents1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallEvents2, x$stageResults3$overallEvents2, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallSampleSizes1, x$stageResults3$overallSampleSizes1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallSampleSizes2, x$stageResults3$overallSampleSizes2, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPi1, x$stageResults3$overallPi1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPi2, x$stageResults3$overallPi2, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$testStatistics, x$stageResults3$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$pValues, x$stageResults3$pValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$effectSizes, x$stageResults3$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$combFisher, x$stageResults3$combFisher, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$weightsFisher, x$stageResults3$weightsFisher, tolerance = 1e-05) expect_type(names(x$stageResults3), "character") df <- as.data.frame(x$stageResults3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("Creation of a dataset of rates using stage wise data (four groups)", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetRates} datasetOfRates3 <- getDataset( n1 = c(11, 13, 12, 13), n2 = c(8, 10, 9, 11), n3 = c(7, 10, 8, 9), n4 = c(9, 11, 5, 2), events1 = c(10, 10, 12, 12), events2 = c(3, 5, 5, 6), events3 = c(2, 4, 3, 5), events4 = c(3, 4, 3, 0) ) ## Comparison of the results of DatasetRates object 'datasetOfRates3' with expected results expect_equal(datasetOfRates3$stages, c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4)) expect_equal(datasetOfRates3$groups, c(1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4)) expect_equal(datasetOfRates3$subsets, c(NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_)) expect_equal(datasetOfRates3$sampleSizes, c(11, 8, 7, 9, 13, 10, 10, 11, 12, 9, 8, 5, 13, 11, 9, 2)) expect_equal(datasetOfRates3$events, c(10, 3, 2, 3, 10, 5, 4, 4, 12, 5, 3, 3, 12, 6, 5, 0)) expect_equal(datasetOfRates3$overallSampleSizes, c(11, 8, 7, 9, 24, 18, 17, 20, 36, 27, 25, 25, 49, 38, 34, 27)) expect_equal(datasetOfRates3$overallEvents, c(10, 3, 2, 3, 20, 8, 6, 7, 32, 13, 9, 10, 44, 19, 14, 10)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(datasetOfRates3), NA))) expect_output(print(datasetOfRates3)$show()) invisible(capture.output(expect_error(summary(datasetOfRates3), NA))) expect_output(summary(datasetOfRates3)$show()) datasetOfRates3CodeBased <- eval(parse(text = getObjectRCode(datasetOfRates3, stringWrapParagraphWidth = NULL))) expect_equal(datasetOfRates3CodeBased$stages, datasetOfRates3$stages, tolerance = 1e-05) expect_equal(datasetOfRates3CodeBased$groups, datasetOfRates3$groups, tolerance = 1e-05) expect_equal(datasetOfRates3CodeBased$subsets, datasetOfRates3$subsets, tolerance = 1e-05) expect_equal(datasetOfRates3CodeBased$sampleSizes, datasetOfRates3$sampleSizes, tolerance = 1e-05) expect_equal(datasetOfRates3CodeBased$events, datasetOfRates3$events, tolerance = 1e-05) expect_equal(datasetOfRates3CodeBased$overallSampleSizes, datasetOfRates3$overallSampleSizes, tolerance = 1e-05) expect_equal(datasetOfRates3CodeBased$overallEvents, datasetOfRates3$overallEvents, tolerance = 1e-05) expect_type(names(datasetOfRates3), "character") df <- as.data.frame(datasetOfRates3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(datasetOfRates3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of data.frame object 'datasetOfRates3$.data' with expected results expect_equal(datasetOfRates3$.data$stage, factor(c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4))) expect_equal(datasetOfRates3$.data$group, factor(c(1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4))) expect_equal(datasetOfRates3$.data$subset, factor(c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA))) expect_equal(datasetOfRates3$.data$sampleSize, c(11, 8, 7, 9, 13, 10, 10, 11, 12, 9, 8, 5, 13, 11, 9, 2)) expect_equal(datasetOfRates3$.data$event, c(10, 3, 2, 3, 10, 5, 4, 4, 12, 5, 3, 3, 12, 6, 5, 0)) expect_equal(datasetOfRates3$.data$overallSampleSize, c(11, 8, 7, 9, 24, 18, 17, 20, 36, 27, 25, 25, 49, 38, 34, 27)) expect_equal(datasetOfRates3$.data$overallEvent, c(10, 3, 2, 3, 20, 8, 6, 7, 32, 13, 9, 10, 44, 19, 14, 10)) }) test_that("Creation of a dataset of rates using overall data (two groups)", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetRates} datasetOfRates4 <- getDataset( overallSampleSizes1 = c(11, 24, 36, 49), overallSampleSizes2 = c(8, 18, 27, 38), overallEvents1 = c(10, 20, 32, 44), overallEvents2 = c(3, 8, 13, 19) ) ## Comparison of the results of DatasetRates object 'datasetOfRates4' with expected results expect_equal(datasetOfRates4$stages, c(1, 1, 2, 2, 3, 3, 4, 4)) expect_equal(datasetOfRates4$groups, c(1, 2, 1, 2, 1, 2, 1, 2)) expect_equal(datasetOfRates4$subsets, c(NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_)) expect_equal(datasetOfRates4$sampleSizes, c(11, 8, 13, 10, 12, 9, 13, 11)) expect_equal(datasetOfRates4$events, c(10, 3, 10, 5, 12, 5, 12, 6)) expect_equal(datasetOfRates4$overallSampleSizes, c(11, 8, 24, 18, 36, 27, 49, 38)) expect_equal(datasetOfRates4$overallEvents, c(10, 3, 20, 8, 32, 13, 44, 19)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(datasetOfRates4), NA))) expect_output(print(datasetOfRates4)$show()) invisible(capture.output(expect_error(summary(datasetOfRates4), NA))) expect_output(summary(datasetOfRates4)$show()) datasetOfRates4CodeBased <- eval(parse(text = getObjectRCode(datasetOfRates4, stringWrapParagraphWidth = NULL))) expect_equal(datasetOfRates4CodeBased$stages, datasetOfRates4$stages, tolerance = 1e-05) expect_equal(datasetOfRates4CodeBased$groups, datasetOfRates4$groups, tolerance = 1e-05) expect_equal(datasetOfRates4CodeBased$subsets, datasetOfRates4$subsets, tolerance = 1e-05) expect_equal(datasetOfRates4CodeBased$sampleSizes, datasetOfRates4$sampleSizes, tolerance = 1e-05) expect_equal(datasetOfRates4CodeBased$events, datasetOfRates4$events, tolerance = 1e-05) expect_equal(datasetOfRates4CodeBased$overallSampleSizes, datasetOfRates4$overallSampleSizes, tolerance = 1e-05) expect_equal(datasetOfRates4CodeBased$overallEvents, datasetOfRates4$overallEvents, tolerance = 1e-05) expect_type(names(datasetOfRates4), "character") df <- as.data.frame(datasetOfRates4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(datasetOfRates4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of data.frame object 'datasetOfRates4$.data' with expected results expect_equal(datasetOfRates4$.data$stage, factor(c(1, 1, 2, 2, 3, 3, 4, 4))) expect_equal(datasetOfRates4$.data$group, factor(c(1, 2, 1, 2, 1, 2, 1, 2))) expect_equal(datasetOfRates4$.data$subset, factor(c(NA, NA, NA, NA, NA, NA, NA, NA))) expect_equal(datasetOfRates4$.data$sampleSize, c(11, 8, 13, 10, 12, 9, 13, 11)) expect_equal(datasetOfRates4$.data$event, c(10, 3, 10, 5, 12, 5, 12, 6)) expect_equal(datasetOfRates4$.data$overallSampleSize, c(11, 8, 24, 18, 36, 27, 49, 38)) expect_equal(datasetOfRates4$.data$overallEvent, c(10, 3, 20, 8, 32, 13, 44, 19)) x <- getMultipleStageResultsForDataset(datasetOfRates4, thetaH0 = 0.99) ## Comparison of the results of StageResultsRates object 'x$stageResults1' with expected results expect_equal(x$stageResults1$overallTestStatistics, c(-13.397899, -26.707477, -31.300879, -37.503444, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallPValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults1$overallEvents1, c(10, 20, 32, 44, NA_real_)) expect_equal(x$stageResults1$overallEvents2, c(3, 8, 13, 19, NA_real_)) expect_equal(x$stageResults1$overallSampleSizes1, c(11, 24, 36, 49, NA_real_)) expect_equal(x$stageResults1$overallSampleSizes2, c(8, 18, 27, 38, NA_real_)) expect_equal(x$stageResults1$overallPi1, c(0.90909091, 0.83333333, 0.88888889, 0.89795918, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$overallPi2, c(0.375, 0.44444444, 0.48148148, 0.5, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$testStatistics, c(-13.397899, -23.909016, -16.449119, -20.614826, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$pValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults1$effectSizes, c(0.53409091, 0.38888889, 0.40740741, 0.39795918, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults1), NA))) expect_output(print(x$stageResults1)$show()) invisible(capture.output(expect_error(summary(x$stageResults1), NA))) expect_output(summary(x$stageResults1)$show()) x$stageResults1CodeBased <- eval(parse(text = getObjectRCode(x$stageResults1, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults1CodeBased$overallTestStatistics, x$stageResults1$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPValues, x$stageResults1$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallEvents1, x$stageResults1$overallEvents1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallEvents2, x$stageResults1$overallEvents2, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallSampleSizes1, x$stageResults1$overallSampleSizes1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallSampleSizes2, x$stageResults1$overallSampleSizes2, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPi1, x$stageResults1$overallPi1, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPi2, x$stageResults1$overallPi2, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$testStatistics, x$stageResults1$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$pValues, x$stageResults1$pValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$effectSizes, x$stageResults1$effectSizes, tolerance = 1e-05) expect_type(names(x$stageResults1), "character") df <- as.data.frame(x$stageResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsRates object 'x$stageResults2' with expected results expect_equal(x$stageResults2$overallTestStatistics, c(-13.397899, -26.707477, -31.300879, -37.503444, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallPValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults2$overallEvents1, c(10, 20, 32, 44, NA_real_)) expect_equal(x$stageResults2$overallEvents2, c(3, 8, 13, 19, NA_real_)) expect_equal(x$stageResults2$overallSampleSizes1, c(11, 24, 36, 49, NA_real_)) expect_equal(x$stageResults2$overallSampleSizes2, c(8, 18, 27, 38, NA_real_)) expect_equal(x$stageResults2$overallPi1, c(0.90909091, 0.83333333, 0.88888889, 0.89795918, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$overallPi2, c(0.375, 0.44444444, 0.48148148, 0.5, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$testStatistics, c(-13.397899, -23.909016, -16.449119, -20.614826, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$pValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults2$effectSizes, c(0.53409091, 0.38888889, 0.40740741, 0.39795918, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$combInverseNormal, c(-38.449394, -54.375655, -66.596305, -76.898789, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$weightsInverseNormal, c(0.4472136, 0.4472136, 0.4472136, 0.4472136, 0.4472136), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults2), NA))) expect_output(print(x$stageResults2)$show()) invisible(capture.output(expect_error(summary(x$stageResults2), NA))) expect_output(summary(x$stageResults2)$show()) x$stageResults2CodeBased <- eval(parse(text = getObjectRCode(x$stageResults2, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults2CodeBased$overallTestStatistics, x$stageResults2$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPValues, x$stageResults2$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallEvents1, x$stageResults2$overallEvents1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallEvents2, x$stageResults2$overallEvents2, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallSampleSizes1, x$stageResults2$overallSampleSizes1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallSampleSizes2, x$stageResults2$overallSampleSizes2, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPi1, x$stageResults2$overallPi1, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPi2, x$stageResults2$overallPi2, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$testStatistics, x$stageResults2$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$pValues, x$stageResults2$pValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$effectSizes, x$stageResults2$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$combInverseNormal, x$stageResults2$combInverseNormal, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$weightsInverseNormal, x$stageResults2$weightsInverseNormal, tolerance = 1e-05) expect_type(names(x$stageResults2), "character") df <- as.data.frame(x$stageResults2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsRates object 'x$stageResults3' with expected results expect_equal(x$stageResults3$overallTestStatistics, c(-13.397899, -26.707477, -31.300879, -37.503444, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallPValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults3$overallEvents1, c(10, 20, 32, 44, NA_real_)) expect_equal(x$stageResults3$overallEvents2, c(3, 8, 13, 19, NA_real_)) expect_equal(x$stageResults3$overallSampleSizes1, c(11, 24, 36, 49, NA_real_)) expect_equal(x$stageResults3$overallSampleSizes2, c(8, 18, 27, 38, NA_real_)) expect_equal(x$stageResults3$overallPi1, c(0.90909091, 0.83333333, 0.88888889, 0.89795918, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$overallPi2, c(0.375, 0.44444444, 0.48148148, 0.5, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$testStatistics, c(-13.397899, -23.909016, -16.449119, -20.614826, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$pValues, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults3$effectSizes, c(0.53409091, 0.38888889, 0.40740741, 0.39795918, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$combFisher, c(1, 1, 1, 1, NA_real_)) expect_equal(x$stageResults3$weightsFisher, c(1, 1, 1, 1, 1), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults3), NA))) expect_output(print(x$stageResults3)$show()) invisible(capture.output(expect_error(summary(x$stageResults3), NA))) expect_output(summary(x$stageResults3)$show()) x$stageResults3CodeBased <- eval(parse(text = getObjectRCode(x$stageResults3, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults3CodeBased$overallTestStatistics, x$stageResults3$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPValues, x$stageResults3$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallEvents1, x$stageResults3$overallEvents1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallEvents2, x$stageResults3$overallEvents2, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallSampleSizes1, x$stageResults3$overallSampleSizes1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallSampleSizes2, x$stageResults3$overallSampleSizes2, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPi1, x$stageResults3$overallPi1, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPi2, x$stageResults3$overallPi2, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$testStatistics, x$stageResults3$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$pValues, x$stageResults3$pValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$effectSizes, x$stageResults3$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$combFisher, x$stageResults3$combFisher, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$weightsFisher, x$stageResults3$weightsFisher, tolerance = 1e-05) expect_type(names(x$stageResults3), "character") df <- as.data.frame(x$stageResults3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("Creation of a dataset of rates using overall data (three groups)", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetRates} datasetOfRates5 <- getDataset( overallSampleSizes1 = c(11, 24, 36, 49), overallSampleSizes2 = c(8, 18, 27, 38), overallSampleSizes3 = c(8, 18, 27, 38), overallEvents1 = c(10, 20, 32, 44), overallEvents2 = c(3, 8, 13, 19), overallEvents3 = c(3, 7, 12, 20) ) ## Comparison of the results of DatasetRates object 'datasetOfRates5' with expected results expect_equal(datasetOfRates5$stages, c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4)) expect_equal(datasetOfRates5$groups, c(1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3)) expect_equal(datasetOfRates5$subsets, c(NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_)) expect_equal(datasetOfRates5$sampleSizes, c(11, 8, 8, 13, 10, 10, 12, 9, 9, 13, 11, 11)) expect_equal(datasetOfRates5$events, c(10, 3, 3, 10, 5, 4, 12, 5, 5, 12, 6, 8)) expect_equal(datasetOfRates5$overallSampleSizes, c(11, 8, 8, 24, 18, 18, 36, 27, 27, 49, 38, 38)) expect_equal(datasetOfRates5$overallEvents, c(10, 3, 3, 20, 8, 7, 32, 13, 12, 44, 19, 20)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(datasetOfRates5), NA))) expect_output(print(datasetOfRates5)$show()) invisible(capture.output(expect_error(summary(datasetOfRates5), NA))) expect_output(summary(datasetOfRates5)$show()) datasetOfRates5CodeBased <- eval(parse(text = getObjectRCode(datasetOfRates5, stringWrapParagraphWidth = NULL))) expect_equal(datasetOfRates5CodeBased$stages, datasetOfRates5$stages, tolerance = 1e-05) expect_equal(datasetOfRates5CodeBased$groups, datasetOfRates5$groups, tolerance = 1e-05) expect_equal(datasetOfRates5CodeBased$subsets, datasetOfRates5$subsets, tolerance = 1e-05) expect_equal(datasetOfRates5CodeBased$sampleSizes, datasetOfRates5$sampleSizes, tolerance = 1e-05) expect_equal(datasetOfRates5CodeBased$events, datasetOfRates5$events, tolerance = 1e-05) expect_equal(datasetOfRates5CodeBased$overallSampleSizes, datasetOfRates5$overallSampleSizes, tolerance = 1e-05) expect_equal(datasetOfRates5CodeBased$overallEvents, datasetOfRates5$overallEvents, tolerance = 1e-05) expect_type(names(datasetOfRates5), "character") df <- as.data.frame(datasetOfRates5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(datasetOfRates5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of data.frame object 'datasetOfRates5$.data' with expected results expect_equal(datasetOfRates5$.data$stage, factor(c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4))) expect_equal(datasetOfRates5$.data$group, factor(c(1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3))) expect_equal(datasetOfRates5$.data$subset, factor(c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA))) expect_equal(datasetOfRates5$.data$sampleSize, c(11, 8, 8, 13, 10, 10, 12, 9, 9, 13, 11, 11)) expect_equal(datasetOfRates5$.data$event, c(10, 3, 3, 10, 5, 4, 12, 5, 5, 12, 6, 8)) expect_equal(datasetOfRates5$.data$overallSampleSize, c(11, 8, 8, 24, 18, 18, 36, 27, 27, 49, 38, 38)) expect_equal(datasetOfRates5$.data$overallEvent, c(10, 3, 3, 20, 8, 7, 32, 13, 12, 44, 19, 20)) }) test_that("Trim command works as expected for rates", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetRates} datasetOfRatesExpected <- getDataset( overallSampleSizes1 = c(11, 24, 36, 49), overallSampleSizes2 = c(8, 18, 27, 38), overallSampleSizes3 = c(8, 18, 27, 38), overallEvents1 = c(10, 20, 32, 44), overallEvents2 = c(3, 8, 13, 19), overallEvents3 = c(3, 7, 12, 20) ) datasetOfRates <- getDataset( overallSampleSizes1 = c(11, 24, 36, 49), overallSampleSizes2 = c(8, 18, 27, 38), overallSampleSizes3 = c(8, 18, 27, 38), overallEvents1 = c(10, 20, 32, 44), overallEvents2 = c(3, 8, 13, 19), overallEvents3 = c(3, 7, 12, 20) ) datasetOfRates$.fillWithNAs(6) datasetOfRates$.trim(4) expect_equal(datasetOfRates$stages, datasetOfRatesExpected$stages) expect_equal(datasetOfRates$groups, datasetOfRatesExpected$groups) expect_equal(datasetOfRates$overallEvents, datasetOfRatesExpected$overallEvents) expect_equal(datasetOfRates$events, datasetOfRatesExpected$events) expect_equal(datasetOfRates$.data$stage, datasetOfRatesExpected$.data$stage) expect_equal(datasetOfRates$.data$group, datasetOfRatesExpected$.data$group) expect_equal(datasetOfRates$.data$overallEvent, datasetOfRatesExpected$.data$overallEvent) expect_equal(datasetOfRates$.data$event, datasetOfRatesExpected$.data$event) }) test_that("Creation of a dataset of survival data using stage wise data", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetSurvival} datasetSurvival1 <- getDataset( events = c(8, 7, 4, 12), allocationRatios = c(1, 1, 1, 3.58333333333333), logRanks = c(1.520, 1.273, 0.503, 0.887) ) ## Comparison of the results of DatasetSurvival object 'datasetSurvival1' with expected results expect_equal(datasetSurvival1$stages, c(1, 2, 3, 4)) expect_equal(datasetSurvival1$groups, c(1, 1, 1, 1)) expect_equal(datasetSurvival1$subsets, c(NA_character_, NA_character_, NA_character_, NA_character_)) expect_equal(datasetSurvival1$overallEvents, c(8, 15, 19, 31)) expect_equal(datasetSurvival1$overallAllocationRatios, c(1, 1, 1, 2), tolerance = 1e-07) expect_equal(datasetSurvival1$overallLogRanks, c(1.52, 1.9796756, 1.9897802, 2.1096275), tolerance = 1e-07) expect_equal(datasetSurvival1$events, c(8, 7, 4, 12)) expect_equal(datasetSurvival1$allocationRatios, c(1, 1, 1, 3.5833333), tolerance = 1e-07) expect_equal(datasetSurvival1$logRanks, c(1.52, 1.273, 0.503, 0.887), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(datasetSurvival1), NA))) expect_output(print(datasetSurvival1)$show()) invisible(capture.output(expect_error(summary(datasetSurvival1), NA))) expect_output(summary(datasetSurvival1)$show()) datasetSurvival1CodeBased <- eval(parse(text = getObjectRCode(datasetSurvival1, stringWrapParagraphWidth = NULL))) expect_equal(datasetSurvival1CodeBased$stages, datasetSurvival1$stages, tolerance = 1e-05) expect_equal(datasetSurvival1CodeBased$groups, datasetSurvival1$groups, tolerance = 1e-05) expect_equal(datasetSurvival1CodeBased$subsets, datasetSurvival1$subsets, tolerance = 1e-05) expect_equal(datasetSurvival1CodeBased$overallEvents, datasetSurvival1$overallEvents, tolerance = 1e-05) expect_equal(datasetSurvival1CodeBased$overallAllocationRatios, datasetSurvival1$overallAllocationRatios, tolerance = 1e-05) expect_equal(datasetSurvival1CodeBased$overallLogRanks, datasetSurvival1$overallLogRanks, tolerance = 1e-05) expect_equal(datasetSurvival1CodeBased$events, datasetSurvival1$events, tolerance = 1e-05) expect_equal(datasetSurvival1CodeBased$allocationRatios, datasetSurvival1$allocationRatios, tolerance = 1e-05) expect_equal(datasetSurvival1CodeBased$logRanks, datasetSurvival1$logRanks, tolerance = 1e-05) expect_type(names(datasetSurvival1), "character") df <- as.data.frame(datasetSurvival1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(datasetSurvival1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of data.frame object 'datasetSurvival1$.data' with expected results expect_equal(datasetSurvival1$.data$stage, factor(c(1, 2, 3, 4))) expect_equal(datasetSurvival1$.data$group, factor(c(1, 1, 1, 1))) expect_equal(datasetSurvival1$.data$subset, factor(c(NA, NA, NA, NA))) expect_equal(datasetSurvival1$.data$overallEvent, c(8, 15, 19, 31)) expect_equal(datasetSurvival1$.data$overallAllocationRatio, c(1, 1, 1, 2), tolerance = 1e-07) expect_equal(datasetSurvival1$.data$overallLogRank, c(1.52, 1.9796756, 1.9897802, 2.1096275), tolerance = 1e-07) expect_equal(datasetSurvival1$.data$event, c(8, 7, 4, 12)) expect_equal(datasetSurvival1$.data$allocationRatio, c(1, 1, 1, 3.5833333), tolerance = 1e-07) expect_equal(datasetSurvival1$.data$logRank, c(1.52, 1.273, 0.503, 0.887), tolerance = 1e-07) x <- getMultipleStageResultsForDataset(datasetSurvival1) ## Comparison of the results of StageResultsSurvival object 'x$stageResults1' with expected results expect_equal(x$stageResults1$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallEvents, c(8, 15, 19, 31, NA_real_)) expect_equal(x$stageResults1$overallAllocationRatios, c(1, 1, 1, 2, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$events, c(8, 7, 4, 12, NA_real_)) expect_equal(x$stageResults1$allocationRatios, c(1, 1, 1, 3.5833333, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$effectSizes, c(2.9294137, 2.7795807, 2.4917213, 2.2339445, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults1), NA))) expect_output(print(x$stageResults1)$show()) invisible(capture.output(expect_error(summary(x$stageResults1), NA))) expect_output(summary(x$stageResults1)$show()) x$stageResults1CodeBased <- eval(parse(text = getObjectRCode(x$stageResults1, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults1CodeBased$overallTestStatistics, x$stageResults1$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPValues, x$stageResults1$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallEvents, x$stageResults1$overallEvents, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallAllocationRatios, x$stageResults1$overallAllocationRatios, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$events, x$stageResults1$events, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$allocationRatios, x$stageResults1$allocationRatios, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$testStatistics, x$stageResults1$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$pValues, x$stageResults1$pValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPValues, x$stageResults1$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$effectSizes, x$stageResults1$effectSizes, tolerance = 1e-05) expect_type(names(x$stageResults1), "character") df <- as.data.frame(x$stageResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsSurvival object 'x$stageResults2' with expected results expect_equal(x$stageResults2$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallEvents, c(8, 15, 19, 31, NA_real_)) expect_equal(x$stageResults2$overallAllocationRatios, c(1, 1, 1, 2, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$events, c(8, 7, 4, 12, NA_real_)) expect_equal(x$stageResults2$allocationRatios, c(1, 1, 1, 3.5833333, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$effectSizes, c(2.9294137, 2.7795807, 2.4917213, 2.2339445, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$combInverseNormal, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$weightsInverseNormal, c(0.4472136, 0.4472136, 0.4472136, 0.4472136, 0.4472136), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults2), NA))) expect_output(print(x$stageResults2)$show()) invisible(capture.output(expect_error(summary(x$stageResults2), NA))) expect_output(summary(x$stageResults2)$show()) x$stageResults2CodeBased <- eval(parse(text = getObjectRCode(x$stageResults2, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults2CodeBased$overallTestStatistics, x$stageResults2$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPValues, x$stageResults2$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallEvents, x$stageResults2$overallEvents, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallAllocationRatios, x$stageResults2$overallAllocationRatios, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$events, x$stageResults2$events, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$allocationRatios, x$stageResults2$allocationRatios, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$testStatistics, x$stageResults2$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$pValues, x$stageResults2$pValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPValues, x$stageResults2$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$effectSizes, x$stageResults2$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$combInverseNormal, x$stageResults2$combInverseNormal, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$weightsInverseNormal, x$stageResults2$weightsInverseNormal, tolerance = 1e-05) expect_type(names(x$stageResults2), "character") df <- as.data.frame(x$stageResults2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsSurvival object 'x$stageResults3' with expected results expect_equal(x$stageResults3$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallEvents, c(8, 15, 19, 31, NA_real_)) expect_equal(x$stageResults3$overallAllocationRatios, c(1, 1, 1, 2, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$events, c(8, 7, 4, 12, NA_real_)) expect_equal(x$stageResults3$allocationRatios, c(1, 1, 1, 3.5833333, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$effectSizes, c(2.9294137, 2.7795807, 2.4917213, 2.2339445, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$combFisher, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$weightsFisher, c(1, 1, 1, 1, 1), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults3), NA))) expect_output(print(x$stageResults3)$show()) invisible(capture.output(expect_error(summary(x$stageResults3), NA))) expect_output(summary(x$stageResults3)$show()) x$stageResults3CodeBased <- eval(parse(text = getObjectRCode(x$stageResults3, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults3CodeBased$overallTestStatistics, x$stageResults3$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPValues, x$stageResults3$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallEvents, x$stageResults3$overallEvents, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallAllocationRatios, x$stageResults3$overallAllocationRatios, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$events, x$stageResults3$events, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$allocationRatios, x$stageResults3$allocationRatios, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$testStatistics, x$stageResults3$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$pValues, x$stageResults3$pValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPValues, x$stageResults3$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$effectSizes, x$stageResults3$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$combFisher, x$stageResults3$combFisher, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$weightsFisher, x$stageResults3$weightsFisher, tolerance = 1e-05) expect_type(names(x$stageResults3), "character") df <- as.data.frame(x$stageResults3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } expect_equal(factor(datasetSurvival1$stages), datasetSurvival1$.data$stage, tolerance = 1e-07) expect_equal(factor(datasetSurvival1$groups), datasetSurvival1$.data$group, tolerance = 1e-07) expect_equal(datasetSurvival1$events, datasetSurvival1$.data$event, tolerance = 1e-07) expect_equal(datasetSurvival1$allocationRatios, datasetSurvival1$.data$allocationRatio, tolerance = 1e-07) expect_equal(datasetSurvival1$logRanks, datasetSurvival1$.data$logRank, tolerance = 1e-07) expect_equal(datasetSurvival1$overallEvents, datasetSurvival1$.data$overallEvent, tolerance = 1e-07) expect_equal(datasetSurvival1$overallAllocationRatios, datasetSurvival1$.data$overallAllocationRatio, tolerance = 1e-07) expect_equal(datasetSurvival1$overallLogRanks, datasetSurvival1$.data$overallLogRank, tolerance = 1e-07) }) test_that("Creation of a dataset of survival data using overall data", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetSurvival} datasetSurvival2 <- getDataset( overallEvents = c(8, 15, 19, 31), overallAllocationRatios = c(1, 1, 1, 2), overallLogRanks = c(1.52, 1.98, 1.99, 2.11) ) ## Comparison of the results of DatasetSurvival object 'datasetSurvival2' with expected results expect_equal(datasetSurvival2$stages, c(1, 2, 3, 4)) expect_equal(datasetSurvival2$groups, c(1, 1, 1, 1)) expect_equal(datasetSurvival2$subsets, c(NA_character_, NA_character_, NA_character_, NA_character_)) expect_equal(datasetSurvival2$overallEvents, c(8, 15, 19, 31)) expect_equal(datasetSurvival2$overallAllocationRatios, c(1, 1, 1, 2)) expect_equal(datasetSurvival2$overallLogRanks, c(1.52, 1.98, 1.99, 2.11), tolerance = 1e-07) expect_equal(datasetSurvival2$events, c(8, 7, 4, 12)) expect_equal(datasetSurvival2$allocationRatios, c(1, 1, 1, 3.5833333), tolerance = 1e-07) expect_equal(datasetSurvival2$logRanks, c(1.52, 1.2734749, 0.50285094, 0.8873221), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(datasetSurvival2), NA))) expect_output(print(datasetSurvival2)$show()) invisible(capture.output(expect_error(summary(datasetSurvival2), NA))) expect_output(summary(datasetSurvival2)$show()) datasetSurvival2CodeBased <- eval(parse(text = getObjectRCode(datasetSurvival2, stringWrapParagraphWidth = NULL))) expect_equal(datasetSurvival2CodeBased$stages, datasetSurvival2$stages, tolerance = 1e-05) expect_equal(datasetSurvival2CodeBased$groups, datasetSurvival2$groups, tolerance = 1e-05) expect_equal(datasetSurvival2CodeBased$subsets, datasetSurvival2$subsets, tolerance = 1e-05) expect_equal(datasetSurvival2CodeBased$overallEvents, datasetSurvival2$overallEvents, tolerance = 1e-05) expect_equal(datasetSurvival2CodeBased$overallAllocationRatios, datasetSurvival2$overallAllocationRatios, tolerance = 1e-05) expect_equal(datasetSurvival2CodeBased$overallLogRanks, datasetSurvival2$overallLogRanks, tolerance = 1e-05) expect_equal(datasetSurvival2CodeBased$events, datasetSurvival2$events, tolerance = 1e-05) expect_equal(datasetSurvival2CodeBased$allocationRatios, datasetSurvival2$allocationRatios, tolerance = 1e-05) expect_equal(datasetSurvival2CodeBased$logRanks, datasetSurvival2$logRanks, tolerance = 1e-05) expect_type(names(datasetSurvival2), "character") df <- as.data.frame(datasetSurvival2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(datasetSurvival2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of data.frame object 'datasetSurvival2$.data' with expected results expect_equal(datasetSurvival2$.data$stage, factor(c(1, 2, 3, 4))) expect_equal(datasetSurvival2$.data$group, factor(c(1, 1, 1, 1))) expect_equal(datasetSurvival2$.data$subset, factor(c(NA, NA, NA, NA))) expect_equal(datasetSurvival2$.data$overallEvent, c(8, 15, 19, 31)) expect_equal(datasetSurvival2$.data$overallAllocationRatio, c(1, 1, 1, 2)) expect_equal(datasetSurvival2$.data$overallLogRank, c(1.52, 1.98, 1.99, 2.11), tolerance = 1e-07) expect_equal(datasetSurvival2$.data$event, c(8, 7, 4, 12)) expect_equal(datasetSurvival2$.data$allocationRatio, c(1, 1, 1, 3.5833333), tolerance = 1e-07) expect_equal(datasetSurvival2$.data$logRank, c(1.52, 1.2734749, 0.50285094, 0.8873221), tolerance = 1e-07) x <- getMultipleStageResultsForDataset(datasetSurvival2) ## Comparison of the results of StageResultsSurvival object 'x$stageResults1' with expected results expect_equal(x$stageResults1$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallEvents, c(8, 15, 19, 31, NA_real_)) expect_equal(x$stageResults1$overallAllocationRatios, c(1, 1, 1, 2, NA_real_)) expect_equal(x$stageResults1$events, c(8, 7, 4, 12, NA_real_)) expect_equal(x$stageResults1$allocationRatios, c(1, 1, 1, 3.5833333, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults1$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults1$effectSizes, c(2.9294137, 2.7800464, 2.4919726, 2.2342616, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults1), NA))) expect_output(print(x$stageResults1)$show()) invisible(capture.output(expect_error(summary(x$stageResults1), NA))) expect_output(summary(x$stageResults1)$show()) x$stageResults1CodeBased <- eval(parse(text = getObjectRCode(x$stageResults1, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults1CodeBased$overallTestStatistics, x$stageResults1$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPValues, x$stageResults1$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallEvents, x$stageResults1$overallEvents, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallAllocationRatios, x$stageResults1$overallAllocationRatios, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$events, x$stageResults1$events, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$allocationRatios, x$stageResults1$allocationRatios, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$testStatistics, x$stageResults1$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$pValues, x$stageResults1$pValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$overallPValues, x$stageResults1$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults1CodeBased$effectSizes, x$stageResults1$effectSizes, tolerance = 1e-05) expect_type(names(x$stageResults1), "character") df <- as.data.frame(x$stageResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsSurvival object 'x$stageResults2' with expected results expect_equal(x$stageResults2$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallEvents, c(8, 15, 19, 31, NA_real_)) expect_equal(x$stageResults2$overallAllocationRatios, c(1, 1, 1, 2, NA_real_)) expect_equal(x$stageResults2$events, c(8, 7, 4, 12, NA_real_)) expect_equal(x$stageResults2$allocationRatios, c(1, 1, 1, 3.5833333, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$effectSizes, c(2.9294137, 2.7800464, 2.4919726, 2.2342616, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults2$combInverseNormal, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults2$weightsInverseNormal, c(0.4472136, 0.4472136, 0.4472136, 0.4472136, 0.4472136), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults2), NA))) expect_output(print(x$stageResults2)$show()) invisible(capture.output(expect_error(summary(x$stageResults2), NA))) expect_output(summary(x$stageResults2)$show()) x$stageResults2CodeBased <- eval(parse(text = getObjectRCode(x$stageResults2, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults2CodeBased$overallTestStatistics, x$stageResults2$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPValues, x$stageResults2$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallEvents, x$stageResults2$overallEvents, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallAllocationRatios, x$stageResults2$overallAllocationRatios, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$events, x$stageResults2$events, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$allocationRatios, x$stageResults2$allocationRatios, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$testStatistics, x$stageResults2$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$pValues, x$stageResults2$pValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$overallPValues, x$stageResults2$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$effectSizes, x$stageResults2$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$combInverseNormal, x$stageResults2$combInverseNormal, tolerance = 1e-05) expect_equal(x$stageResults2CodeBased$weightsInverseNormal, x$stageResults2$weightsInverseNormal, tolerance = 1e-05) expect_type(names(x$stageResults2), "character") df <- as.data.frame(x$stageResults2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of StageResultsSurvival object 'x$stageResults3' with expected results expect_equal(x$stageResults3$overallTestStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallEvents, c(8, 15, 19, 31, NA_real_)) expect_equal(x$stageResults3$overallAllocationRatios, c(1, 1, 1, 2, NA_real_)) expect_equal(x$stageResults3$events, c(8, 7, 4, 12, NA_real_)) expect_equal(x$stageResults3$allocationRatios, c(1, 1, 1, 3.5833333, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$testStatistics, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$pValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$overallPValues, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$effectSizes, c(2.9294137, 2.7800464, 2.4919726, 2.2342616, NA_real_), tolerance = 1e-07) expect_equal(x$stageResults3$combFisher, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$stageResults3$weightsFisher, c(1, 1, 1, 1, 1), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x$stageResults3), NA))) expect_output(print(x$stageResults3)$show()) invisible(capture.output(expect_error(summary(x$stageResults3), NA))) expect_output(summary(x$stageResults3)$show()) x$stageResults3CodeBased <- eval(parse(text = getObjectRCode(x$stageResults3, stringWrapParagraphWidth = NULL))) expect_equal(x$stageResults3CodeBased$overallTestStatistics, x$stageResults3$overallTestStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPValues, x$stageResults3$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallEvents, x$stageResults3$overallEvents, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallAllocationRatios, x$stageResults3$overallAllocationRatios, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$events, x$stageResults3$events, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$allocationRatios, x$stageResults3$allocationRatios, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$testStatistics, x$stageResults3$testStatistics, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$pValues, x$stageResults3$pValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$overallPValues, x$stageResults3$overallPValues, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$effectSizes, x$stageResults3$effectSizes, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$combFisher, x$stageResults3$combFisher, tolerance = 1e-05) expect_equal(x$stageResults3CodeBased$weightsFisher, x$stageResults3$weightsFisher, tolerance = 1e-05) expect_type(names(x$stageResults3), "character") df <- as.data.frame(x$stageResults3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x$stageResults3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } datasetSurvival3 <- getDataset( events1 = c(25, 32), events2 = c(18, NA), events3 = c(22, 36), logRanks1 = -c(2.2,1.8), logRanks2 = -c(1.99, NA), logRanks3 = -c(2.32, 2.11) ) ## Comparison of the results of DatasetSurvival object 'datasetSurvival3' with expected results expect_equal(datasetSurvival3$stages, c(1, 1, 1, 2, 2, 2)) expect_equal(datasetSurvival3$groups, c(1, 2, 3, 1, 2, 3)) expect_equal(datasetSurvival3$subsets, c(NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_)) expect_equal(datasetSurvival3$overallEvents, c(25, 18, 22, 57, NA_real_, 58)) expect_equal(datasetSurvival3$overallAllocationRatios, c(1, 1, 1, 1, NA_real_, 1)) expect_equal(datasetSurvival3$overallLogRanks, c(-2.2, -1.99, -2.32, -2.8056692, NA_real_, -3.0911851), tolerance = 1e-07) expect_equal(datasetSurvival3$events, c(25, 18, 22, 32, NA_real_, 36)) expect_equal(datasetSurvival3$allocationRatios, c(1, 1, 1, 1, NA_real_, 1)) expect_equal(datasetSurvival3$logRanks, c(-2.2, -1.99, -2.32, -1.8, NA_real_, -2.11), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(datasetSurvival3), NA))) expect_output(print(datasetSurvival3)$show()) invisible(capture.output(expect_error(summary(datasetSurvival3), NA))) expect_output(summary(datasetSurvival3)$show()) datasetSurvival3CodeBased <- eval(parse(text = getObjectRCode(datasetSurvival3, stringWrapParagraphWidth = NULL))) expect_equal(datasetSurvival3CodeBased$stages, datasetSurvival3$stages, tolerance = 1e-05) expect_equal(datasetSurvival3CodeBased$groups, datasetSurvival3$groups, tolerance = 1e-05) expect_equal(datasetSurvival3CodeBased$subsets, datasetSurvival3$subsets, tolerance = 1e-05) expect_equal(datasetSurvival3CodeBased$overallEvents, datasetSurvival3$overallEvents, tolerance = 1e-05) expect_equal(datasetSurvival3CodeBased$overallAllocationRatios, datasetSurvival3$overallAllocationRatios, tolerance = 1e-05) expect_equal(datasetSurvival3CodeBased$overallLogRanks, datasetSurvival3$overallLogRanks, tolerance = 1e-05) expect_equal(datasetSurvival3CodeBased$events, datasetSurvival3$events, tolerance = 1e-05) expect_equal(datasetSurvival3CodeBased$allocationRatios, datasetSurvival3$allocationRatios, tolerance = 1e-05) expect_equal(datasetSurvival3CodeBased$logRanks, datasetSurvival3$logRanks, tolerance = 1e-05) expect_type(names(datasetSurvival3), "character") df <- as.data.frame(datasetSurvival3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(datasetSurvival3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ## Comparison of the results of data.frame object 'datasetSurvival3$.data' with expected results expect_equal(datasetSurvival3$.data$stage, factor(c(1, 1, 1, 2, 2, 2))) expect_equal(datasetSurvival3$.data$group, factor(c(1, 2, 3, 1, 2, 3))) expect_equal(datasetSurvival3$.data$subset, factor(c(NA, NA, NA, NA, NA, NA))) expect_equal(datasetSurvival3$.data$overallEvent, c(25, 18, 22, 57, NA_real_, 58)) expect_equal(datasetSurvival3$.data$overallAllocationRatio, c(1, 1, 1, 1, NA_real_, 1)) expect_equal(datasetSurvival3$.data$overallLogRank, c(-2.2, -1.99, -2.32, -2.8056692, NA_real_, -3.0911851), tolerance = 1e-07) expect_equal(datasetSurvival3$.data$event, c(25, 18, 22, 32, NA_real_, 36)) expect_equal(datasetSurvival3$.data$allocationRatio, c(1, 1, 1, 1, NA_real_, 1)) expect_equal(datasetSurvival3$.data$logRank, c(-2.2, -1.99, -2.32, -1.8, NA_real_, -2.11), tolerance = 1e-07) }) test_that("Trim command works as expected for suvival data", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetSurvival} dataExampleSurvivalExpected <- getDataset( events1 = c(25, 32), events2 = c(18, NA), events3 = c(22, 36), logRanks1 = c(2.2,1.8), logRanks2 = c(1.99, NA), logRanks3 = c(2.32, 2.11) ) dataExampleSurvival <- getDataset( events1 = c(25, 32), events2 = c(18, NA), events3 = c(22, 36), logRanks1 = c(2.2,1.8), logRanks2 = c(1.99, NA), logRanks3 = c(2.32, 2.11) ) dataExampleSurvival$.fillWithNAs(4) dataExampleSurvival$.trim(2) expect_equal(dataExampleSurvival$stages, dataExampleSurvivalExpected$stages) expect_equal(dataExampleSurvival$groups, dataExampleSurvivalExpected$groups) expect_equal(dataExampleSurvival$overallEvents, dataExampleSurvivalExpected$overallEvents) expect_equal(dataExampleSurvival$overallAllocationRatios, dataExampleSurvivalExpected$overallAllocationRatios) expect_equal(dataExampleSurvival$overallLogRanks, dataExampleSurvivalExpected$overallLogRanks, tolerance = 1e-07) expect_equal(dataExampleSurvival$events, dataExampleSurvivalExpected$events) expect_equal(dataExampleSurvival$allocationRatios, dataExampleSurvivalExpected$allocationRatios) expect_equal(dataExampleSurvival$logRanks, dataExampleSurvivalExpected$logRanks, tolerance = 1e-07) expect_equal(dataExampleSurvival$.data$stage, dataExampleSurvivalExpected$.data$stage) expect_equal(dataExampleSurvival$.data$group, dataExampleSurvivalExpected$.data$group) expect_equal(dataExampleSurvival$.data$overallEvent, dataExampleSurvivalExpected$.data$overallEvent) expect_equal(dataExampleSurvival$.data$overallAllocationRatio, dataExampleSurvivalExpected$.data$overallAllocationRatio) expect_equal(dataExampleSurvival$.data$overallLogRank, dataExampleSurvivalExpected$.data$overallLogRank, tolerance = 1e-07) expect_equal(dataExampleSurvival$.data$event, dataExampleSurvivalExpected$.data$event) expect_equal(dataExampleSurvival$.data$allocationRatio, dataExampleSurvivalExpected$.data$allocationRatio) expect_equal(dataExampleSurvival$.data$logRank, dataExampleSurvivalExpected$.data$logRank, tolerance = 1e-07) }) test_that("Dataset functions 'getNumberOfStages' and 'getNumberOfGroups' work as expected for means", { # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetMeans} data1 <- getDataset( overallN1 = c(22, 33, NA), overallN2 = c(20, 34, 56), overallN3 = c(22, 31, 52), overallMeans1 = c(1.64, 1.54, NA), overallMeans2 = c(1.7, 1.5, 1.77), overallMeans3 = c(2.5, 2.06, 2.99), overallStDevs1 = c(1.5, 1.9, NA), overallStDevs2 = c(1.3, 1.3, 1.1), overallStDevs3 = c(1, 1.3, 1.8)) expect_equal(data1$getNumberOfStages(), 3) expect_equal(data1$getNumberOfStages(FALSE), 3) expect_equal(data1$getNumberOfGroups(), 3) expect_equal(data1$getNumberOfGroups(survivalCorrectionEnabled = FALSE), 3) .skipTestIfDisabled() data2 <- getDataset( overallN1 = c(22, 33, 55), overallN2 = c(20, 34, 56), overallN3 = c(22, 31, 52), overallMeans1 = c(1.64, 1.54, 2.10), overallMeans2 = c(1.7, 1.5, 1.77), overallMeans3 = c(2.5, 2.06, 2.99), overallStDevs1 = c(1.5, 1.9, 1.7), overallStDevs2 = c(1.3, 1.3, 1.1), overallStDevs3 = c(1, 1.3, 1.8)) expect_equal(data2$getNumberOfStages(), 3) expect_equal(data2$getNumberOfStages(FALSE), 3) expect_equal(data2$getNumberOfGroups(), 3) expect_equal(data2$getNumberOfGroups(survivalCorrectionEnabled = FALSE), 3) data3 <- getDataset( overallN1 = c(22, 33, 55), overallN2 = c(20, 34, 56), overallN3 = c(22, 31, 52), overallMeans1 = c(1.64, 1.54, 2.10), overallMeans2 = c(1.7, 1.5, 1.77), overallMeans3 = c(2.5, 2.06, 2.99), overallStDevs1 = c(1.5, 1.9, 1.7), overallStDevs2 = c(1.3, 1.3, 1.1), overallStDevs3 = c(1, 1.3, 1.8)) expect_equal(data3$getNumberOfStages(), 3) expect_equal(data3$getNumberOfStages(FALSE), 3) expect_equal(data3$getNumberOfGroups(), 3) expect_equal(data3$getNumberOfGroups(survivalCorrectionEnabled = FALSE), 3) }) test_that("Dataset functions 'getNumberOfStages' and 'getNumberOfGroups' work as expected for rates", { # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetRates} data1 <- getDataset( overallSampleSizes1 = c(11, 24, 36, NA), overallSampleSizes2 = c(8, 18, 27, NA), overallSampleSizes3 = c(8, 18, 27, NA), overallEvents1 = c(10, 20, 32, NA), overallEvents2 = c(3, 8, 13, NA), overallEvents3 = c(3, 7, 12, NA)) expect_equal(data1$getNumberOfStages(), 3) expect_equal(data1$getNumberOfStages(FALSE), 4) expect_equal(data1$getNumberOfGroups(), 3) expect_equal(data1$getNumberOfGroups(survivalCorrectionEnabled = FALSE), 3) .skipTestIfDisabled() data2 <- getDataset( overallSampleSizes1 = c(11, 24, 36, 49), overallSampleSizes2 = c(8, 18, 27, 38), overallSampleSizes3 = c(8, 18, 27, 38), overallEvents1 = c(10, 20, 32, 44), overallEvents2 = c(3, 8, 13, 19), overallEvents3 = c(3, 7, 12, 20)) expect_equal(data2$getNumberOfStages(), 4) expect_equal(data2$getNumberOfStages(FALSE), 4) expect_equal(data2$getNumberOfGroups(), 3) expect_equal(data2$getNumberOfGroups(survivalCorrectionEnabled = FALSE), 3) data3 <- getDataset( overallSampleSizes1 = c(11, 24, 36, 49), overallSampleSizes2 = c(8, 18, NA, NA), overallSampleSizes3 = c(8, 18, NA, NA), overallSampleSizes4 = c(8, 18, 27, 38), overallEvents1 = c(10, 20, 32, 44), overallEvents2 = c(3, 8, NA, NA), overallEvents3 = c(3, 8, NA, NA), overallEvents4 = c(3, 7, 12, 20)) expect_equal(data3$getNumberOfStages(), 4) expect_equal(data3$getNumberOfStages(FALSE), 4) expect_equal(data3$getNumberOfGroups(), 4) expect_equal(data3$getNumberOfGroups(survivalCorrectionEnabled = FALSE), 4) data4 <- getDataset( overallSampleSizes1 = c(11, 24, 36), overallSampleSizes2 = c(8, 18, 27), overallEvents1 = c(10, 20, 32), overallEvents2 = c(3, 7, 12)) expect_equal(data4$getNumberOfStages(), 3) expect_equal(data4$getNumberOfStages(FALSE), 3) expect_equal(data4$getNumberOfGroups(), 2) expect_equal(data4$getNumberOfGroups(survivalCorrectionEnabled = FALSE), 2) data5 <- getDataset( overallSampleSizes1 = c(11, 24, NA), overallSampleSizes2 = c(8, 18, NA), overallEvents1 = c(10, 20, NA), overallEvents2 = c(3, 7, NA)) expect_equal(data5$getNumberOfStages(), 2) expect_equal(data5$getNumberOfStages(FALSE), 3) expect_equal(data5$getNumberOfGroups(), 2) expect_equal(data5$getNumberOfGroups(survivalCorrectionEnabled = FALSE), 2) data6 <- getDataset( overallSampleSizes = c(11, 24, NA), overallEvents = c(3, 7, NA)) expect_equal(data6$getNumberOfStages(), 2) expect_equal(data6$getNumberOfStages(FALSE), 3) expect_equal(data6$getNumberOfGroups(), 1) expect_equal(data6$getNumberOfGroups(survivalCorrectionEnabled = FALSE), 1) }) test_that("Dataset functions 'getNumberOfStages' and 'getNumberOfGroups' work as expected for survival data", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:dataInputVariants} # @refFS[Tab.]fs:tab:output:getDatasetSurvival} data3 <- getDataset( overallEvents1 = c(13, 33), overallLogRanks1 = c(1.23, 1.55), overallEvents2 = c(16, 33), overallLogRanks2 = c(1.55, 2.2)) expect_equal(data3$getNumberOfStages(), 2) expect_equal(data3$getNumberOfStages(FALSE), 2) expect_equal(data3$getNumberOfGroups(), 3) expect_equal(data3$getNumberOfGroups(survivalCorrectionEnabled = FALSE), 2) data4 <- getDataset( events1 = c(13, NA), logRanks1 = c(1.23, NA), events2 = c(16, NA), logRanks2 = c(1.55, NA)) expect_equal(data4$getNumberOfStages(), 1) expect_equal(data4$getNumberOfStages(FALSE), 2) expect_equal(data4$getNumberOfGroups(), 3) expect_equal(data4$getNumberOfGroups(survivalCorrectionEnabled = FALSE), 2) }) test_that("Function '.naOmitBackward' works as expected", { expect_equal(.naOmitBackward(c(1, NA_real_, 3, NA_real_)), c(1, NA_real_, 3)) expect_equal(.naOmitBackward(c(1, NA_real_, 3, NA_real_, 5)), c(1, NA_real_, 3, NA_real_, 5)) expect_equal(.naOmitBackward(c(1, NA_real_, NA_real_)), c(1)) expect_equal(.naOmitBackward(c(1, NA_real_, NA_real_, 4)), c(1, NA_real_, NA_real_, 4)) expect_equal(.naOmitBackward(c(1)), c(1)) expect_equal(.naOmitBackward(c(NA_real_)), c(NA_real_)) expect_equal(.naOmitBackward(c(1, 2, NA_real_)), c(1, 2)) }) context("Testing that 'getDataset' Throws Exceptions as Expected") test_that("Wrong parameter usage of 'getDataset'", { # @refFS[Tab.]{fs:tab:dataInputVariants} expect_error(getDataset(), "Missing argument: data.frame, data vectors, or datasets expected", fixed = TRUE) expect_error(getDataset(1), "Illegal argument: all parameters must be named", fixed = TRUE) expect_error(getDataset(n = 1), "Illegal argument: failed to identify dataset type", fixed = TRUE) expect_error(getDataset(1, x = 2), "Illegal argument: all parameters must be named", fixed = TRUE) expect_error(getDataset( overallSampleSizes1 = c(11, 24, 36, 49), overallSampleSizes2 = c(8, 18, 27, 38), overallSampleSizes3 = c(8, 18, 27, 38), overallEvents1 = c(10, 20, 32, 44), overallEvents2 = c(3, 8, 13, 19), overallEvents3 = c(3, 8, 13, 19), overallEvents1 = c(3, 8, 13, 19) ), "Illegal argument: the parameter names must be unique", fixed = TRUE) }) context("Testing datasets for enrichment designs") test_that("Creation of a dataset of means with subsets", { x <- getDataset( stage = c(1,1,1,1,2,2,2,2,3,3,3,3), subset = c("S1","S2","S12","R","S1","S2","S12","R","S1","S2","S12","R"), sampleSize1 = c(12,14,21,33,33,22,12,14,21,33,33,22), sampleSize2 = c(18,11,21,9,17,18,12,14,21,33,33,22), mean1 = c(107.7, 68.3, 84.9, 77.1, 77.7, 127.4, 107.7, 68.3, 84.9, 77.1, 77.7, 127.4), mean2 = c(165.6, 120.1, 195.9, 162.4, 111.1, 100.9, 107.7, 68.3, 84.9, 77.1, 77.7, 127.4), stDev1 = c(128.5, 124.0, 139.5, 163.5, 133.3, 134.7, 107.7, 68.3, 84.9, 77.1, 77.7, 127.4), stDev2 = c(120.1, 116.8, 185.0, 120.6, 145.6, 133.7, 107.7, 68.3, 84.9, 77.1, 77.7, 127.4)) ## Comparison of the results of DatasetMeans object 'x' with expected results expect_equal(x$stages, c(1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3)) expect_equal(x$groups, c(1, 1, 1, 1, 2, 2, 2, 2, 1, 1, 1, 1, 2, 2, 2, 2, 1, 1, 1, 1, 2, 2, 2, 2)) expect_equal(x$subsets, c("S1", "S2", "S12", "R", "S1", "S2", "S12", "R", "S1", "S2", "S12", "R", "S1", "S2", "S12", "R", "S1", "S2", "S12", "R", "S1", "S2", "S12", "R")) expect_equal(x$sampleSizes, c(12, 14, 21, 33, 18, 11, 21, 9, 33, 22, 12, 14, 17, 18, 12, 14, 21, 33, 33, 22, 21, 33, 33, 22)) expect_equal(x$means, c(107.7, 68.3, 84.9, 77.1, 165.6, 120.1, 195.9, 162.4, 77.7, 127.4, 107.7, 68.3, 111.1, 100.9, 107.7, 68.3, 84.9, 77.1, 77.7, 127.4, 84.9, 77.1, 77.7, 127.4), tolerance = 1e-07) expect_equal(x$stDevs, c(128.5, 124, 139.5, 163.5, 120.1, 116.8, 185, 120.6, 133.3, 134.7, 107.7, 68.3, 145.6, 133.7, 107.7, 68.3, 84.9, 77.1, 77.7, 127.4, 84.9, 77.1, 77.7, 127.4), tolerance = 1e-07) expect_equal(x$overallSampleSizes, c(12, 14, 21, 33, 18, 11, 21, 9, 45, 36, 33, 47, 35, 29, 33, 23, 66, 69, 66, 69, 56, 62, 66, 45)) expect_equal(x$overallMeans, c(107.7, 68.3, 84.9, 77.1, 165.6, 120.1, 195.9, 162.4, 85.7, 104.41667, 93.190909, 74.478723, 139.12857, 108.18276, 163.82727, 105.12174, 85.445455, 91.352174, 85.445455, 91.352174, 118.79286, 91.63871, 120.76364, 116.01333), tolerance = 1e-07) expect_equal(x$overallStDevs, c(128.5, 124, 139.5, 163.5, 120.1, 116.8, 185, 120.6, 131.26649, 132.10351, 127.56945, 141.17802, 133.9849, 125.75856, 165.02815, 101.24395, 117.82181, 109.40115, 105.0948, 138.24808, 120.08511, 103.06452, 135.14016, 114.01099), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x), NA))) expect_output(print(x)$show()) invisible(capture.output(expect_error(summary(x), NA))) expect_output(summary(x)$show()) xCodeBased <- eval(parse(text = getObjectRCode(x, stringWrapParagraphWidth = NULL))) expect_equal(xCodeBased$stages, x$stages, tolerance = 1e-05) expect_equal(xCodeBased$groups, x$groups, tolerance = 1e-05) expect_equal(xCodeBased$subsets, x$subsets, tolerance = 1e-05) expect_equal(xCodeBased$sampleSizes, x$sampleSizes, tolerance = 1e-05) expect_equal(xCodeBased$means, x$means, tolerance = 1e-05) expect_equal(xCodeBased$stDevs, x$stDevs, tolerance = 1e-05) expect_equal(xCodeBased$overallSampleSizes, x$overallSampleSizes, tolerance = 1e-05) expect_equal(xCodeBased$overallMeans, x$overallMeans, tolerance = 1e-05) expect_equal(xCodeBased$overallStDevs, x$overallStDevs, tolerance = 1e-05) expect_type(names(x), "character") df <- as.data.frame(x) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x2 <- getDataset( stages = c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3), subsets = c('S2', 'S12', 'S1', 'R', 'S2', 'S12', 'S1', 'R', 'S2', 'S12', 'S1', 'R'), overallSampleSizes1 = c(14, 21, 12, 33, 36, 33, 45, 47, 69, 66, 66, 69), overallSampleSizes2 = c(11, 21, 18, 9, 29, 33, 35, 23, 62, 66, 56, 45), overallMeans1 = c(68.3, 84.9, 107.7, 77.1, 104.417, 93.191, 85.7, 74.479, 91.352, 85.445, 85.445, 91.352), overallMeans2 = c(120.1, 195.9, 165.6, 162.4, 108.183, 163.827, 139.129, 105.122, 91.639, 120.764, 118.793, 116.013), overallStDevs1 = c(124, 139.5, 128.5, 163.5, 132.104, 127.569, 131.266, 141.178, 109.401, 105.095, 117.822, 138.248), overallStDevs2 = c(116.8, 185, 120.1, 120.6, 125.759, 165.028, 133.985, 101.244, 103.065, 135.14, 120.085, 114.011) ) ## Comparison of the results of DatasetMeans object 'x2' with expected results expect_equal(x2$stages, c(1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3)) expect_equal(x2$groups, c(1, 1, 1, 1, 2, 2, 2, 2, 1, 1, 1, 1, 2, 2, 2, 2, 1, 1, 1, 1, 2, 2, 2, 2)) expect_equal(x2$subsets, c("S1", "S2", "S12", "R", "S1", "S2", "S12", "R", "S1", "S2", "S12", "R", "S1", "S2", "S12", "R", "S1", "S2", "S12", "R", "S1", "S2", "S12", "R")) expect_equal(x2$sampleSizes, c(12, 14, 21, 33, 18, 11, 21, 9, 33, 22, 12, 14, 17, 18, 12, 14, 21, 33, 33, 22, 21, 33, 33, 22)) expect_equal(x2$means, c(107.7, 68.3, 84.9, 77.1, 165.6, 120.1, 195.9, 162.4, 77.7, 127.40055, 107.70025, 68.300929, 111.10088, 100.90039, 107.69925, 68.300429, 84.898571, 77.099273, 77.699, 127.39886, 84.899667, 77.100333, 77.701, 127.39905), tolerance = 1e-07) expect_equal(x2$stDevs, c(128.5, 124, 139.5, 163.5, 120.1, 116.8, 185, 120.6, 133.29934, 134.7007, 107.69841, 68.299913, 145.60038, 133.7007, 107.6989, 68.300382, 84.902527, 77.098435, 77.701172, 127.40021, 84.898999, 77.100624, 77.70049, 127.40009), tolerance = 1e-07) expect_equal(x2$overallSampleSizes, c(12, 14, 21, 33, 18, 11, 21, 9, 45, 36, 33, 47, 35, 29, 33, 23, 66, 69, 66, 69, 56, 62, 66, 45)) expect_equal(x2$overallMeans, c(107.7, 68.3, 84.9, 77.1, 165.6, 120.1, 195.9, 162.4, 85.7, 104.417, 93.191, 74.479, 139.129, 108.183, 163.827, 105.122, 85.445, 91.352, 85.445, 91.352, 118.793, 91.639, 120.764, 116.013), tolerance = 1e-07) expect_equal(x2$overallStDevs, c(128.5, 124, 139.5, 163.5, 120.1, 116.8, 185, 120.6, 131.266, 132.104, 127.569, 141.178, 133.985, 125.759, 165.028, 101.244, 117.822, 109.401, 105.095, 138.248, 120.085, 103.065, 135.14, 114.011), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$stages, x2$stages, tolerance = 1e-05) expect_equal(x2CodeBased$groups, x2$groups, tolerance = 1e-05) expect_equal(x2CodeBased$subsets, x2$subsets, tolerance = 1e-05) expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-05) expect_equal(x2CodeBased$means, x2$means, tolerance = 1e-05) expect_equal(x2CodeBased$stDevs, x2$stDevs, tolerance = 1e-05) expect_equal(x2CodeBased$overallSampleSizes, x2$overallSampleSizes, tolerance = 1e-05) expect_equal(x2CodeBased$overallMeans, x2$overallMeans, tolerance = 1e-05) expect_equal(x2CodeBased$overallStDevs, x2$overallStDevs, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } expect_equal(x$sampleSizes, x2$sampleSizes) expect_equal(x$means, x2$means, tolerance = 1e-05) expect_equal(x$stDevs, x2$stDevs, tolerance = 1e-05) expect_equal(x$overallSampleSizes, x2$overallSampleSizes) expect_equal(x$overallMeans, x2$overallMeans, tolerance = 1e-05) expect_equal(x$overallStDevs, x2$overallStDevs, tolerance = 1e-05) }) test_that("Creation of a dataset of rates with subsets", { x <- getDataset( stage = c(1,1,2,2), subset = c("S1","R","S1","R"), sampleSizes1 = c(11, 24, 36, 49), sampleSizes2 = c(8, 18, 27, 38), sampleSizes3 = c(8, 18, 27, 38), events1 = c(10, 20, 32, 44), events2 = c(3, 8, 13, 19), events3 = c(3, 7, 12, 20)) ## Comparison of the results of DatasetRates object 'x' with expected results expect_equal(x$stages, c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)) expect_equal(x$groups, c(1, 1, 2, 2, 3, 3, 1, 1, 2, 2, 3, 3)) expect_equal(x$subsets, c("S1", "R", "S1", "R", "S1", "R", "S1", "R", "S1", "R", "S1", "R")) expect_equal(x$sampleSizes, c(11, 24, 8, 18, 8, 18, 36, 49, 27, 38, 27, 38)) expect_equal(x$events, c(10, 20, 3, 8, 3, 7, 32, 44, 13, 19, 12, 20)) expect_equal(x$overallSampleSizes, c(11, 24, 8, 18, 8, 18, 47, 73, 35, 56, 35, 56)) expect_equal(x$overallEvents, c(10, 20, 3, 8, 3, 7, 42, 64, 16, 27, 15, 27)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x), NA))) expect_output(print(x)$show()) invisible(capture.output(expect_error(summary(x), NA))) expect_output(summary(x)$show()) xCodeBased <- eval(parse(text = getObjectRCode(x, stringWrapParagraphWidth = NULL))) expect_equal(xCodeBased$stages, x$stages, tolerance = 1e-05) expect_equal(xCodeBased$groups, x$groups, tolerance = 1e-05) expect_equal(xCodeBased$subsets, x$subsets, tolerance = 1e-05) expect_equal(xCodeBased$sampleSizes, x$sampleSizes, tolerance = 1e-05) expect_equal(xCodeBased$events, x$events, tolerance = 1e-05) expect_equal(xCodeBased$overallSampleSizes, x$overallSampleSizes, tolerance = 1e-05) expect_equal(xCodeBased$overallEvents, x$overallEvents, tolerance = 1e-05) expect_type(names(x), "character") df <- as.data.frame(x) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("Creation of a dataset of survival data with subsets", { x <- getDataset( stage = c(1, 1, 2, 2), subset = c("S1","R","S1","R"), events1 = c(10, 20, 32, 44), events2 = c(3, 8, 13, 19), events3 = c(3, 7, 12, 20), logRanks1 = c(2.2, 1.8, 1.9, 2.1), logRanks2 = c(1.99, 2.01, 2.05, 2.09), logRanks3 = c(2.32, 2.11, 2.14, 2.17) ) ## Comparison of the results of DatasetSurvival object 'x' with expected results expect_equal(x$stages, c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)) expect_equal(x$groups, c(1, 1, 2, 2, 3, 3, 1, 1, 2, 2, 3, 3)) expect_equal(x$subsets, c("S1", "R", "S1", "R", "S1", "R", "S1", "R", "S1", "R", "S1", "R")) expect_equal(x$overallEvents, c(10, 20, 3, 8, 3, 7, 42, 64, 16, 27, 15, 27)) expect_equal(x$overallAllocationRatios, c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)) expect_equal(x$overallLogRanks, c(2.2, 1.8, 1.99, 2.01, 2.32, 2.11, 2.731946, 2.7474586, 2.7095403, 2.8473447, 2.9516097, 2.941998), tolerance = 1e-07) expect_equal(x$events, c(10, 20, 3, 8, 3, 7, 32, 44, 13, 19, 12, 20)) expect_equal(x$allocationRatios, c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)) expect_equal(x$logRanks, c(2.2, 1.8, 1.99, 2.01, 2.32, 2.11, 1.9, 2.1, 2.05, 2.09, 2.14, 2.17), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x), NA))) expect_output(print(x)$show()) invisible(capture.output(expect_error(summary(x), NA))) expect_output(summary(x)$show()) xCodeBased <- eval(parse(text = getObjectRCode(x, stringWrapParagraphWidth = NULL))) expect_equal(xCodeBased$stages, x$stages, tolerance = 1e-05) expect_equal(xCodeBased$groups, x$groups, tolerance = 1e-05) expect_equal(xCodeBased$subsets, x$subsets, tolerance = 1e-05) expect_equal(xCodeBased$overallEvents, x$overallEvents, tolerance = 1e-05) expect_equal(xCodeBased$overallAllocationRatios, x$overallAllocationRatios, tolerance = 1e-05) expect_equal(xCodeBased$overallLogRanks, x$overallLogRanks, tolerance = 1e-05) expect_equal(xCodeBased$events, x$events, tolerance = 1e-05) expect_equal(xCodeBased$allocationRatios, x$allocationRatios, tolerance = 1e-05) expect_equal(xCodeBased$logRanks, x$logRanks, tolerance = 1e-05) expect_type(names(x), "character") df <- as.data.frame(x) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("Illegal creation of a dataset of means with subsets: invalid sample size", { expect_error(getDataset( sampleSize1 = c(NA, NA), sampleSize2 = c(NA, NA), mean1 = c(NA, NA), mean2 = c(NA, NA), stDev1 = c(NA, NA), stDev2 = c(NA, NA)), "Illegal argument: 'sampleSize1' is NA at first stage; a valid numeric value must be specified at stage 1", fixed = TRUE) }) test_that("Illegal creation of a dataset of means with subsets: too small standard deviation (one subset)", { S1 <- getDataset( sampleSize1 = c(12, 21), sampleSize2 = c(18, 21), mean1 = c(107.7, 84.9), mean2 = c(165.6, 195.9), stDev1 = c(128.5, 139.5), stDev2 = c(120.1, 185.0)) F <- getDataset( sampleSize1 = c(26, NA), sampleSize2 = c(29, NA), mean1 = c(86.48462, NA), mean2 = c(148.34138, NA), stDev1 = c(125.1485, NA), stDev2 = c(118.888, NA)) expect_error(getDataset(S1 = S1, F = F), "Conflicting arguments: 'stDev' F (125.148) must be > 'stDev' S1 (128.5) in group 1 at stage 1", fixed = TRUE) }) test_that("Illegal creation of a dataset of means with subsets: too small sample size in F (one group)", { S1 <- getDataset( sampleSize1 = c(12, 21), sampleSize2 = c(30, 21), mean1 = c(107.7, 84.9), mean2 = c(165.6, 195.9), stDev1 = c(128.5, 139.5), stDev2 = c(120.1, 185.0)) F <- getDataset( sampleSize1 = c(26, NA), sampleSize2 = c(29, NA), mean1 = c(86.48462, NA), mean2 = c(148.34138, NA), stDev1 = c(129.1485, NA), stDev2 = c(122.888, NA)) expect_error(getDataset(S1 = S1, F = F), "Conflicting arguments: 'sampleSize' F (29) must be >= 'sampleSize' S1 (30) in group 2 at stage 1", fixed = TRUE) }) test_that("Illegal creation of a dataset of means with subsets: wrong deselection (one group)", { S1 <- getDataset( sampleSize1 = c( 12, NA), sampleSize2 = c( 18, NA), mean1 = c(107.7, NA), mean2 = c(165.6, NA), stDev1 = c(128.5, NA), stDev2 = c(120.1, NA)) R <- getDataset( sampleSize1 = c( 14, 21), sampleSize2 = c( 11, 21), mean1 = c( 68.3, 84.9), mean2 = c(120.1, 195.9), stDev1 = c(124.0, 139.5), stDev2 = c(116.8, 185.0)) expect_error(getDataset(S1 = S1, R = R), paste0("Conflicting arguments: if S1 is deselected (NA) then R also must be deselected (NA) ", "but, e.g., ", sQuote("sampleSize"), " R is 21 in group 1 at stage 2"), fixed = TRUE) }) test_that("Illegal creation of a dataset of means with subsets: inconsistent number of stages", { ## S1 expect_error(getDataset( sampleSize1 = c( 12, NA, 21), sampleSize2 = c( 18, NA, 21), mean1 = c(107.7, NA, 84.9), mean2 = c(165.6, NA, 195.9), stDev1 = c(128.5, NA, 139.5), stDev2 = c(120.1, NA, 185.0)), paste0("Illegal argument: 'sampleSize1' contains a NA at stage 2 followed by a ", "value for a higher stage; NA's must be the last values"), fixed = TRUE) S1 <- getDataset( sampleSize1 = c( 12, 21), sampleSize2 = c( 18, 21), mean1 = c(107.7, 84.9), mean2 = c(165.6, 195.9), stDev1 = c(128.5, 139.5), stDev2 = c(120.1, 185.0)) R <- getDataset( sampleSize1 = c( 14, NA, NA), sampleSize2 = c( 11, NA, NA), mean1 = c( 68.3, NA, NA), mean2 = c(120.1, NA, NA), stDev1 = c(124.0, NA, NA), stDev2 = c(116.8, NA, NA)) expect_error(getDataset(S1 = S1, R = R), paste0("Conflicting arguments: all subsets must have the identical ", "number of stages defined (kMax: S1 = 2, R = 3)"), fixed = TRUE) }) test_that("Illegal creation of a dataset of means with subsets: too small standard deviation in F (two subsets)", { S1N <- getDataset( sampleSize1 = c( 39, 34, NA), sampleSize2 = c( 33, 45, NA), stDev1 = c(156.5026, 120.084, NA), stDev2 = c(134.0254, 126.502, NA), mean1 = c(131.146, 114.4, NA), mean2 = c(93.191, 85.7, NA)) S2N <- getDataset( sampleSize1 = c( 32, NA, NA), sampleSize2 = c( 35, NA, NA), stDev1 = c(163.645, NA, NA), stDev2 = c(131.888, NA, NA), mean1 = c(123.594, NA, NA), mean2 = c(78.26, NA, NA) ) F <- getDataset( sampleSize1 = c( 69, NA, NA), sampleSize2 = c( 80, NA, NA), stDev1 = c(140.4682, NA, NA), stDev2 = c(143.9796, NA, NA), mean1 = c(129.2957, NA, NA), mean2 = c(82.1875, NA, NA)) expect_error(getDataset(S1 = S1N, S2 = S2N, F = F), paste0("Conflicting arguments: 'stDev' F (140.468) must ", "be > 'stDev' S1 (156.503) in group 1 at stage 1"), fixed = TRUE) }) test_that("Illegal creation of a dataset of means with subsets: too small sample size in F (two subsets)", { S1N <- getDataset( sampleSize1 = c( 39, 34, NA), sampleSize2 = c( 33, 45, NA), stDev1 = c(156.5026, 120.084, NA), stDev2 = c(134.0254, 126.502, NA), mean1 = c(131.146, 114.4, NA), mean2 = c(93.191, 85.7, NA)) S2N <- getDataset( sampleSize1 = c( 32, NA, NA), sampleSize2 = c( 35, NA, NA), stDev1 = c(163.645, NA, NA), stDev2 = c(131.888, NA, NA), mean1 = c(123.594, NA, NA), mean2 = c(78.26, NA, NA) ) F <- getDataset( sampleSize1 = c( 30, NA, NA), sampleSize2 = c( 80, NA, NA), stDev1 = c(164.4682, NA, NA), stDev2 = c(143.9796, NA, NA), mean1 = c(129.2957, NA, NA), mean2 = c( 82.1875, NA, NA)) expect_error(getDataset(S1 = S1N, S2 = S2N, F = F), paste0("Conflicting arguments: 'sampleSize' F (30) must ", "be >= 'sampleSize' S1 (39) in group 1 at stage 1"), fixed = TRUE) }) test_that("Illegal creation of a dataset of means with subsets: wrong deselection (three subsets)", { S1 <- getDataset( sampleSize2 = c( 12, 33, 21), sampleSize1 = c( 18, 17, 23), mean2 = c(107.7, 77.7, 84.9), mean1 = c(125.6, 111.1, 99.9), stDev2 = c(128.5, 133.3, 84.9), stDev1 = c(120.1, 145.6, 74.3)) S2 <- getDataset( sampleSize2 = c( 14, NA, NA), sampleSize1 = c( 11, NA, NA), mean2 = c( 68.3, NA, NA), mean1 = c(100.1, NA, NA), stDev2 = c(124.0, NA, NA), stDev1 = c(116.8, NA, NA)) S12 <- getDataset( sampleSize2 = c( 21, 12, 33), sampleSize1 = c( 21, 17, 31), mean2 = c( 84.9, 107.7, 77.7), mean1 = c( 135.9, 117.7, 97.7), stDev2 = c( 139.5, 107.7, 77.7), stDev1 = c( 185.0, 92.3, 87.3)) R <- getDataset( sampleSize2 = c( 33, 33, NA), sampleSize1 = c( 19, 19, NA), mean2 = c( 77.1, 77.1, NA), mean1 = c(142.4, 142.4, NA), stDev2 = c(163.5, 163.5, NA), stDev1 = c(120.6, 120.6, NA)) expect_error(getDataset(S1 = S1, S2 = S2, S12 = S12, R = R), paste0("Conflicting arguments: if S2 is deselected (NA) then R also must be deselected ", "(NA) but, e.g., ", sQuote("sampleSize"), " R is 19 in group 1 at stage 2"), fixed = TRUE) }) test_that("Valid creation of a dataset of means with subsets: no error occurs", { S1 <- getDataset( sampleSize2 = c( 12, 33, 21), sampleSize1 = c( 18, 17, 23), mean2 = c(107.7, 77.7, 84.9), mean1 = c(125.6, 111.1, 99.9), stDev2 = c(128.5, 133.3, 84.9), stDev1 = c(120.1, 145.6, 74.3)) S2 <- getDataset( sampleSize2 = c( 14, 22, NA), sampleSize1 = c( 11, 18, NA), mean2 = c( 68.3, 127.4, NA), mean1 = c(100.1, 110.9, NA), stDev2 = c(124.0, 134.7, NA), stDev1 = c(116.8, 133.7, NA)) S12 <- getDataset( sampleSize2 = c( 21, NA, NA), sampleSize1 = c( 21, NA, NA), mean2 = c( 84.9, NA, NA), mean1 = c( 135.9, NA, NA), stDev2 = c( 139.5, NA, NA), stDev1 = c( 185.0, NA, NA)) R <- getDataset( sampleSize2 = c( 33, 33, NA), sampleSize1 = c( 19, 19, NA), mean2 = c( 77.1, 77.1, NA), mean1 = c(142.4, 142.4, NA), stDev2 = c(163.5, 163.5, NA), stDev1 = c(120.6, 120.6, NA)) expect_error(getDataset(S1 = S1, S2 = S2, S12 = S12, R = R), NA) }) test_that("Illegal creation of a dataset of rates with subsets: too small number of events in F (one subset)", { S1 <- getDataset( sampleSize1 = c( 22, 31, 37), sampleSize2 = c( 28, 33, 39), events1 = c( 17, 16, 17), events2 = c( 18, 21, 19) ) F <- getDataset( sampleSize1 = c( 46, 54, NA), sampleSize2 = c( 49, 62, NA), events1 = c( 16, 31, NA), events2 = c( 29, 35, NA) ) expect_error(getDataset(S1 = S1, F = F), paste0("Conflicting arguments: 'event' F (16) must be >= 'event' S1 (17) in group 1 at stage 1"), fixed = TRUE) }) test_that("Illegal creation of a dataset of rates with subsets: too small sample size in F (one subset)", { S1 <- getDataset( sampleSize1 = c( 22, 31, 37), sampleSize2 = c( 28, 33, 39), events1 = c( 7, 16, 17), events2 = c( 18, 21, 19) ) F <- getDataset( sampleSize1 = c( 46, 29, NA), sampleSize2 = c( 49, 62, NA), events1 = c( 16, 31, NA), events2 = c( 29, 35, NA) ) expect_error(getDataset(S1 = S1, F = F), paste0("Conflicting arguments: 'sampleSize' F (29) must be >= 'sampleSize' S1 (31) in group 1 at stage 2"), fixed = TRUE) }) test_that("Illegal creation of a dataset of rates with subsets: wrong deselection (one subset)", { S1 <- getDataset( sampleSize1 = c( 22, 31, NA), sampleSize2 = c( 28, 33, NA), events1 = c( 7, 16, NA), events2 = c( 18, 21, NA) ) R <- getDataset( sampleSize1 = c( 24, 23, 37), sampleSize2 = c( 21, 29, 39), events1 = c( 9, 15, 10), events2 = c( 11, 14, 19) ) expect_error(getDataset(S1 = S1, R = R), paste0("Conflicting arguments: if S1 is deselected (NA) then R also must be ", "deselected (NA) but, e.g., ", sQuote("sampleSize"), " R is 37 in group 1 at stage 3"), fixed = TRUE) }) test_that("Illegal creation of a dataset of rates with subsets: too small sample size in F (three subsets)", { S1 <- getDataset( sampleSize1 = c( 84, 94, 25), sampleSize2 = c( 82, 75, 23), events1 = c( 21, 28, 13), events2 = c( 32, 23, 20) ) S2 <- getDataset( sampleSize1 = c( 81, 95, NA), sampleSize2 = c( 84, 64, NA), events1 = c( 26, 29, NA), events2 = c( 31, 26, NA) ) S3 <- getDataset( sampleSize1 = c( 271, NA, NA), sampleSize2 = c( 74, NA, NA), events1 = c( 16, NA, NA), events2 = c( 21, NA, NA) ) F <- getDataset( sampleSize1 = c( 248, NA, NA), sampleSize2 = c( 254, NA, NA), events1 = c( 75, NA, NA), events2 = c( 98, NA, NA) ) expect_error(getDataset(S1 = S1, S2 = S2, S3 = S3, F = F), paste0("Conflicting arguments: 'sampleSize' F (248) must ", "be >= 'sampleSize' S3 (271) in group 1 at stage 1"), fixed = TRUE) }) test_that("Illegal creation of a dataset of rates with subsets: wrong deselection (three subsets)", { S1 <- getDataset( sampleSize1 = c( 47, 33, 37), sampleSize2 = c( 48, 47, 39), events1 = c( 18, 13, 17), events2 = c( 12, 11, 9) ) S2 <- getDataset( sampleSize1 = c( 49, NA, NA), sampleSize2 = c( 45, NA, NA), events1 = c( 12, NA, NA), events2 = c( 13, NA, NA) ) S12 <- getDataset( sampleSize1 = c( 35, 42, NA), sampleSize2 = c( 36, 47, NA), events1 = c( 19, 10, NA), events2 = c( 13, 17, NA) ) R <- getDataset( sampleSize1 = c( 43, 43, 43), sampleSize2 = c( 39, 39, 39), events1 = c( 17, 17, 17), events2 = c( 14, 14, 14) ) expect_error(getDataset(S1 = S1, S2 = S2, S12 = S12, R = R), paste0("Conflicting arguments: if S2 is deselected (NA) then R also must be ", "deselected (NA) but, e.g., ", sQuote("sampleSize"), " R is 43 in group 1 at stage 2"), fixed = TRUE) }) test_that("Creation of a dataset of rates with subsets: empty subsets", { S1 <- getDataset( sampleSize1 = c( 84, 94, 25), sampleSize2 = c( 82, 75, 23), events1 = c( 21, 28, 13), events2 = c( 32, 23, 20) ) S2 <- getDataset( sampleSize1 = c( 81, 95, NA), sampleSize2 = c( 84, 64, NA), events1 = c( 26, 29, NA), events2 = c( 31, 26, NA) ) S3 <- getDataset( sampleSize1 = c( 71, NA, NA), sampleSize2 = c( 74, NA, NA), events1 = c( 16, NA, NA), events2 = c( 21, NA, NA) ) R <- getDataset( sampleSize1 = c( 12, NA, NA), sampleSize2 = c( 14, NA, NA), events1 = c( 12, NA, NA), events2 = c( 14, NA, NA) ) expect_warning(getDataset(S1 = S1, S2 = S2, S3 = S3, R = R), "The 4 undefined subsets S12, S13, S23, S123 were defined as empty subsets", fixed = TRUE) }) test_that("Illegal creation of a dataset of rates with subsets: wrong deselection (R)", { S1 <- getDataset( sampleSize1 = c( 84, 94, 25), sampleSize2 = c( 82, 75, 23), events1 = c( 21, 28, 13), events2 = c( 32, 23, 20) ) S2 <- getDataset( sampleSize1 = c( 81, 95, NA), sampleSize2 = c( 84, 64, NA), events1 = c( 26, 29, NA), events2 = c( 31, 26, NA) ) S3 <- getDataset( sampleSize1 = c( 71, NA, NA), sampleSize2 = c( 74, NA, NA), events1 = c( 16, NA, NA), events2 = c( 21, NA, NA) ) R <- getDataset( sampleSize1 = c( 12, 95, NA), sampleSize2 = c( 14, 64, NA), events1 = c( 12, 29, NA), events2 = c( 14, 26, NA) ) expect_warning(expect_error(getDataset(S1 = S1, S2 = S2, S3 = S3, R = R), paste0("Conflicting arguments: if S3 is deselected (NA) then R also must be ", "deselected (NA) but, e.g., ", sQuote("sampleSize"), " R is 95 in group 1 at stage 2"), fixed = TRUE)) }) test_that("Illegal creation of a dataset of survival data with subsets: too small number of events (one group)", { S1 <- getDataset( events = c(37, 56, 22), logRanks = c(1.66, 1.38, 1.22), allocationRatios = c(1,1,1) ) F <- getDataset( events = c(66, 55, NA), logRanks = c(1.98, 1.57, NA), allocationRatios = c(1,1, NA) ) expect_error(getDataset(S1 = S1, F = F), paste0("Conflicting arguments: 'event' F (55) must be >= ", "'event' S1 (56) in group 1 at stage 2"), fixed = TRUE) }) test_that("Illegal creation of a dataset of survival data with subsets: wrong deselection (one group)", { S1 <- getDataset( overallExpectedEvents = c(13.3, NA, NA), overallEvents = c(16, NA, NA), overallVarianceEvents = c(2.9, NA, NA), overallAllocationRatios = c(1, NA, NA) ) R <- getDataset( overallExpectedEvents = c(23.4, 35.4, 43.7), overallEvents = c(27, 38, 47), overallVarianceEvents = c(3.8, 4.7, 3.4), overallAllocationRatios = c(1, 1, 1) ) expect_error(getDataset(S1 = S1, R = R), paste0("Conflicting arguments: if S1 is deselected (NA) then R also must ", "be deselected (NA) but, e.g., ", sQuote("overallEvent"), " R is 38 in group 1 at stage 2"), fixed = TRUE) }) test_that("Creation of a dataset of survival data with subsets: no error occurs", { S1 <- getDataset( events = c(37, 13, 26), logRanks = -c(1.66, 1.239, 0.785) ) S2 <- getDataset( events = c(31, 18, NA), logRanks = -c(1.98, 1.064, NA) ) F <- getDataset( events = c(37, NA, NA), logRanks = -c(2.18, NA, NA) ) expect_error(getDataset(S1 = S1, S2 = S2, F = F), NA) }) test_that("Illegal creation of a dataset of survival data with subsets: too small number of events (two groups)", { S1 <- getDataset( events = c(37, 13, 26), logRanks = -c(1.66, 1.239, 0.785) ) S2 <- getDataset( events = c(31, 18, NA), logRanks = -c(1.98, 1.064, NA) ) F <- getDataset( events = c(30, NA, NA), logRanks = -c(2.18, NA, NA) ) expect_error(getDataset(S1 = S1, S2 = S2, F = F), paste0("Conflicting arguments: 'event' F (30) must be ", ">= 'event' S1 (37) in group 1 at stage 1"), fixed = TRUE) }) test_that("Illegal creation of a dataset of survival data with subsets: inconsistent deselection", { expect_error(getDataset( overallExpectedEvents = c(13.4, 35.4, 43.7), overallEvents = c(16, 37, 47), overallVarianceEvents = c(2.8, 4.7, 3.4), overallAllocationRatios = c(1, 1, NA) ), paste0("Conflicting arguments: values of treatment 1 not correctly specified; if NA's exist, then they are ", "mandatory for each parameter at the same stage"), fixed = TRUE) S1 <- getDataset( overallExpectedEvents = c(13.4, 35.4, 43.7), overallEvents = c(16, 37, 47), overallVarianceEvents = c(2.8, 4.7, 3.4), overallAllocationRatios = c(1, 1, 1) ) expect_error(getDataset( overallExpectedEvents = c(11.5, 31.1, NA), overallEvents = c(15, 33, NA), overallVarianceEvents = c(2.2, 4.4, NA), overallAllocationRatios = c(1, 1, 1) ), paste0("Conflicting arguments: values of treatment 1 not correctly specified; if NA's exist, then they are ", "mandatory for each parameter at the same stage"), fixed = TRUE) S2 <- getDataset( overallExpectedEvents = c(11.5, 31.1, NA), overallEvents = c(15, 33, NA), overallVarianceEvents = c(2.2, 4.4, NA), overallAllocationRatios = c(1, 1, NA) ) S12 <- getDataset( overallExpectedEvents = c(10.1, 29.6, 39.1), overallEvents = c(11, 31, 42), overallVarianceEvents = c(2.8, 4.7, 3.4), overallAllocationRatios = c(1, 1, 1) ) R <- getDataset( overallExpectedEvents = c(23.3, NA, NA), overallEvents = c(25, NA, NA), overallVarianceEvents = c(3.9, NA, NA), overallAllocationRatios = c(1, NA, NA) ) expect_error(getDataset(S1 = S1, S2 = S2, S12 = S12, R = R), NA) }) rpact/tests/testthat/test-class_time.R0000644000175000017500000053541714154142422017760 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-class_time.R ## | Creation date: 08 December 2021, 08:59:14 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Class 'PiecewiseSurvivalTime'") test_that("Testing 'getPiecewiseSurvivalTime': isPiecewiseSurvivalEnabled()", { # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} expect_false(getPiecewiseSurvivalTime()$isPiecewiseSurvivalEnabled()) expect_false(getPiecewiseSurvivalTime(piecewiseSurvivalTime = NA)$isPiecewiseSurvivalEnabled()) }) test_that("Testing 'getPiecewiseSurvivalTime': simple vector based definition", { # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} pwSurvivalTime1 <- getPiecewiseSurvivalTime(lambda2 = 0.5, hazardRatio = 0.8) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime1' with expected results expect_equal(pwSurvivalTime1$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime1$lambda1, 0.4, tolerance = 1e-07) expect_equal(pwSurvivalTime1$lambda2, 0.5, tolerance = 1e-07) expect_equal(pwSurvivalTime1$hazardRatio, 0.8, tolerance = 1e-07) expect_equal(pwSurvivalTime1$pi1, NA_real_) expect_equal(pwSurvivalTime1$pi2, NA_real_) expect_equal(pwSurvivalTime1$median1, 1.732868, tolerance = 1e-07) expect_equal(pwSurvivalTime1$median2, 1.3862944, tolerance = 1e-07) expect_equal(pwSurvivalTime1$eventTime, NA_real_) expect_equal(pwSurvivalTime1$kappa, 1) expect_equal(pwSurvivalTime1$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime1$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime1$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime1), NA))) expect_output(print(pwSurvivalTime1)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime1), NA))) expect_output(summary(pwSurvivalTime1)$show()) pwSurvivalTime1CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime1, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalTime, pwSurvivalTime1$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$lambda1, pwSurvivalTime1$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$lambda2, pwSurvivalTime1$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$hazardRatio, pwSurvivalTime1$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$pi1, pwSurvivalTime1$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$pi2, pwSurvivalTime1$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$median1, pwSurvivalTime1$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$median2, pwSurvivalTime1$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$eventTime, pwSurvivalTime1$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$kappa, pwSurvivalTime1$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime1$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$delayedResponseAllowed, pwSurvivalTime1$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$delayedResponseEnabled, pwSurvivalTime1$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime1), "character") df <- as.data.frame(pwSurvivalTime1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime2 <- getPiecewiseSurvivalTime(lambda2 = 0.5, lambda1 = 0.4) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime2$lambda1, 0.4, tolerance = 1e-07) expect_equal(pwSurvivalTime2$lambda2, 0.5, tolerance = 1e-07) expect_equal(pwSurvivalTime2$hazardRatio, 0.8, tolerance = 1e-07) expect_equal(pwSurvivalTime2$pi1, NA_real_) expect_equal(pwSurvivalTime2$pi2, NA_real_) expect_equal(pwSurvivalTime2$median1, 1.732868, tolerance = 1e-07) expect_equal(pwSurvivalTime2$median2, 1.3862944, tolerance = 1e-07) expect_equal(pwSurvivalTime2$eventTime, NA_real_) expect_equal(pwSurvivalTime2$kappa, 1) expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) expect_output(print(pwSurvivalTime2)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) expect_output(summary(pwSurvivalTime2)$show()) pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime2), "character") df <- as.data.frame(pwSurvivalTime2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() pwSurvivalTime2 <- getPiecewiseSurvivalTime(pi2 = 0.5, hazardRatio = 0.8) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, NA_real_) expect_equal(pwSurvivalTime2$lambda1, 0.046209812, tolerance = 1e-07) expect_equal(pwSurvivalTime2$lambda2, 0.057762265, tolerance = 1e-07) expect_equal(pwSurvivalTime2$hazardRatio, 0.8, tolerance = 1e-07) expect_equal(pwSurvivalTime2$pi1, 0.42565082, tolerance = 1e-07) expect_equal(pwSurvivalTime2$pi2, 0.5, tolerance = 1e-07) expect_equal(pwSurvivalTime2$median1, 15) expect_equal(pwSurvivalTime2$median2, 12) expect_equal(pwSurvivalTime2$eventTime, 12) expect_equal(pwSurvivalTime2$kappa, 1) expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) expect_output(print(pwSurvivalTime2)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) expect_output(summary(pwSurvivalTime2)$show()) pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime2), "character") df <- as.data.frame(pwSurvivalTime2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime2 <- getPiecewiseSurvivalTime(pi2 = 0.5, pi1 = 0.4) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, NA_real_) expect_equal(pwSurvivalTime2$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(pwSurvivalTime2$lambda2, 0.057762265, tolerance = 1e-07) expect_equal(pwSurvivalTime2$hazardRatio, 0.73696559, tolerance = 1e-07) expect_equal(pwSurvivalTime2$pi1, 0.4, tolerance = 1e-07) expect_equal(pwSurvivalTime2$pi2, 0.5, tolerance = 1e-07) expect_equal(pwSurvivalTime2$median1, 16.282985, tolerance = 1e-07) expect_equal(pwSurvivalTime2$median2, 12) expect_equal(pwSurvivalTime2$eventTime, 12) expect_equal(pwSurvivalTime2$kappa, 1) expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) expect_output(print(pwSurvivalTime2)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) expect_output(summary(pwSurvivalTime2)$show()) pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime2), "character") df <- as.data.frame(pwSurvivalTime2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime3 <- getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime3' with expected results expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime3$lambda1, c(0.24, 0.32), tolerance = 1e-07) expect_equal(pwSurvivalTime3$lambda2, 0.4, tolerance = 1e-07) expect_equal(pwSurvivalTime3$hazardRatio, c(0.6, 0.8), tolerance = 1e-07) expect_equal(pwSurvivalTime3$pi1, NA_real_) expect_equal(pwSurvivalTime3$pi2, NA_real_) expect_equal(pwSurvivalTime3$median1, c(2.8881133, 2.1660849), tolerance = 1e-07) expect_equal(pwSurvivalTime3$median2, 1.732868, tolerance = 1e-07) expect_equal(pwSurvivalTime3$eventTime, NA_real_) expect_equal(pwSurvivalTime3$kappa, 1) expect_equal(pwSurvivalTime3$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime3$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime3$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime3), NA))) expect_output(print(pwSurvivalTime3)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime3), NA))) expect_output(summary(pwSurvivalTime3)$show()) pwSurvivalTime3CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime3, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalTime, pwSurvivalTime3$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$lambda1, pwSurvivalTime3$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$lambda2, pwSurvivalTime3$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$hazardRatio, pwSurvivalTime3$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$pi1, pwSurvivalTime3$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$pi2, pwSurvivalTime3$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$median1, pwSurvivalTime3$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$median2, pwSurvivalTime3$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$eventTime, pwSurvivalTime3$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$kappa, pwSurvivalTime3$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime3$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$delayedResponseAllowed, pwSurvivalTime3$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$delayedResponseEnabled, pwSurvivalTime3$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime3), "character") df <- as.data.frame(pwSurvivalTime3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime8 <- getPiecewiseSurvivalTime( pi2 = 0.4, pi1 = 0.3) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime8' with expected results expect_equal(pwSurvivalTime8$piecewiseSurvivalTime, NA_real_) expect_equal(pwSurvivalTime8$lambda1, 0.029722912, tolerance = 1e-07) expect_equal(pwSurvivalTime8$lambda2, 0.042568802, tolerance = 1e-07) expect_equal(pwSurvivalTime8$hazardRatio, 0.69823229, tolerance = 1e-07) expect_equal(pwSurvivalTime8$pi1, 0.3, tolerance = 1e-07) expect_equal(pwSurvivalTime8$pi2, 0.4, tolerance = 1e-07) expect_equal(pwSurvivalTime8$median1, 23.320299, tolerance = 1e-07) expect_equal(pwSurvivalTime8$median2, 16.282985, tolerance = 1e-07) expect_equal(pwSurvivalTime8$eventTime, 12) expect_equal(pwSurvivalTime8$kappa, 1) expect_equal(pwSurvivalTime8$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime8$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime8$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime8), NA))) expect_output(print(pwSurvivalTime8)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime8), NA))) expect_output(summary(pwSurvivalTime8)$show()) pwSurvivalTime8CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime8, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime8CodeBased$piecewiseSurvivalTime, pwSurvivalTime8$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime8CodeBased$lambda1, pwSurvivalTime8$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime8CodeBased$lambda2, pwSurvivalTime8$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime8CodeBased$hazardRatio, pwSurvivalTime8$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime8CodeBased$pi1, pwSurvivalTime8$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime8CodeBased$pi2, pwSurvivalTime8$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime8CodeBased$median1, pwSurvivalTime8$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime8CodeBased$median2, pwSurvivalTime8$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime8CodeBased$eventTime, pwSurvivalTime8$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime8CodeBased$kappa, pwSurvivalTime8$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime8CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime8$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime8CodeBased$delayedResponseAllowed, pwSurvivalTime8$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime8CodeBased$delayedResponseEnabled, pwSurvivalTime8$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime8), "character") df <- as.data.frame(pwSurvivalTime8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime9 <- getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi2 = 0.3) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime9' with expected results expect_equal(pwSurvivalTime9$piecewiseSurvivalTime, NA_real_) expect_equal(pwSurvivalTime9$lambda1, c(0.017833747, 0.02377833), tolerance = 1e-07) expect_equal(pwSurvivalTime9$lambda2, 0.029722912, tolerance = 1e-07) expect_equal(pwSurvivalTime9$hazardRatio, c(0.6, 0.8), tolerance = 1e-07) expect_equal(pwSurvivalTime9$pi1, c(0.19265562, 0.24824135), tolerance = 1e-07) expect_equal(pwSurvivalTime9$pi2, 0.3, tolerance = 1e-07) expect_equal(pwSurvivalTime9$median1, c(38.867164, 29.150373), tolerance = 1e-07) expect_equal(pwSurvivalTime9$median2, 23.320299, tolerance = 1e-07) expect_equal(pwSurvivalTime9$eventTime, 12) expect_equal(pwSurvivalTime9$kappa, 1) expect_equal(pwSurvivalTime9$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime9$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime9$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime9), NA))) expect_output(print(pwSurvivalTime9)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime9), NA))) expect_output(summary(pwSurvivalTime9)$show()) pwSurvivalTime9CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime9, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime9CodeBased$piecewiseSurvivalTime, pwSurvivalTime9$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime9CodeBased$lambda1, pwSurvivalTime9$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime9CodeBased$lambda2, pwSurvivalTime9$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime9CodeBased$hazardRatio, pwSurvivalTime9$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime9CodeBased$pi1, pwSurvivalTime9$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime9CodeBased$pi2, pwSurvivalTime9$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime9CodeBased$median1, pwSurvivalTime9$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime9CodeBased$median2, pwSurvivalTime9$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime9CodeBased$eventTime, pwSurvivalTime9$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime9CodeBased$kappa, pwSurvivalTime9$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime9CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime9$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime9CodeBased$delayedResponseAllowed, pwSurvivalTime9$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime9CodeBased$delayedResponseEnabled, pwSurvivalTime9$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime9), "character") df <- as.data.frame(pwSurvivalTime9) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime9) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime10 <- getPiecewiseSurvivalTime(median2 = 1.386294, hazardRatio = 0.8) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime10' with expected results expect_equal(pwSurvivalTime10$piecewiseSurvivalTime, NA_real_) expect_equal(pwSurvivalTime10$lambda1, 0.4000001, tolerance = 1e-07) expect_equal(pwSurvivalTime10$lambda2, 0.50000013, tolerance = 1e-07) expect_equal(pwSurvivalTime10$hazardRatio, 0.8, tolerance = 1e-07) expect_equal(pwSurvivalTime10$pi1, NA_real_) expect_equal(pwSurvivalTime10$pi2, NA_real_) expect_equal(pwSurvivalTime10$median1, 1.7328675, tolerance = 1e-07) expect_equal(pwSurvivalTime10$median2, 1.386294, tolerance = 1e-07) expect_equal(pwSurvivalTime10$eventTime, NA_real_) expect_equal(pwSurvivalTime10$kappa, 1) expect_equal(pwSurvivalTime10$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime10$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime10$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime10), NA))) expect_output(print(pwSurvivalTime10)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime10), NA))) expect_output(summary(pwSurvivalTime10)$show()) pwSurvivalTime10CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime10, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalTime, pwSurvivalTime10$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$lambda1, pwSurvivalTime10$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$lambda2, pwSurvivalTime10$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$hazardRatio, pwSurvivalTime10$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$pi1, pwSurvivalTime10$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$pi2, pwSurvivalTime10$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$median1, pwSurvivalTime10$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$median2, pwSurvivalTime10$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$eventTime, pwSurvivalTime10$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$kappa, pwSurvivalTime10$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime10$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$delayedResponseAllowed, pwSurvivalTime10$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$delayedResponseEnabled, pwSurvivalTime10$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime10), "character") df <- as.data.frame(pwSurvivalTime10) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime10) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime11 <- getPiecewiseSurvivalTime(median2 = 1.386294, lambda1 = 0.4) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime11' with expected results expect_equal(pwSurvivalTime11$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime11$lambda1, 0.4, tolerance = 1e-07) expect_equal(pwSurvivalTime11$lambda2, 0.50000013, tolerance = 1e-07) expect_equal(pwSurvivalTime11$hazardRatio, 0.79999979, tolerance = 1e-07) expect_equal(pwSurvivalTime11$pi1, NA_real_) expect_equal(pwSurvivalTime11$pi2, NA_real_) expect_equal(pwSurvivalTime11$median1, 1.732868, tolerance = 1e-07) expect_equal(pwSurvivalTime11$median2, 1.386294, tolerance = 1e-07) expect_equal(pwSurvivalTime11$eventTime, NA_real_) expect_equal(pwSurvivalTime11$kappa, 1) expect_equal(pwSurvivalTime11$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime11$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime11$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime11), NA))) expect_output(print(pwSurvivalTime11)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime11), NA))) expect_output(summary(pwSurvivalTime11)$show()) pwSurvivalTime11CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime11, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalTime, pwSurvivalTime11$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$lambda1, pwSurvivalTime11$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$lambda2, pwSurvivalTime11$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$hazardRatio, pwSurvivalTime11$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$pi1, pwSurvivalTime11$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$pi2, pwSurvivalTime11$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$median1, pwSurvivalTime11$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$median2, pwSurvivalTime11$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$eventTime, pwSurvivalTime11$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$kappa, pwSurvivalTime11$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime11$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$delayedResponseAllowed, pwSurvivalTime11$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$delayedResponseEnabled, pwSurvivalTime11$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime11), "character") df <- as.data.frame(pwSurvivalTime11) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime11) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime12 <- getPiecewiseSurvivalTime(median2 = 5, median1 = 6) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime12' with expected results expect_equal(pwSurvivalTime12$piecewiseSurvivalTime, NA_real_) expect_equal(pwSurvivalTime12$lambda1, 0.11552453, tolerance = 1e-07) expect_equal(pwSurvivalTime12$lambda2, 0.13862944, tolerance = 1e-07) expect_equal(pwSurvivalTime12$hazardRatio, 0.83333333, tolerance = 1e-07) expect_equal(pwSurvivalTime12$pi1, NA_real_) expect_equal(pwSurvivalTime12$pi2, NA_real_) expect_equal(pwSurvivalTime12$median1, 6) expect_equal(pwSurvivalTime12$median2, 5) expect_equal(pwSurvivalTime12$eventTime, NA_real_) expect_equal(pwSurvivalTime12$kappa, 1) expect_equal(pwSurvivalTime12$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime12$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime12$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime12), NA))) expect_output(print(pwSurvivalTime12)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime12), NA))) expect_output(summary(pwSurvivalTime12)$show()) pwSurvivalTime12CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime12, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalTime, pwSurvivalTime12$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$lambda1, pwSurvivalTime12$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$lambda2, pwSurvivalTime12$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$hazardRatio, pwSurvivalTime12$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$pi1, pwSurvivalTime12$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$pi2, pwSurvivalTime12$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$median1, pwSurvivalTime12$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$median2, pwSurvivalTime12$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$eventTime, pwSurvivalTime12$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$kappa, pwSurvivalTime12$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime12$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$delayedResponseAllowed, pwSurvivalTime12$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$delayedResponseEnabled, pwSurvivalTime12$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime12), "character") df <- as.data.frame(pwSurvivalTime12) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime12) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime13 <- getPiecewiseSurvivalTime(median2 = 1.386294, lambda1 = c(0.3, 0.4)) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime13' with expected results expect_equal(pwSurvivalTime13$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime13$lambda1, c(0.3, 0.4), tolerance = 1e-07) expect_equal(pwSurvivalTime13$lambda2, 0.50000013, tolerance = 1e-07) expect_equal(pwSurvivalTime13$hazardRatio, c(0.59999984, 0.79999979), tolerance = 1e-07) expect_equal(pwSurvivalTime13$pi1, NA_real_) expect_equal(pwSurvivalTime13$pi2, NA_real_) expect_equal(pwSurvivalTime13$median1, c(2.3104906, 1.732868), tolerance = 1e-07) expect_equal(pwSurvivalTime13$median2, 1.386294, tolerance = 1e-07) expect_equal(pwSurvivalTime13$eventTime, NA_real_) expect_equal(pwSurvivalTime13$kappa, 1) expect_equal(pwSurvivalTime13$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime13$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime13$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime13), NA))) expect_output(print(pwSurvivalTime13)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime13), NA))) expect_output(summary(pwSurvivalTime13)$show()) pwSurvivalTime13CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime13, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalTime, pwSurvivalTime13$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$lambda1, pwSurvivalTime13$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$lambda2, pwSurvivalTime13$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$hazardRatio, pwSurvivalTime13$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$pi1, pwSurvivalTime13$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$pi2, pwSurvivalTime13$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$median1, pwSurvivalTime13$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$median2, pwSurvivalTime13$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$eventTime, pwSurvivalTime13$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$kappa, pwSurvivalTime13$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime13$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$delayedResponseAllowed, pwSurvivalTime13$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$delayedResponseEnabled, pwSurvivalTime13$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime13), "character") df <- as.data.frame(pwSurvivalTime13) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime13) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime14 <- getPiecewiseSurvivalTime(median2 = 5, median1 = c(6:8)) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime14' with expected results expect_equal(pwSurvivalTime14$piecewiseSurvivalTime, NA_real_) expect_equal(pwSurvivalTime14$lambda1, c(0.11552453, 0.099021026, 0.086643398), tolerance = 1e-07) expect_equal(pwSurvivalTime14$lambda2, 0.13862944, tolerance = 1e-07) expect_equal(pwSurvivalTime14$hazardRatio, c(0.83333333, 0.71428571, 0.625), tolerance = 1e-07) expect_equal(pwSurvivalTime14$pi1, NA_real_) expect_equal(pwSurvivalTime14$pi2, NA_real_) expect_equal(pwSurvivalTime14$median1, c(6, 7, 8)) expect_equal(pwSurvivalTime14$median2, 5) expect_equal(pwSurvivalTime14$eventTime, NA_real_) expect_equal(pwSurvivalTime14$kappa, 1) expect_equal(pwSurvivalTime14$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime14$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime14$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime14), NA))) expect_output(print(pwSurvivalTime14)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime14), NA))) expect_output(summary(pwSurvivalTime14)$show()) pwSurvivalTime14CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime14, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime14CodeBased$piecewiseSurvivalTime, pwSurvivalTime14$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime14CodeBased$lambda1, pwSurvivalTime14$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime14CodeBased$lambda2, pwSurvivalTime14$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime14CodeBased$hazardRatio, pwSurvivalTime14$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime14CodeBased$pi1, pwSurvivalTime14$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime14CodeBased$pi2, pwSurvivalTime14$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime14CodeBased$median1, pwSurvivalTime14$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime14CodeBased$median2, pwSurvivalTime14$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime14CodeBased$eventTime, pwSurvivalTime14$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime14CodeBased$kappa, pwSurvivalTime14$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime14CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime14$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime14CodeBased$delayedResponseAllowed, pwSurvivalTime14$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime14CodeBased$delayedResponseEnabled, pwSurvivalTime14$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime14), "character") df <- as.data.frame(pwSurvivalTime14) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime14) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime15 <- getPiecewiseSurvivalTime(median2 = 2, hazardRatio = 0.8) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime15' with expected results expect_equal(pwSurvivalTime15$piecewiseSurvivalTime, NA_real_) expect_equal(pwSurvivalTime15$lambda1, 0.27725887, tolerance = 1e-07) expect_equal(pwSurvivalTime15$lambda2, 0.34657359, tolerance = 1e-07) expect_equal(pwSurvivalTime15$hazardRatio, 0.8, tolerance = 1e-07) expect_equal(pwSurvivalTime15$pi1, NA_real_) expect_equal(pwSurvivalTime15$pi2, NA_real_) expect_equal(pwSurvivalTime15$median1, 2.5, tolerance = 1e-07) expect_equal(pwSurvivalTime15$median2, 2) expect_equal(pwSurvivalTime15$eventTime, NA_real_) expect_equal(pwSurvivalTime15$kappa, 1) expect_equal(pwSurvivalTime15$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime15$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime15$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime15), NA))) expect_output(print(pwSurvivalTime15)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime15), NA))) expect_output(summary(pwSurvivalTime15)$show()) pwSurvivalTime15CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime15, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime15CodeBased$piecewiseSurvivalTime, pwSurvivalTime15$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime15CodeBased$lambda1, pwSurvivalTime15$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime15CodeBased$lambda2, pwSurvivalTime15$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime15CodeBased$hazardRatio, pwSurvivalTime15$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime15CodeBased$pi1, pwSurvivalTime15$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime15CodeBased$pi2, pwSurvivalTime15$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime15CodeBased$median1, pwSurvivalTime15$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime15CodeBased$median2, pwSurvivalTime15$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime15CodeBased$eventTime, pwSurvivalTime15$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime15CodeBased$kappa, pwSurvivalTime15$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime15CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime15$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime15CodeBased$delayedResponseAllowed, pwSurvivalTime15$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime15CodeBased$delayedResponseEnabled, pwSurvivalTime15$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime15), "character") df <- as.data.frame(pwSurvivalTime15) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime15) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime16 <- getPiecewiseSurvivalTime(median1 = c(2, 2), hazardRatio = c(1.4, 1.4)) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime16' with expected results expect_equal(pwSurvivalTime16$piecewiseSurvivalTime, NA_real_) expect_equal(pwSurvivalTime16$lambda1, c(0.34657359, 0.34657359), tolerance = 1e-07) expect_equal(pwSurvivalTime16$lambda2, c(0.24755256, 0.24755256), tolerance = 1e-07) expect_equal(pwSurvivalTime16$hazardRatio, c(1.4, 1.4), tolerance = 1e-07) expect_equal(pwSurvivalTime16$pi1, NA_real_) expect_equal(pwSurvivalTime16$pi2, NA_real_) expect_equal(pwSurvivalTime16$median1, c(2, 2)) expect_equal(pwSurvivalTime16$median2, c(2.8, 2.8), tolerance = 1e-07) expect_equal(pwSurvivalTime16$eventTime, NA_real_) expect_equal(pwSurvivalTime16$kappa, 1) expect_equal(pwSurvivalTime16$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime16$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime16$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime16), NA))) expect_output(print(pwSurvivalTime16)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime16), NA))) expect_output(summary(pwSurvivalTime16)$show()) pwSurvivalTime16CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime16, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime16CodeBased$piecewiseSurvivalTime, pwSurvivalTime16$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime16CodeBased$lambda1, pwSurvivalTime16$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime16CodeBased$lambda2, pwSurvivalTime16$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime16CodeBased$hazardRatio, pwSurvivalTime16$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime16CodeBased$pi1, pwSurvivalTime16$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime16CodeBased$pi2, pwSurvivalTime16$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime16CodeBased$median1, pwSurvivalTime16$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime16CodeBased$median2, pwSurvivalTime16$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime16CodeBased$eventTime, pwSurvivalTime16$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime16CodeBased$kappa, pwSurvivalTime16$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime16CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime16$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime16CodeBased$delayedResponseAllowed, pwSurvivalTime16$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime16CodeBased$delayedResponseEnabled, pwSurvivalTime16$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime16), "character") df <- as.data.frame(pwSurvivalTime16) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime16) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime17 <- getPiecewiseSurvivalTime(median1 = c(2, 3), median2 = 4) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime17' with expected results expect_equal(pwSurvivalTime17$piecewiseSurvivalTime, NA_real_) expect_equal(pwSurvivalTime17$lambda1, c(0.34657359, 0.23104906), tolerance = 1e-07) expect_equal(pwSurvivalTime17$lambda2, 0.1732868, tolerance = 1e-07) expect_equal(pwSurvivalTime17$hazardRatio, c(2, 1.3333333), tolerance = 1e-07) expect_equal(pwSurvivalTime17$pi1, NA_real_) expect_equal(pwSurvivalTime17$pi2, NA_real_) expect_equal(pwSurvivalTime17$median1, c(2, 3)) expect_equal(pwSurvivalTime17$median2, 4) expect_equal(pwSurvivalTime17$eventTime, NA_real_) expect_equal(pwSurvivalTime17$kappa, 1) expect_equal(pwSurvivalTime17$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime17$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime17$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime17), NA))) expect_output(print(pwSurvivalTime17)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime17), NA))) expect_output(summary(pwSurvivalTime17)$show()) pwSurvivalTime17CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime17, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime17CodeBased$piecewiseSurvivalTime, pwSurvivalTime17$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime17CodeBased$lambda1, pwSurvivalTime17$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime17CodeBased$lambda2, pwSurvivalTime17$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime17CodeBased$hazardRatio, pwSurvivalTime17$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime17CodeBased$pi1, pwSurvivalTime17$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime17CodeBased$pi2, pwSurvivalTime17$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime17CodeBased$median1, pwSurvivalTime17$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime17CodeBased$median2, pwSurvivalTime17$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime17CodeBased$eventTime, pwSurvivalTime17$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime17CodeBased$kappa, pwSurvivalTime17$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime17CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime17$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime17CodeBased$delayedResponseAllowed, pwSurvivalTime17$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime17CodeBased$delayedResponseEnabled, pwSurvivalTime17$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime17), "character") df <- as.data.frame(pwSurvivalTime17) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime17) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime18 <- getPiecewiseSurvivalTime(median1 = c(2, 3), lambda2 = 0.4) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime18' with expected results expect_equal(pwSurvivalTime18$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime18$lambda1, c(0.34657359, 0.23104906), tolerance = 1e-07) expect_equal(pwSurvivalTime18$lambda2, 0.4, tolerance = 1e-07) expect_equal(pwSurvivalTime18$hazardRatio, c(0.86643398, 0.57762265), tolerance = 1e-07) expect_equal(pwSurvivalTime18$pi1, NA_real_) expect_equal(pwSurvivalTime18$pi2, NA_real_) expect_equal(pwSurvivalTime18$median1, c(2, 3)) expect_equal(pwSurvivalTime18$median2, 1.732868, tolerance = 1e-07) expect_equal(pwSurvivalTime18$eventTime, NA_real_) expect_equal(pwSurvivalTime18$kappa, 1) expect_equal(pwSurvivalTime18$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime18$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime18$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime18), NA))) expect_output(print(pwSurvivalTime18)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime18), NA))) expect_output(summary(pwSurvivalTime18)$show()) pwSurvivalTime18CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime18, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime18CodeBased$piecewiseSurvivalTime, pwSurvivalTime18$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime18CodeBased$lambda1, pwSurvivalTime18$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime18CodeBased$lambda2, pwSurvivalTime18$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime18CodeBased$hazardRatio, pwSurvivalTime18$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime18CodeBased$pi1, pwSurvivalTime18$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime18CodeBased$pi2, pwSurvivalTime18$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime18CodeBased$median1, pwSurvivalTime18$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime18CodeBased$median2, pwSurvivalTime18$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime18CodeBased$eventTime, pwSurvivalTime18$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime18CodeBased$kappa, pwSurvivalTime18$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime18CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime18$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime18CodeBased$delayedResponseAllowed, pwSurvivalTime18$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime18CodeBased$delayedResponseEnabled, pwSurvivalTime18$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime18), "character") df <- as.data.frame(pwSurvivalTime18) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime18) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime19 <- getPiecewiseSurvivalTime(pi1 = 0.45) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime19' with expected results expect_equal(pwSurvivalTime19$piecewiseSurvivalTime, NA_real_) expect_equal(pwSurvivalTime19$lambda1, 0.04981975, tolerance = 1e-07) expect_equal(pwSurvivalTime19$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(pwSurvivalTime19$hazardRatio, 2.6791588, tolerance = 1e-07) expect_equal(pwSurvivalTime19$pi1, 0.45, tolerance = 1e-07) expect_equal(pwSurvivalTime19$pi2, 0.2, tolerance = 1e-07) expect_equal(pwSurvivalTime19$median1, 13.9131, tolerance = 1e-07) expect_equal(pwSurvivalTime19$median2, 37.275405, tolerance = 1e-07) expect_equal(pwSurvivalTime19$eventTime, 12) expect_equal(pwSurvivalTime19$kappa, 1) expect_equal(pwSurvivalTime19$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime19$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime19$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime19), NA))) expect_output(print(pwSurvivalTime19)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime19), NA))) expect_output(summary(pwSurvivalTime19)$show()) pwSurvivalTime19CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime19, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime19CodeBased$piecewiseSurvivalTime, pwSurvivalTime19$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime19CodeBased$lambda1, pwSurvivalTime19$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime19CodeBased$lambda2, pwSurvivalTime19$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime19CodeBased$hazardRatio, pwSurvivalTime19$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime19CodeBased$pi1, pwSurvivalTime19$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime19CodeBased$pi2, pwSurvivalTime19$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime19CodeBased$median1, pwSurvivalTime19$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime19CodeBased$median2, pwSurvivalTime19$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime19CodeBased$eventTime, pwSurvivalTime19$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime19CodeBased$kappa, pwSurvivalTime19$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime19CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime19$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime19CodeBased$delayedResponseAllowed, pwSurvivalTime19$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime19CodeBased$delayedResponseEnabled, pwSurvivalTime19$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime19), "character") df <- as.data.frame(pwSurvivalTime19) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime19) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime20 <- getPiecewiseSurvivalTime(median1 = c(2, 4), hazardRatio = c(1.4, 0.7)) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime20' with expected results expect_equal(pwSurvivalTime20$piecewiseSurvivalTime, NA_real_) expect_equal(pwSurvivalTime20$lambda1, c(0.34657359, 0.1732868), tolerance = 1e-07) expect_equal(pwSurvivalTime20$lambda2, c(0.24755256, 0.24755256), tolerance = 1e-07) expect_equal(pwSurvivalTime20$hazardRatio, c(1.4, 0.7), tolerance = 1e-07) expect_equal(pwSurvivalTime20$pi1, NA_real_) expect_equal(pwSurvivalTime20$pi2, NA_real_) expect_equal(pwSurvivalTime20$median1, c(2, 4)) expect_equal(pwSurvivalTime20$median2, c(2.8, 2.8), tolerance = 1e-07) expect_equal(pwSurvivalTime20$eventTime, NA_real_) expect_equal(pwSurvivalTime20$kappa, 1) expect_equal(pwSurvivalTime20$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime20$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime20$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime20), NA))) expect_output(print(pwSurvivalTime20)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime20), NA))) expect_output(summary(pwSurvivalTime20)$show()) pwSurvivalTime20CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime20, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime20CodeBased$piecewiseSurvivalTime, pwSurvivalTime20$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime20CodeBased$lambda1, pwSurvivalTime20$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime20CodeBased$lambda2, pwSurvivalTime20$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime20CodeBased$hazardRatio, pwSurvivalTime20$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime20CodeBased$pi1, pwSurvivalTime20$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime20CodeBased$pi2, pwSurvivalTime20$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime20CodeBased$median1, pwSurvivalTime20$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime20CodeBased$median2, pwSurvivalTime20$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime20CodeBased$eventTime, pwSurvivalTime20$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime20CodeBased$kappa, pwSurvivalTime20$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime20CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime20$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime20CodeBased$delayedResponseAllowed, pwSurvivalTime20$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime20CodeBased$delayedResponseEnabled, pwSurvivalTime20$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime20), "character") df <- as.data.frame(pwSurvivalTime20) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime20) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime21 <- getPiecewiseSurvivalTime(median1 = 3, hazardRatio = 0.8) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime21' with expected results expect_equal(pwSurvivalTime21$piecewiseSurvivalTime, NA_real_) expect_equal(pwSurvivalTime21$lambda1, 0.23104906, tolerance = 1e-07) expect_equal(pwSurvivalTime21$lambda2, 0.28881133, tolerance = 1e-07) expect_equal(pwSurvivalTime21$hazardRatio, 0.8, tolerance = 1e-07) expect_equal(pwSurvivalTime21$pi1, NA_real_) expect_equal(pwSurvivalTime21$pi2, NA_real_) expect_equal(pwSurvivalTime21$median1, 3) expect_equal(pwSurvivalTime21$median2, 2.4, tolerance = 1e-07) expect_equal(pwSurvivalTime21$eventTime, NA_real_) expect_equal(pwSurvivalTime21$kappa, 1) expect_equal(pwSurvivalTime21$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime21$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime21$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime21), NA))) expect_output(print(pwSurvivalTime21)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime21), NA))) expect_output(summary(pwSurvivalTime21)$show()) pwSurvivalTime21CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime21, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime21CodeBased$piecewiseSurvivalTime, pwSurvivalTime21$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime21CodeBased$lambda1, pwSurvivalTime21$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime21CodeBased$lambda2, pwSurvivalTime21$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime21CodeBased$hazardRatio, pwSurvivalTime21$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime21CodeBased$pi1, pwSurvivalTime21$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime21CodeBased$pi2, pwSurvivalTime21$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime21CodeBased$median1, pwSurvivalTime21$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime21CodeBased$median2, pwSurvivalTime21$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime21CodeBased$eventTime, pwSurvivalTime21$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime21CodeBased$kappa, pwSurvivalTime21$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime21CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime21$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime21CodeBased$delayedResponseAllowed, pwSurvivalTime21$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime21CodeBased$delayedResponseEnabled, pwSurvivalTime21$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime21), "character") df <- as.data.frame(pwSurvivalTime21) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime21) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } expect_error(getPiecewiseSurvivalTime(median2 = 1.386294, lambda2 = 0.4, hazardRatio = 0.8)) expect_error(getPiecewiseSurvivalTime(median2 = c(1.5, 1.7), lambda1 = c(0.3, 0.4))) expect_error(getPiecewiseSurvivalTime(median1 = c(2, 4), hazardRatio = c(1, 0.7))) expect_error(getPiecewiseSurvivalTime(median1 = c(2, 4), hazardRatio = 0.7)) }) test_that("Testing 'getPiecewiseSurvivalTime': vector based definition", { # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} pwSurvivalTime1 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6, 9), lambda2 = c(0.025, 0.04, 0.015), hazardRatio = 0.8) expect_equal(pwSurvivalTime1$hazardRatio, 0.8) expect_equal(pwSurvivalTime1$lambda1, c(0.025, 0.04, 0.015) * 0.8) expect_false(pwSurvivalTime1$isDelayedResponseEnabled()) .skipTestIfDisabled() pwSurvivalTime2 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.1, 0.2, 0.8), hazardRatio = 0.8) expect_true(pwSurvivalTime2$isPiecewiseSurvivalEnabled()) expect_false(pwSurvivalTime2$isDelayedResponseEnabled()) expect_equal(pwSurvivalTime2$hazardRatio, 0.8) expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, c(0, 5, 10)) expect_equal(pwSurvivalTime2$lambda2, c(0.1, 0.2, 0.8)) pwSurvivalTime3 <- getPiecewiseSurvivalTime(c(0, 6), lambda2 = c(0.01, 0.03), hazardRatio = 0.8) expect_true(pwSurvivalTime3$isPiecewiseSurvivalEnabled()) expect_false(pwSurvivalTime3$isDelayedResponseEnabled()) expect_equal(pwSurvivalTime3$hazardRatio, 0.8) expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, c(0, 6)) expect_equal(pwSurvivalTime3$lambda2, c(0.01, 0.03)) pwSurvivalTime4 <- getPiecewiseSurvivalTime(0, lambda2 = 0.01, hazardRatio = 0.8) expect_true(pwSurvivalTime4$isPiecewiseSurvivalEnabled()) expect_false(pwSurvivalTime4$isDelayedResponseEnabled()) expect_equal(pwSurvivalTime4$hazardRatio, 0.8) expect_equal(pwSurvivalTime4$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime4$lambda2, 0.01) expect_equal(pwSurvivalTime4$lambda1, 0.01 * 0.8) pwSurvivalTime5 <- getPiecewiseSurvivalTime(NA_real_, lambda2 = 0.01, hazardRatio = 0.8) expect_true(pwSurvivalTime5$isPiecewiseSurvivalEnabled()) expect_false(pwSurvivalTime5$isDelayedResponseEnabled()) expect_equal(pwSurvivalTime5$hazardRatio, 0.8) expect_equal(pwSurvivalTime5$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime5$lambda2, 0.01) expect_equal(pwSurvivalTime5$lambda1, 0.01 * 0.8) pwSurvivalTime6 <- getPiecewiseSurvivalTime(0, lambda2 = 0.01, lambda1 = 0.008) expect_true(pwSurvivalTime6$isPiecewiseSurvivalEnabled()) expect_false(pwSurvivalTime6$isDelayedResponseEnabled()) expect_equal(pwSurvivalTime6$hazardRatio, 0.8) expect_equal(pwSurvivalTime6$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime6$lambda2, 0.01) expect_equal(pwSurvivalTime6$lambda1, 0.008) pwSurvivalTime7 <- getPiecewiseSurvivalTime(NA_real_, lambda2 = 0.01, lambda1 = 0.008) expect_true(pwSurvivalTime7$isPiecewiseSurvivalEnabled()) expect_false(pwSurvivalTime7$isDelayedResponseEnabled()) expect_equal(pwSurvivalTime7$hazardRatio, 0.8) expect_equal(pwSurvivalTime7$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime7$lambda2, 0.01) expect_equal(pwSurvivalTime7$lambda1, 0.008) # case 2.2 pwSurvivalTime9 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6, 9), lambda2 = c(0.025, 0.04, 0.015), lambda1 = c(0.025, 0.04, 0.015) * 0.8) expect_true(pwSurvivalTime9$isPiecewiseSurvivalEnabled()) expect_false(pwSurvivalTime9$isDelayedResponseEnabled()) expect_equal(pwSurvivalTime9$hazardRatio, 0.8) pwSurvivalTime10 <- getPiecewiseSurvivalTime(lambda2 = 0.025, hazardRatio = 0.8) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime10' with expected results expect_equal(pwSurvivalTime10$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime10$lambda1, 0.02, tolerance = 1e-07) expect_equal(pwSurvivalTime10$lambda2, 0.025, tolerance = 1e-07) expect_equal(pwSurvivalTime10$hazardRatio, 0.8, tolerance = 1e-07) expect_equal(pwSurvivalTime10$pi1, NA_real_) expect_equal(pwSurvivalTime10$pi2, NA_real_) expect_equal(pwSurvivalTime10$median1, 34.657359, tolerance = 1e-07) expect_equal(pwSurvivalTime10$median2, 27.725887, tolerance = 1e-07) expect_equal(pwSurvivalTime10$eventTime, NA_real_) expect_equal(pwSurvivalTime10$kappa, 1) expect_equal(pwSurvivalTime10$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime10$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime10$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime10), NA))) expect_output(print(pwSurvivalTime10)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime10), NA))) expect_output(summary(pwSurvivalTime10)$show()) pwSurvivalTime10CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime10, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalTime, pwSurvivalTime10$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$lambda1, pwSurvivalTime10$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$lambda2, pwSurvivalTime10$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$hazardRatio, pwSurvivalTime10$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$pi1, pwSurvivalTime10$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$pi2, pwSurvivalTime10$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$median1, pwSurvivalTime10$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$median2, pwSurvivalTime10$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$eventTime, pwSurvivalTime10$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$kappa, pwSurvivalTime10$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime10$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$delayedResponseAllowed, pwSurvivalTime10$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime10CodeBased$delayedResponseEnabled, pwSurvivalTime10$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime10), "character") df <- as.data.frame(pwSurvivalTime10) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime10) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime11 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = 0, lambda2 = 0.025, hazardRatio = 0.8) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime11' with expected results expect_equal(pwSurvivalTime11$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime11$lambda1, 0.02, tolerance = 1e-07) expect_equal(pwSurvivalTime11$lambda2, 0.025, tolerance = 1e-07) expect_equal(pwSurvivalTime11$hazardRatio, 0.8, tolerance = 1e-07) expect_equal(pwSurvivalTime11$pi1, NA_real_) expect_equal(pwSurvivalTime11$pi2, NA_real_) expect_equal(pwSurvivalTime11$median1, 34.657359, tolerance = 1e-07) expect_equal(pwSurvivalTime11$median2, 27.725887, tolerance = 1e-07) expect_equal(pwSurvivalTime11$eventTime, NA_real_) expect_equal(pwSurvivalTime11$kappa, 1) expect_equal(pwSurvivalTime11$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime11$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime11$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime11), NA))) expect_output(print(pwSurvivalTime11)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime11), NA))) expect_output(summary(pwSurvivalTime11)$show()) pwSurvivalTime11CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime11, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalTime, pwSurvivalTime11$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$lambda1, pwSurvivalTime11$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$lambda2, pwSurvivalTime11$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$hazardRatio, pwSurvivalTime11$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$pi1, pwSurvivalTime11$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$pi2, pwSurvivalTime11$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$median1, pwSurvivalTime11$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$median2, pwSurvivalTime11$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$eventTime, pwSurvivalTime11$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$kappa, pwSurvivalTime11$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime11$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$delayedResponseAllowed, pwSurvivalTime11$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime11CodeBased$delayedResponseEnabled, pwSurvivalTime11$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime11), "character") df <- as.data.frame(pwSurvivalTime11) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime11) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime12 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = c(0.025, 0.01), hazardRatio = c(0.8, 0.9)) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime12' with expected results expect_equal(pwSurvivalTime12$piecewiseSurvivalTime, c(0, 6)) expect_equal(pwSurvivalTime12$lambda1, NA_real_) expect_equal(pwSurvivalTime12$lambda2, c(0.025, 0.01), tolerance = 1e-07) expect_equal(pwSurvivalTime12$hazardRatio, c(0.8, 0.9), tolerance = 1e-07) expect_equal(pwSurvivalTime12$pi1, NA_real_) expect_equal(pwSurvivalTime12$pi2, NA_real_) expect_equal(pwSurvivalTime12$median1, NA_real_) expect_equal(pwSurvivalTime12$median2, NA_real_) expect_equal(pwSurvivalTime12$eventTime, NA_real_) expect_equal(pwSurvivalTime12$kappa, 1) expect_equal(pwSurvivalTime12$piecewiseSurvivalEnabled, TRUE) expect_equal(pwSurvivalTime12$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime12$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime12), NA))) expect_output(print(pwSurvivalTime12)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime12), NA))) expect_output(summary(pwSurvivalTime12)$show()) pwSurvivalTime12CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime12, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalTime, pwSurvivalTime12$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$lambda1, pwSurvivalTime12$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$lambda2, pwSurvivalTime12$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$hazardRatio, pwSurvivalTime12$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$pi1, pwSurvivalTime12$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$pi2, pwSurvivalTime12$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$median1, pwSurvivalTime12$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$median2, pwSurvivalTime12$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$eventTime, pwSurvivalTime12$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$kappa, pwSurvivalTime12$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime12$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$delayedResponseAllowed, pwSurvivalTime12$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime12CodeBased$delayedResponseEnabled, pwSurvivalTime12$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime12), "character") df <- as.data.frame(pwSurvivalTime12) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime12) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime13 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = c(0.025, 0.01), hazardRatio = c(0.8, 0.9), delayedResponseAllowed = TRUE) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime13' with expected results expect_equal(pwSurvivalTime13$piecewiseSurvivalTime, c(0, 6)) expect_equal(pwSurvivalTime13$lambda1, c(0.02, 0.009), tolerance = 1e-07) expect_equal(pwSurvivalTime13$lambda2, c(0.025, 0.01), tolerance = 1e-07) expect_equal(pwSurvivalTime13$hazardRatio, c(0.8, 0.9), tolerance = 1e-07) expect_equal(pwSurvivalTime13$pi1, NA_real_) expect_equal(pwSurvivalTime13$pi2, NA_real_) expect_equal(pwSurvivalTime13$median1, NA_real_) expect_equal(pwSurvivalTime13$median2, NA_real_) expect_equal(pwSurvivalTime13$eventTime, NA_real_) expect_equal(pwSurvivalTime13$kappa, 1) expect_equal(pwSurvivalTime13$piecewiseSurvivalEnabled, TRUE) expect_equal(pwSurvivalTime13$delayedResponseAllowed, TRUE) expect_equal(pwSurvivalTime13$delayedResponseEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime13), NA))) expect_output(print(pwSurvivalTime13)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime13), NA))) expect_output(summary(pwSurvivalTime13)$show()) pwSurvivalTime13CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime13, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalTime, pwSurvivalTime13$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$lambda1, pwSurvivalTime13$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$lambda2, pwSurvivalTime13$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$hazardRatio, pwSurvivalTime13$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$pi1, pwSurvivalTime13$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$pi2, pwSurvivalTime13$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$median1, pwSurvivalTime13$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$median2, pwSurvivalTime13$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$eventTime, pwSurvivalTime13$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$kappa, pwSurvivalTime13$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime13$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$delayedResponseAllowed, pwSurvivalTime13$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime13CodeBased$delayedResponseEnabled, pwSurvivalTime13$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime13), "character") df <- as.data.frame(pwSurvivalTime13) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime13) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # case 2.2: error expected expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6, 9), lambda2 = c(0.025, 0.04, 0.015), lambda1 = c(0.03, 0.04, 0.025)), paste0("Illegal argument: 'hazardRatio' can only be calculated if ", "'unique(lambda1 / lambda2)' result in a single value; ", "current result = c(1.2, 1, 1.667) (delayed response is not allowed)"), fixed = TRUE) # case 3 expect_false(getPiecewiseSurvivalTime(delayedResponseAllowed = TRUE)$isPiecewiseSurvivalEnabled()) expect_false(getPiecewiseSurvivalTime(piecewiseSurvivalTime = NA, delayedResponseAllowed = TRUE)$isPiecewiseSurvivalEnabled()) # case 3.1 pwSurvivalTimeSim1 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6, 9), lambda2 = c(0.025, 0.04, 0.015), hazardRatio = 0.8, delayedResponseAllowed = TRUE) expect_equal(pwSurvivalTimeSim1$hazardRatio, 0.8) expect_equal(pwSurvivalTimeSim1$lambda1, c(0.025, 0.04, 0.015) * 0.8) expect_false(pwSurvivalTimeSim1$isDelayedResponseEnabled()) # case 3.2 pwSurvivalTimeSim2 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6, 9), lambda2 = c(0.025, 0.04, 0.015), lambda1 = c(0.03, 0.04, 0.025), delayedResponseAllowed = TRUE) expect_true(pwSurvivalTimeSim2$isPiecewiseSurvivalEnabled()) expect_true(pwSurvivalTimeSim2$isDelayedResponseEnabled()) expect_equal(pwSurvivalTimeSim2$hazardRatio, c(1.2, 1, 5/3)) pwsTime1 <- getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4) expect_equal(pwsTime1$.isLambdaBased(minNumberOfLambdas = 1), TRUE) }) test_that("Testing 'getPiecewiseSurvivalTime': check error and warnings", { # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} expect_error(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4, pi2 = 0.4), "Conflicting arguments: it is not allowed to specify 'pi2' (0.4) and 'lambda2' (0.4) concurrently", fixed = TRUE) expect_error(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4, pi2 = 0.4, pi1 = 0.3), "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda2' (0.4) concurrently", fixed = TRUE) expect_error(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4, pi2 = 0.4, pi1 = 0.3), "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda2' (0.4) concurrently", fixed = TRUE) expect_error(getPiecewiseSurvivalTime(lambda2 = 0.4, lambda1 = 0.3, pi2 = 0.4, pi1 = 0.3), "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda1' (0.3) concurrently", fixed = TRUE) expect_error(getPiecewiseSurvivalTime(lambda2 = 0.4, lambda1 = 0.3, pi2 = 0.4, pi1 = 0.3), "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda1' (0.3) concurrently", fixed = TRUE) expect_equal(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi2 = 0.4)$.isPiBased(), TRUE) expect_warning(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi2 = 0.4, pi1 = 0.3), "'hazardRatio' (0.6, 0.8) will be ignored because it will be calculated", fixed = TRUE) expect_warning(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi1 = 0.3), "'hazardRatio' (0.6, 0.8) will be ignored because it will be calculated", fixed = TRUE) expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = 0.025, hazardRatio = 0.8, delayedResponseAllowed = TRUE), "Illegal argument: length of 'piecewiseSurvivalTime' (2) and length of 'lambda2' (1) must be equal", fixed = TRUE) expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6, 12), lambda2 = 0.025, hazardRatio = 0.8, delayedResponseAllowed = TRUE), "Illegal argument: length of 'piecewiseSurvivalTime' (3) and length of 'lambda2' (1) must be equal", fixed = TRUE) expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = 0.025, hazardRatio = 0.8), "Illegal argument: length of 'piecewiseSurvivalTime' (2) and length of 'lambda2' (1) must be equal", fixed = TRUE) }) test_that("Testing 'getPiecewiseSurvivalTime': list-wise definition", { # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} pwSurvivalTime8 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list( "<6" = 0.025, "6 - <9" = 0.04, "9 - <15" = 0.015, "15 - <21" = 0.01, ">=21" = 0.007), hazardRatio = 0.6) expect_true(pwSurvivalTime8$isPiecewiseSurvivalEnabled()) expect_false(pwSurvivalTime8$isDelayedResponseEnabled()) expect_equal(pwSurvivalTime8$hazardRatio, 0.6) expect_equal(pwSurvivalTime8$piecewiseSurvivalTime, c(0, 6,9, 15, 21)) expect_equal(pwSurvivalTime8$lambda2, c(0.025, 0.040, 0.015, 0.010, 0.007)) expect_equal(pwSurvivalTime8$lambda1, c(0.0150, 0.0240, 0.0090, 0.0060, 0.0042)) .skipTestIfDisabled() result1 <- getPiecewiseSurvivalTime(list( "<5" = 0.1, "5 - <10" = 0.2, ">=10" = 0.8), hazardRatio = 0.8) expect_equal(result1$piecewiseSurvivalTime, c(0, 5, 10)) expect_equal(result1$lambda2, c(0.1, 0.2, 0.8)) result2 <- getPiecewiseSurvivalTime(list( "0 - <5" = 0.1, "5 - <10" = 0.2, "10 - Inf" = 0.8), hazardRatio = 0.8) expect_equal(result2$piecewiseSurvivalTime, c(0, 5, 10)) expect_equal(result2$lambda2, c(0.1, 0.2, 0.8)) pwSurvivalTime2 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.1, 0.2, 0.8), hazardRatio = 0.8) expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, c(0, 5, 10)) expect_equal(pwSurvivalTime2$lambda2, c(0.1, 0.2, 0.8)) pwSurvivalTime3 <- getPiecewiseSurvivalTime(c(0, 6), lambda2 = c(0.01, 0.03), hazardRatio = 0.8) expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, c(0, 6)) expect_equal(pwSurvivalTime3$lambda2, c(0.01, 0.03)) pwSurvivalTime4 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("0 - ?" = 0.025), hazardRatio = 0.8, delayedResponseAllowed = TRUE) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime4' with expected results expect_equal(pwSurvivalTime4$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime4$lambda1, 0.02, tolerance = 1e-07) expect_equal(pwSurvivalTime4$lambda2, 0.025, tolerance = 1e-07) expect_equal(pwSurvivalTime4$hazardRatio, 0.8, tolerance = 1e-07) expect_equal(pwSurvivalTime4$pi1, NA_real_) expect_equal(pwSurvivalTime4$pi2, NA_real_) expect_equal(pwSurvivalTime4$median1, 34.657359, tolerance = 1e-07) expect_equal(pwSurvivalTime4$median2, 27.725887, tolerance = 1e-07) expect_equal(pwSurvivalTime4$eventTime, NA_real_) expect_equal(pwSurvivalTime4$kappa, 1) expect_equal(pwSurvivalTime4$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime4$delayedResponseAllowed, TRUE) expect_equal(pwSurvivalTime4$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime4), NA))) expect_output(print(pwSurvivalTime4)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime4), NA))) expect_output(summary(pwSurvivalTime4)$show()) pwSurvivalTime4CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime4, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime4CodeBased$piecewiseSurvivalTime, pwSurvivalTime4$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime4CodeBased$lambda1, pwSurvivalTime4$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime4CodeBased$lambda2, pwSurvivalTime4$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime4CodeBased$hazardRatio, pwSurvivalTime4$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime4CodeBased$pi1, pwSurvivalTime4$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime4CodeBased$pi2, pwSurvivalTime4$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime4CodeBased$median1, pwSurvivalTime4$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime4CodeBased$median2, pwSurvivalTime4$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime4CodeBased$eventTime, pwSurvivalTime4$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime4CodeBased$kappa, pwSurvivalTime4$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime4CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime4$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime4CodeBased$delayedResponseAllowed, pwSurvivalTime4$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime4CodeBased$delayedResponseEnabled, pwSurvivalTime4$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime4), "character") df <- as.data.frame(pwSurvivalTime4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime5 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("x" = 0.025), hazardRatio = 0.8, delayedResponseAllowed = TRUE) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime5' with expected results expect_equal(pwSurvivalTime5$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime5$lambda1, 0.02, tolerance = 1e-07) expect_equal(pwSurvivalTime5$lambda2, 0.025, tolerance = 1e-07) expect_equal(pwSurvivalTime5$hazardRatio, 0.8, tolerance = 1e-07) expect_equal(pwSurvivalTime5$pi1, NA_real_) expect_equal(pwSurvivalTime5$pi2, NA_real_) expect_equal(pwSurvivalTime5$median1, 34.657359, tolerance = 1e-07) expect_equal(pwSurvivalTime5$median2, 27.725887, tolerance = 1e-07) expect_equal(pwSurvivalTime5$eventTime, NA_real_) expect_equal(pwSurvivalTime5$kappa, 1) expect_equal(pwSurvivalTime5$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime5$delayedResponseAllowed, TRUE) expect_equal(pwSurvivalTime5$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime5), NA))) expect_output(print(pwSurvivalTime5)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime5), NA))) expect_output(summary(pwSurvivalTime5)$show()) pwSurvivalTime5CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime5, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime5CodeBased$piecewiseSurvivalTime, pwSurvivalTime5$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime5CodeBased$lambda1, pwSurvivalTime5$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime5CodeBased$lambda2, pwSurvivalTime5$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime5CodeBased$hazardRatio, pwSurvivalTime5$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime5CodeBased$pi1, pwSurvivalTime5$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime5CodeBased$pi2, pwSurvivalTime5$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime5CodeBased$median1, pwSurvivalTime5$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime5CodeBased$median2, pwSurvivalTime5$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime5CodeBased$eventTime, pwSurvivalTime5$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime5CodeBased$kappa, pwSurvivalTime5$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime5CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime5$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime5CodeBased$delayedResponseAllowed, pwSurvivalTime5$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime5CodeBased$delayedResponseEnabled, pwSurvivalTime5$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime5), "character") df <- as.data.frame(pwSurvivalTime5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime6 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("0 - 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime7 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("x" = 0.025), hazardRatio = 0.8, delayedResponseAllowed = FALSE) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime7' with expected results expect_equal(pwSurvivalTime7$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime7$lambda1, 0.02, tolerance = 1e-07) expect_equal(pwSurvivalTime7$lambda2, 0.025, tolerance = 1e-07) expect_equal(pwSurvivalTime7$hazardRatio, 0.8, tolerance = 1e-07) expect_equal(pwSurvivalTime7$pi1, NA_real_) expect_equal(pwSurvivalTime7$pi2, NA_real_) expect_equal(pwSurvivalTime7$median1, 34.657359, tolerance = 1e-07) expect_equal(pwSurvivalTime7$median2, 27.725887, tolerance = 1e-07) expect_equal(pwSurvivalTime7$eventTime, NA_real_) expect_equal(pwSurvivalTime7$kappa, 1) expect_equal(pwSurvivalTime7$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime7$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime7$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime7), NA))) expect_output(print(pwSurvivalTime7)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime7), NA))) expect_output(summary(pwSurvivalTime7)$show()) pwSurvivalTime7CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime7, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime7CodeBased$piecewiseSurvivalTime, pwSurvivalTime7$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime7CodeBased$lambda1, pwSurvivalTime7$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime7CodeBased$lambda2, pwSurvivalTime7$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime7CodeBased$hazardRatio, pwSurvivalTime7$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime7CodeBased$pi1, pwSurvivalTime7$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime7CodeBased$pi2, pwSurvivalTime7$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime7CodeBased$median1, pwSurvivalTime7$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime7CodeBased$median2, pwSurvivalTime7$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime7CodeBased$eventTime, pwSurvivalTime7$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime7CodeBased$kappa, pwSurvivalTime7$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime7CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime7$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime7CodeBased$delayedResponseAllowed, pwSurvivalTime7$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime7CodeBased$delayedResponseEnabled, pwSurvivalTime7$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime7), "character") df <- as.data.frame(pwSurvivalTime7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime8 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("0 - 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } expect_warning(getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("<6" = 0.025), hazardRatio = 0.8), "Defined time period \"0 - <6\" will be ignored because 'piecewiseSurvivalTime' list has only 1 entry", fixed = TRUE) }) context("Testing Class 'AccrualTime'") test_that("Testing 'getAccrualTime': isAccrualTimeEnabled()", { expect_true(getAccrualTime()$isAccrualTimeEnabled()) expect_true(getAccrualTime(maxNumberOfSubjects = 100)$isAccrualTimeEnabled()) }) test_that("Testing 'getAccrualTime': vector based definition", { accrualTime1 <- getAccrualTime(accrualTime = c(0, 6, 9, 15), accrualIntensity = c(15, 21, 27), maxNumberOfSubjects = 315) expect_equal(accrualTime1$accrualTime, c(0, 6, 9, 15)) expect_equal(accrualTime1$accrualIntensity, c(15, 21, 27)) expect_equal(accrualTime1$remainingTime, NA_real_) accrualTime2 <- getAccrualTime(accrualTime = c(0, 6, 9), accrualIntensity = c(15, 21, 27), maxNumberOfSubjects = 1000) expect_equal(accrualTime2$accrualTime, c(0, 6, 9, 40.37037)) expect_equal(accrualTime2$accrualIntensity, c(15, 21, 27)) expect_equal(accrualTime2$remainingTime, 31.37037) .skipTestIfDisabled() accrualTime3 <- getAccrualTime(accrualTime = c(0, 12, 13, 14, 15, 16), accrualIntensity = c(15, 21, 27, 33, 39, 45), maxNumberOfSubjects = 1405) expect_equal(accrualTime3$accrualTime, c( 0, 12, 13, 14, 15, 16, 40.55555556)) expect_equal(accrualTime3$accrualIntensity, c(15, 21, 27, 33, 39, 45)) expect_equal(accrualTime3$remainingTime, 24.55555556) accrualTime4 <- getAccrualTime(accrualTime = c(0, 24), accrualIntensity = c(30), maxNumberOfSubjects = 720) ## Comparison of the results of AccrualTime object 'accrualTime4' with expected results expect_equal(accrualTime4$endOfAccrualIsUserDefined, TRUE) expect_equal(accrualTime4$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime4$maxNumberOfSubjectsIsUserDefined, TRUE) expect_equal(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime4$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime4$accrualTime, c(0, 24)) expect_equal(accrualTime4$accrualIntensity, 30) expect_equal(accrualTime4$accrualIntensityRelative, NA_real_) expect_equal(accrualTime4$maxNumberOfSubjects, 720) expect_equal(accrualTime4$remainingTime, NA_real_) expect_equal(accrualTime4$piecewiseAccrualEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime4), NA))) expect_output(print(accrualTime4)$show()) invisible(capture.output(expect_error(summary(accrualTime4), NA))) expect_output(summary(accrualTime4)$show()) accrualTime4CodeBased <- eval(parse(text = getObjectRCode(accrualTime4, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime4CodeBased$endOfAccrualIsUserDefined, accrualTime4$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$followUpTimeMustBeUserDefined, accrualTime4$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime4$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$absoluteAccrualIntensityEnabled, accrualTime4$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$accrualTime, accrualTime4$accrualTime, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$accrualIntensity, accrualTime4$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$accrualIntensityRelative, accrualTime4$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$maxNumberOfSubjects, accrualTime4$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$remainingTime, accrualTime4$remainingTime, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$piecewiseAccrualEnabled, accrualTime4$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime4), "character") df <- as.data.frame(accrualTime4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime5 <- getAccrualTime(accrualTime = c(0, 24, 30), accrualIntensity = c(30, 45)) ## Comparison of the results of AccrualTime object 'accrualTime5' with expected results expect_equal(accrualTime5$endOfAccrualIsUserDefined, TRUE) expect_equal(accrualTime5$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime5$maxNumberOfSubjectsIsUserDefined, FALSE) expect_equal(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime5$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime5$accrualTime, c(0, 24, 30)) expect_equal(accrualTime5$accrualIntensity, c(30, 45)) expect_equal(accrualTime5$accrualIntensityRelative, NA_real_) expect_equal(accrualTime5$maxNumberOfSubjects, 990) expect_equal(accrualTime5$remainingTime, 6) expect_equal(accrualTime5$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime5), NA))) expect_output(print(accrualTime5)$show()) invisible(capture.output(expect_error(summary(accrualTime5), NA))) expect_output(summary(accrualTime5)$show()) accrualTime5CodeBased <- eval(parse(text = getObjectRCode(accrualTime5, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime5CodeBased$endOfAccrualIsUserDefined, accrualTime5$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$followUpTimeMustBeUserDefined, accrualTime5$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime5$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$absoluteAccrualIntensityEnabled, accrualTime5$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$accrualTime, accrualTime5$accrualTime, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$accrualIntensity, accrualTime5$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$accrualIntensityRelative, accrualTime5$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$maxNumberOfSubjects, accrualTime5$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$remainingTime, accrualTime5$remainingTime, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$piecewiseAccrualEnabled, accrualTime5$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime5), "character") df <- as.data.frame(accrualTime5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime6 <- getAccrualTime(accrualTime = c(0, 24, 30), accrualIntensity = c(20, 25, 45), maxNumberOfSubjects = 720) ## Comparison of the results of AccrualTime object 'accrualTime6' with expected results expect_equal(accrualTime6$endOfAccrualIsUserDefined, FALSE) expect_equal(accrualTime6$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime6$maxNumberOfSubjectsIsUserDefined, TRUE) expect_equal(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime6$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime6$accrualTime, c(0, 24, 30, 32)) expect_equal(accrualTime6$accrualIntensity, c(20, 25, 45)) expect_equal(accrualTime6$accrualIntensityRelative, NA_real_) expect_equal(accrualTime6$maxNumberOfSubjects, 720) expect_equal(accrualTime6$remainingTime, 2) expect_equal(accrualTime6$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime6), NA))) expect_output(print(accrualTime6)$show()) invisible(capture.output(expect_error(summary(accrualTime6), NA))) expect_output(summary(accrualTime6)$show()) accrualTime6CodeBased <- eval(parse(text = getObjectRCode(accrualTime6, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime6CodeBased$endOfAccrualIsUserDefined, accrualTime6$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$followUpTimeMustBeUserDefined, accrualTime6$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime6$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$absoluteAccrualIntensityEnabled, accrualTime6$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$accrualTime, accrualTime6$accrualTime, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$accrualIntensity, accrualTime6$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$accrualIntensityRelative, accrualTime6$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$maxNumberOfSubjects, accrualTime6$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$remainingTime, accrualTime6$remainingTime, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$piecewiseAccrualEnabled, accrualTime6$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime6), "character") df <- as.data.frame(accrualTime6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime8 <- getAccrualTime(accrualTime = 0, accrualIntensity = 15, maxNumberOfSubjects = 1000) ## Comparison of the results of AccrualTime object 'accrualTime8' with expected results expect_equal(accrualTime8$endOfAccrualIsUserDefined, FALSE) expect_equal(accrualTime8$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime8$maxNumberOfSubjectsIsUserDefined, TRUE) expect_equal(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime8$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime8$accrualTime, c(0, 66.666667), tolerance = 1e-07) expect_equal(accrualTime8$accrualIntensity, 15) expect_equal(accrualTime8$accrualIntensityRelative, NA_real_) expect_equal(accrualTime8$maxNumberOfSubjects, 1000) expect_equal(accrualTime8$remainingTime, 66.666667, tolerance = 1e-07) expect_equal(accrualTime8$piecewiseAccrualEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime8), NA))) expect_output(print(accrualTime8)$show()) invisible(capture.output(expect_error(summary(accrualTime8), NA))) expect_output(summary(accrualTime8)$show()) accrualTime8CodeBased <- eval(parse(text = getObjectRCode(accrualTime8, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime8CodeBased$endOfAccrualIsUserDefined, accrualTime8$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$followUpTimeMustBeUserDefined, accrualTime8$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime8$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$absoluteAccrualIntensityEnabled, accrualTime8$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$accrualTime, accrualTime8$accrualTime, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$accrualIntensity, accrualTime8$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$accrualIntensityRelative, accrualTime8$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$maxNumberOfSubjects, accrualTime8$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$remainingTime, accrualTime8$remainingTime, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$piecewiseAccrualEnabled, accrualTime8$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime8), "character") df <- as.data.frame(accrualTime8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime9 <- getAccrualTime(accrualTime = c(0, 5), accrualIntensity = 15) ## Comparison of the results of AccrualTime object 'accrualTime9' with expected results expect_equal(accrualTime9$endOfAccrualIsUserDefined, TRUE) expect_equal(accrualTime9$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime9$maxNumberOfSubjectsIsUserDefined, FALSE) expect_equal(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime9$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime9$accrualTime, c(0, 5)) expect_equal(accrualTime9$accrualIntensity, 15) expect_equal(accrualTime9$accrualIntensityRelative, NA_real_) expect_equal(accrualTime9$maxNumberOfSubjects, 75) expect_equal(accrualTime9$remainingTime, 5) expect_equal(accrualTime9$piecewiseAccrualEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime9), NA))) expect_output(print(accrualTime9)$show()) invisible(capture.output(expect_error(summary(accrualTime9), NA))) expect_output(summary(accrualTime9)$show()) accrualTime9CodeBased <- eval(parse(text = getObjectRCode(accrualTime9, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime9CodeBased$endOfAccrualIsUserDefined, accrualTime9$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$followUpTimeMustBeUserDefined, accrualTime9$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime9$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$absoluteAccrualIntensityEnabled, accrualTime9$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$accrualTime, accrualTime9$accrualTime, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$accrualIntensity, accrualTime9$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$accrualIntensityRelative, accrualTime9$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$maxNumberOfSubjects, accrualTime9$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$remainingTime, accrualTime9$remainingTime, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$piecewiseAccrualEnabled, accrualTime9$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime9), "character") df <- as.data.frame(accrualTime9) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime9) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime10 <- getAccrualTime(accrualTime = 0, accrualIntensity = 15, maxNumberOfSubjects = 10) ## Comparison of the results of AccrualTime object 'accrualTime10' with expected results expect_equal(accrualTime10$endOfAccrualIsUserDefined, FALSE) expect_equal(accrualTime10$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime10$maxNumberOfSubjectsIsUserDefined, TRUE) expect_equal(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime10$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime10$accrualTime, c(0, 0.66666667), tolerance = 1e-07) expect_equal(accrualTime10$accrualIntensity, 15) expect_equal(accrualTime10$accrualIntensityRelative, NA_real_) expect_equal(accrualTime10$maxNumberOfSubjects, 10) expect_equal(accrualTime10$remainingTime, 0.66666667, tolerance = 1e-07) expect_equal(accrualTime10$piecewiseAccrualEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime10), NA))) expect_output(print(accrualTime10)$show()) invisible(capture.output(expect_error(summary(accrualTime10), NA))) expect_output(summary(accrualTime10)$show()) accrualTime10CodeBased <- eval(parse(text = getObjectRCode(accrualTime10, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime10CodeBased$endOfAccrualIsUserDefined, accrualTime10$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$followUpTimeMustBeUserDefined, accrualTime10$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime10$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$absoluteAccrualIntensityEnabled, accrualTime10$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$accrualTime, accrualTime10$accrualTime, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$accrualIntensity, accrualTime10$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$accrualIntensityRelative, accrualTime10$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$maxNumberOfSubjects, accrualTime10$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$remainingTime, accrualTime10$remainingTime, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$piecewiseAccrualEnabled, accrualTime10$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime10), "character") df <- as.data.frame(accrualTime10) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime10) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime11 <- getAccrualTime(accrualTime = c(0, 5), accrualIntensity = 15, maxNumberOfSubjects = 75) ## Comparison of the results of AccrualTime object 'accrualTime11' with expected results expect_equal(accrualTime11$endOfAccrualIsUserDefined, TRUE) expect_equal(accrualTime11$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime11$maxNumberOfSubjectsIsUserDefined, TRUE) expect_equal(accrualTime11$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime11$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime11$accrualTime, c(0, 5)) expect_equal(accrualTime11$accrualIntensity, 15) expect_equal(accrualTime11$accrualIntensityRelative, NA_real_) expect_equal(accrualTime11$maxNumberOfSubjects, 75) expect_equal(accrualTime11$remainingTime, NA_real_) expect_equal(accrualTime11$piecewiseAccrualEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime11), NA))) expect_output(print(accrualTime11)$show()) invisible(capture.output(expect_error(summary(accrualTime11), NA))) expect_output(summary(accrualTime11)$show()) accrualTime11CodeBased <- eval(parse(text = getObjectRCode(accrualTime11, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime11CodeBased$endOfAccrualIsUserDefined, accrualTime11$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime11CodeBased$followUpTimeMustBeUserDefined, accrualTime11$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime11CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime11$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime11CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime11$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime11CodeBased$absoluteAccrualIntensityEnabled, accrualTime11$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime11CodeBased$accrualTime, accrualTime11$accrualTime, tolerance = 1e-05) expect_equal(accrualTime11CodeBased$accrualIntensity, accrualTime11$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime11CodeBased$accrualIntensityRelative, accrualTime11$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime11CodeBased$maxNumberOfSubjects, accrualTime11$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime11CodeBased$remainingTime, accrualTime11$remainingTime, tolerance = 1e-05) expect_equal(accrualTime11CodeBased$piecewiseAccrualEnabled, accrualTime11$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime11), "character") df <- as.data.frame(accrualTime11) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime11) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime12 <- getAccrualTime(accrualTime = c(0, 6, 15, 25), accrualIntensity = c(22, 0, 33)) ## Comparison of the results of AccrualTime object 'accrualTime12' with expected results expect_equal(accrualTime12$endOfAccrualIsUserDefined, TRUE) expect_equal(accrualTime12$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime12$maxNumberOfSubjectsIsUserDefined, FALSE) expect_equal(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime12$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime12$accrualTime, c(0, 6, 15, 25)) expect_equal(accrualTime12$accrualIntensity, c(22, 0, 33)) expect_equal(accrualTime12$accrualIntensityRelative, NA_real_) expect_equal(accrualTime12$maxNumberOfSubjects, 462) expect_equal(accrualTime12$remainingTime, 10) expect_equal(accrualTime12$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime12), NA))) expect_output(print(accrualTime12)$show()) invisible(capture.output(expect_error(summary(accrualTime12), NA))) expect_output(summary(accrualTime12)$show()) accrualTime12CodeBased <- eval(parse(text = getObjectRCode(accrualTime12, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime12CodeBased$endOfAccrualIsUserDefined, accrualTime12$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$followUpTimeMustBeUserDefined, accrualTime12$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime12$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$absoluteAccrualIntensityEnabled, accrualTime12$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$accrualTime, accrualTime12$accrualTime, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$accrualIntensity, accrualTime12$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$accrualIntensityRelative, accrualTime12$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$maxNumberOfSubjects, accrualTime12$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$remainingTime, accrualTime12$remainingTime, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$piecewiseAccrualEnabled, accrualTime12$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime12), "character") df <- as.data.frame(accrualTime12) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime12) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime13 <- getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33), maxNumberOfSubjects = 1000) ## Comparison of the results of AccrualTime object 'accrualTime13' with expected results expect_equal(accrualTime13$endOfAccrualIsUserDefined, FALSE) expect_equal(accrualTime13$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime13$maxNumberOfSubjectsIsUserDefined, TRUE) expect_equal(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime13$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime13$accrualTime, c(0, 6, 32.30303), tolerance = 1e-07) expect_equal(accrualTime13$accrualIntensity, c(22, 33)) expect_equal(accrualTime13$accrualIntensityRelative, NA_real_) expect_equal(accrualTime13$maxNumberOfSubjects, 1000) expect_equal(accrualTime13$remainingTime, 26.30303, tolerance = 1e-07) expect_equal(accrualTime13$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime13), NA))) expect_output(print(accrualTime13)$show()) invisible(capture.output(expect_error(summary(accrualTime13), NA))) expect_output(summary(accrualTime13)$show()) accrualTime13CodeBased <- eval(parse(text = getObjectRCode(accrualTime13, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime13CodeBased$endOfAccrualIsUserDefined, accrualTime13$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$followUpTimeMustBeUserDefined, accrualTime13$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime13$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$absoluteAccrualIntensityEnabled, accrualTime13$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$accrualTime, accrualTime13$accrualTime, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$accrualIntensity, accrualTime13$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$accrualIntensityRelative, accrualTime13$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$maxNumberOfSubjects, accrualTime13$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$remainingTime, accrualTime13$remainingTime, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$piecewiseAccrualEnabled, accrualTime13$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime13), "character") df <- as.data.frame(accrualTime13) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime13) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("Testing 'getAccrualTime': test absolute and relative definition", { # @refFS[Tab.]{fs:tab:output:getAccrualTime} accrualTime1 <- getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33), maxNumberOfSubjects = 924) ## Comparison of the results of AccrualTime object 'accrualTime1' with expected results expect_equal(accrualTime1$endOfAccrualIsUserDefined, TRUE) expect_equal(accrualTime1$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime1$maxNumberOfSubjectsIsUserDefined, TRUE) expect_equal(accrualTime1$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime1$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime1$accrualTime, c(0, 6, 30)) expect_equal(accrualTime1$accrualIntensity, c(22, 33)) expect_equal(accrualTime1$accrualIntensityRelative, NA_real_) expect_equal(accrualTime1$maxNumberOfSubjects, 924) expect_equal(accrualTime1$remainingTime, NA_real_) expect_equal(accrualTime1$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime1), NA))) expect_output(print(accrualTime1)$show()) invisible(capture.output(expect_error(summary(accrualTime1), NA))) expect_output(summary(accrualTime1)$show()) accrualTime1CodeBased <- eval(parse(text = getObjectRCode(accrualTime1, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime1CodeBased$endOfAccrualIsUserDefined, accrualTime1$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime1CodeBased$followUpTimeMustBeUserDefined, accrualTime1$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime1CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime1$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime1CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime1$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime1CodeBased$absoluteAccrualIntensityEnabled, accrualTime1$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime1CodeBased$accrualTime, accrualTime1$accrualTime, tolerance = 1e-05) expect_equal(accrualTime1CodeBased$accrualIntensity, accrualTime1$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime1CodeBased$accrualIntensityRelative, accrualTime1$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime1CodeBased$maxNumberOfSubjects, accrualTime1$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime1CodeBased$remainingTime, accrualTime1$remainingTime, tolerance = 1e-05) expect_equal(accrualTime1CodeBased$piecewiseAccrualEnabled, accrualTime1$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime1), "character") df <- as.data.frame(accrualTime1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime2 <- getAccrualTime(list( "0 - <6" = 22, "6 - <=30" = 33), maxNumberOfSubjects = 924) ## Comparison of the results of AccrualTime object 'accrualTime2' with expected results expect_equal(accrualTime2$endOfAccrualIsUserDefined, TRUE) expect_equal(accrualTime2$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime2$maxNumberOfSubjectsIsUserDefined, TRUE) expect_equal(accrualTime2$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime2$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime2$accrualTime, c(0, 6, 30)) expect_equal(accrualTime2$accrualIntensity, c(22, 33)) expect_equal(accrualTime2$accrualIntensityRelative, NA_real_) expect_equal(accrualTime2$maxNumberOfSubjects, 924) expect_equal(accrualTime2$remainingTime, NA_real_) expect_equal(accrualTime2$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime2), NA))) expect_output(print(accrualTime2)$show()) invisible(capture.output(expect_error(summary(accrualTime2), NA))) expect_output(summary(accrualTime2)$show()) accrualTime2CodeBased <- eval(parse(text = getObjectRCode(accrualTime2, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime2CodeBased$endOfAccrualIsUserDefined, accrualTime2$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime2CodeBased$followUpTimeMustBeUserDefined, accrualTime2$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime2CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime2$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime2CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime2$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime2CodeBased$absoluteAccrualIntensityEnabled, accrualTime2$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime2CodeBased$accrualTime, accrualTime2$accrualTime, tolerance = 1e-05) expect_equal(accrualTime2CodeBased$accrualIntensity, accrualTime2$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime2CodeBased$accrualIntensityRelative, accrualTime2$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime2CodeBased$maxNumberOfSubjects, accrualTime2$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime2CodeBased$remainingTime, accrualTime2$remainingTime, tolerance = 1e-05) expect_equal(accrualTime2CodeBased$piecewiseAccrualEnabled, accrualTime2$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime2), "character") df <- as.data.frame(accrualTime2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() accrualTime3 <- getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33), maxNumberOfSubjects = 1000) ## Comparison of the results of AccrualTime object 'accrualTime3' with expected results expect_equal(accrualTime3$endOfAccrualIsUserDefined, TRUE) expect_equal(accrualTime3$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime3$maxNumberOfSubjectsIsUserDefined, TRUE) expect_equal(accrualTime3$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime3$absoluteAccrualIntensityEnabled, FALSE) expect_equal(accrualTime3$accrualTime, c(0, 6, 30)) expect_equal(accrualTime3$accrualIntensity, c(23.809524, 35.714286), tolerance = 1e-07) expect_equal(accrualTime3$accrualIntensityRelative, c(0.22, 0.33), tolerance = 1e-07) expect_equal(accrualTime3$maxNumberOfSubjects, 1000) expect_equal(accrualTime3$remainingTime, 24) expect_equal(accrualTime3$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime3), NA))) expect_output(print(accrualTime3)$show()) invisible(capture.output(expect_error(summary(accrualTime3), NA))) expect_output(summary(accrualTime3)$show()) accrualTime3CodeBased <- eval(parse(text = getObjectRCode(accrualTime3, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime3CodeBased$endOfAccrualIsUserDefined, accrualTime3$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime3CodeBased$followUpTimeMustBeUserDefined, accrualTime3$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime3CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime3$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime3CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime3$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime3CodeBased$absoluteAccrualIntensityEnabled, accrualTime3$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime3CodeBased$accrualTime, accrualTime3$accrualTime, tolerance = 1e-05) expect_equal(accrualTime3CodeBased$accrualIntensity, accrualTime3$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime3CodeBased$accrualIntensityRelative, accrualTime3$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime3CodeBased$maxNumberOfSubjects, accrualTime3$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime3CodeBased$remainingTime, accrualTime3$remainingTime, tolerance = 1e-05) expect_equal(accrualTime3CodeBased$piecewiseAccrualEnabled, accrualTime3$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime3), "character") df <- as.data.frame(accrualTime3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime4 <- getAccrualTime(list( "0 - <6" = 0.22, "6 - <=30" = 0.33), maxNumberOfSubjects = 1000) ## Comparison of the results of AccrualTime object 'accrualTime4' with expected results expect_equal(accrualTime4$endOfAccrualIsUserDefined, TRUE) expect_equal(accrualTime4$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime4$maxNumberOfSubjectsIsUserDefined, TRUE) expect_equal(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime4$absoluteAccrualIntensityEnabled, FALSE) expect_equal(accrualTime4$accrualTime, c(0, 6, 30)) expect_equal(accrualTime4$accrualIntensity, c(23.809524, 35.714286), tolerance = 1e-07) expect_equal(accrualTime4$accrualIntensityRelative, c(0.22, 0.33), tolerance = 1e-07) expect_equal(accrualTime4$maxNumberOfSubjects, 1000) expect_equal(accrualTime4$remainingTime, 24) expect_equal(accrualTime4$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime4), NA))) expect_output(print(accrualTime4)$show()) invisible(capture.output(expect_error(summary(accrualTime4), NA))) expect_output(summary(accrualTime4)$show()) accrualTime4CodeBased <- eval(parse(text = getObjectRCode(accrualTime4, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime4CodeBased$endOfAccrualIsUserDefined, accrualTime4$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$followUpTimeMustBeUserDefined, accrualTime4$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime4$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$absoluteAccrualIntensityEnabled, accrualTime4$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$accrualTime, accrualTime4$accrualTime, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$accrualIntensity, accrualTime4$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$accrualIntensityRelative, accrualTime4$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$maxNumberOfSubjects, accrualTime4$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$remainingTime, accrualTime4$remainingTime, tolerance = 1e-05) expect_equal(accrualTime4CodeBased$piecewiseAccrualEnabled, accrualTime4$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime4), "character") df <- as.data.frame(accrualTime4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime5 <- getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33)) ## Comparison of the results of AccrualTime object 'accrualTime5' with expected results expect_equal(accrualTime5$endOfAccrualIsUserDefined, TRUE) expect_equal(accrualTime5$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime5$maxNumberOfSubjectsIsUserDefined, FALSE) expect_equal(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime5$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime5$accrualTime, c(0, 6, 30)) expect_equal(accrualTime5$accrualIntensity, c(22, 33)) expect_equal(accrualTime5$accrualIntensityRelative, NA_real_) expect_equal(accrualTime5$maxNumberOfSubjects, 924) expect_equal(accrualTime5$remainingTime, 24) expect_equal(accrualTime5$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime5), NA))) expect_output(print(accrualTime5)$show()) invisible(capture.output(expect_error(summary(accrualTime5), NA))) expect_output(summary(accrualTime5)$show()) accrualTime5CodeBased <- eval(parse(text = getObjectRCode(accrualTime5, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime5CodeBased$endOfAccrualIsUserDefined, accrualTime5$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$followUpTimeMustBeUserDefined, accrualTime5$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime5$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$absoluteAccrualIntensityEnabled, accrualTime5$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$accrualTime, accrualTime5$accrualTime, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$accrualIntensity, accrualTime5$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$accrualIntensityRelative, accrualTime5$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$maxNumberOfSubjects, accrualTime5$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$remainingTime, accrualTime5$remainingTime, tolerance = 1e-05) expect_equal(accrualTime5CodeBased$piecewiseAccrualEnabled, accrualTime5$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime5), "character") df <- as.data.frame(accrualTime5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime6 <- getAccrualTime(list( "0 - <6" = 22, "6 - <=30" = 33)) ## Comparison of the results of AccrualTime object 'accrualTime6' with expected results expect_equal(accrualTime6$endOfAccrualIsUserDefined, TRUE) expect_equal(accrualTime6$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime6$maxNumberOfSubjectsIsUserDefined, FALSE) expect_equal(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime6$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime6$accrualTime, c(0, 6, 30)) expect_equal(accrualTime6$accrualIntensity, c(22, 33)) expect_equal(accrualTime6$accrualIntensityRelative, NA_real_) expect_equal(accrualTime6$maxNumberOfSubjects, 924) expect_equal(accrualTime6$remainingTime, 24) expect_equal(accrualTime6$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime6), NA))) expect_output(print(accrualTime6)$show()) invisible(capture.output(expect_error(summary(accrualTime6), NA))) expect_output(summary(accrualTime6)$show()) accrualTime6CodeBased <- eval(parse(text = getObjectRCode(accrualTime6, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime6CodeBased$endOfAccrualIsUserDefined, accrualTime6$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$followUpTimeMustBeUserDefined, accrualTime6$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime6$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$absoluteAccrualIntensityEnabled, accrualTime6$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$accrualTime, accrualTime6$accrualTime, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$accrualIntensity, accrualTime6$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$accrualIntensityRelative, accrualTime6$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$maxNumberOfSubjects, accrualTime6$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$remainingTime, accrualTime6$remainingTime, tolerance = 1e-05) expect_equal(accrualTime6CodeBased$piecewiseAccrualEnabled, accrualTime6$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime6), "character") df <- as.data.frame(accrualTime6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime7 <- getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33)) ## Comparison of the results of AccrualTime object 'accrualTime7' with expected results expect_equal(accrualTime7$endOfAccrualIsUserDefined, TRUE) expect_equal(accrualTime7$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime7$maxNumberOfSubjectsIsUserDefined, FALSE) expect_equal(accrualTime7$maxNumberOfSubjectsCanBeCalculatedDirectly, FALSE) expect_equal(accrualTime7$absoluteAccrualIntensityEnabled, FALSE) expect_equal(accrualTime7$accrualTime, c(0, 6, 30)) expect_equal(accrualTime7$accrualIntensity, c(0.22, 0.33), tolerance = 1e-07) expect_equal(accrualTime7$accrualIntensityRelative, NA_real_) expect_equal(accrualTime7$maxNumberOfSubjects, NA_real_) expect_equal(accrualTime7$remainingTime, NA_real_) expect_equal(accrualTime7$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime7), NA))) expect_output(print(accrualTime7)$show()) invisible(capture.output(expect_error(summary(accrualTime7), NA))) expect_output(summary(accrualTime7)$show()) accrualTime7CodeBased <- eval(parse(text = getObjectRCode(accrualTime7, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime7CodeBased$endOfAccrualIsUserDefined, accrualTime7$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime7CodeBased$followUpTimeMustBeUserDefined, accrualTime7$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime7CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime7$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime7CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime7$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime7CodeBased$absoluteAccrualIntensityEnabled, accrualTime7$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime7CodeBased$accrualTime, accrualTime7$accrualTime, tolerance = 1e-05) expect_equal(accrualTime7CodeBased$accrualIntensity, accrualTime7$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime7CodeBased$accrualIntensityRelative, accrualTime7$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime7CodeBased$maxNumberOfSubjects, accrualTime7$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime7CodeBased$remainingTime, accrualTime7$remainingTime, tolerance = 1e-05) expect_equal(accrualTime7CodeBased$piecewiseAccrualEnabled, accrualTime7$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime7), "character") df <- as.data.frame(accrualTime7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime8 <- getAccrualTime(list( "0 - <6" = 0.22, "6 - <=30" = 0.33)) ## Comparison of the results of AccrualTime object 'accrualTime8' with expected results expect_equal(accrualTime8$endOfAccrualIsUserDefined, TRUE) expect_equal(accrualTime8$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime8$maxNumberOfSubjectsIsUserDefined, FALSE) expect_equal(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, FALSE) expect_equal(accrualTime8$absoluteAccrualIntensityEnabled, FALSE) expect_equal(accrualTime8$accrualTime, c(0, 6, 30)) expect_equal(accrualTime8$accrualIntensity, c(0.22, 0.33), tolerance = 1e-07) expect_equal(accrualTime8$accrualIntensityRelative, NA_real_) expect_equal(accrualTime8$maxNumberOfSubjects, NA_real_) expect_equal(accrualTime8$remainingTime, NA_real_) expect_equal(accrualTime8$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime8), NA))) expect_output(print(accrualTime8)$show()) invisible(capture.output(expect_error(summary(accrualTime8), NA))) expect_output(summary(accrualTime8)$show()) accrualTime8CodeBased <- eval(parse(text = getObjectRCode(accrualTime8, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime8CodeBased$endOfAccrualIsUserDefined, accrualTime8$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$followUpTimeMustBeUserDefined, accrualTime8$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime8$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$absoluteAccrualIntensityEnabled, accrualTime8$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$accrualTime, accrualTime8$accrualTime, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$accrualIntensity, accrualTime8$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$accrualIntensityRelative, accrualTime8$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$maxNumberOfSubjects, accrualTime8$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$remainingTime, accrualTime8$remainingTime, tolerance = 1e-05) expect_equal(accrualTime8CodeBased$piecewiseAccrualEnabled, accrualTime8$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime8), "character") df <- as.data.frame(accrualTime8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime9 <- getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33), maxNumberOfSubjects = 1000) ## Comparison of the results of AccrualTime object 'accrualTime9' with expected results expect_equal(accrualTime9$endOfAccrualIsUserDefined, FALSE) expect_equal(accrualTime9$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime9$maxNumberOfSubjectsIsUserDefined, TRUE) expect_equal(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime9$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime9$accrualTime, c(0, 6, 32.30303), tolerance = 1e-07) expect_equal(accrualTime9$accrualIntensity, c(22, 33)) expect_equal(accrualTime9$accrualIntensityRelative, NA_real_) expect_equal(accrualTime9$maxNumberOfSubjects, 1000) expect_equal(accrualTime9$remainingTime, 26.30303, tolerance = 1e-07) expect_equal(accrualTime9$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime9), NA))) expect_output(print(accrualTime9)$show()) invisible(capture.output(expect_error(summary(accrualTime9), NA))) expect_output(summary(accrualTime9)$show()) accrualTime9CodeBased <- eval(parse(text = getObjectRCode(accrualTime9, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime9CodeBased$endOfAccrualIsUserDefined, accrualTime9$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$followUpTimeMustBeUserDefined, accrualTime9$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime9$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$absoluteAccrualIntensityEnabled, accrualTime9$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$accrualTime, accrualTime9$accrualTime, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$accrualIntensity, accrualTime9$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$accrualIntensityRelative, accrualTime9$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$maxNumberOfSubjects, accrualTime9$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$remainingTime, accrualTime9$remainingTime, tolerance = 1e-05) expect_equal(accrualTime9CodeBased$piecewiseAccrualEnabled, accrualTime9$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime9), "character") df <- as.data.frame(accrualTime9) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime9) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime10 <- getAccrualTime(list( "0 - <6" = 22, "6" = 33), maxNumberOfSubjects = 1000) ## Comparison of the results of AccrualTime object 'accrualTime10' with expected results expect_equal(accrualTime10$endOfAccrualIsUserDefined, FALSE) expect_equal(accrualTime10$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime10$maxNumberOfSubjectsIsUserDefined, TRUE) expect_equal(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime10$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime10$accrualTime, c(0, 6, 32.30303), tolerance = 1e-07) expect_equal(accrualTime10$accrualIntensity, c(22, 33)) expect_equal(accrualTime10$accrualIntensityRelative, NA_real_) expect_equal(accrualTime10$maxNumberOfSubjects, 1000) expect_equal(accrualTime10$remainingTime, 26.30303, tolerance = 1e-07) expect_equal(accrualTime10$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime10), NA))) expect_output(print(accrualTime10)$show()) invisible(capture.output(expect_error(summary(accrualTime10), NA))) expect_output(summary(accrualTime10)$show()) accrualTime10CodeBased <- eval(parse(text = getObjectRCode(accrualTime10, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime10CodeBased$endOfAccrualIsUserDefined, accrualTime10$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$followUpTimeMustBeUserDefined, accrualTime10$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime10$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$absoluteAccrualIntensityEnabled, accrualTime10$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$accrualTime, accrualTime10$accrualTime, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$accrualIntensity, accrualTime10$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$accrualIntensityRelative, accrualTime10$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$maxNumberOfSubjects, accrualTime10$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$remainingTime, accrualTime10$remainingTime, tolerance = 1e-05) expect_equal(accrualTime10CodeBased$piecewiseAccrualEnabled, accrualTime10$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime10), "character") df <- as.data.frame(accrualTime10) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime10) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime12 <- getAccrualTime(list( "0 - <6" = 0.22, "6 - <=30" = 0.33), maxNumberOfSubjects = 1000) ## Comparison of the results of AccrualTime object 'accrualTime12' with expected results expect_equal(accrualTime12$endOfAccrualIsUserDefined, TRUE) expect_equal(accrualTime12$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime12$maxNumberOfSubjectsIsUserDefined, TRUE) expect_equal(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime12$absoluteAccrualIntensityEnabled, FALSE) expect_equal(accrualTime12$accrualTime, c(0, 6, 30)) expect_equal(accrualTime12$accrualIntensity, c(23.809524, 35.714286), tolerance = 1e-07) expect_equal(accrualTime12$accrualIntensityRelative, c(0.22, 0.33), tolerance = 1e-07) expect_equal(accrualTime12$maxNumberOfSubjects, 1000) expect_equal(accrualTime12$remainingTime, 24) expect_equal(accrualTime12$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime12), NA))) expect_output(print(accrualTime12)$show()) invisible(capture.output(expect_error(summary(accrualTime12), NA))) expect_output(summary(accrualTime12)$show()) accrualTime12CodeBased <- eval(parse(text = getObjectRCode(accrualTime12, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime12CodeBased$endOfAccrualIsUserDefined, accrualTime12$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$followUpTimeMustBeUserDefined, accrualTime12$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime12$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$absoluteAccrualIntensityEnabled, accrualTime12$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$accrualTime, accrualTime12$accrualTime, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$accrualIntensity, accrualTime12$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$accrualIntensityRelative, accrualTime12$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$maxNumberOfSubjects, accrualTime12$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$remainingTime, accrualTime12$remainingTime, tolerance = 1e-05) expect_equal(accrualTime12CodeBased$piecewiseAccrualEnabled, accrualTime12$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime12), "character") df <- as.data.frame(accrualTime12) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime12) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime13 <- getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33)) ## Comparison of the results of AccrualTime object 'accrualTime13' with expected results expect_equal(accrualTime13$endOfAccrualIsUserDefined, FALSE) expect_equal(accrualTime13$followUpTimeMustBeUserDefined, TRUE) expect_equal(accrualTime13$maxNumberOfSubjectsIsUserDefined, FALSE) expect_equal(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, FALSE) expect_equal(accrualTime13$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime13$accrualTime, c(0, 6)) expect_equal(accrualTime13$accrualIntensity, c(22, 33)) expect_equal(accrualTime13$accrualIntensityRelative, NA_real_) expect_equal(accrualTime13$maxNumberOfSubjects, NA_real_) expect_equal(accrualTime13$remainingTime, NA_real_) expect_equal(accrualTime13$piecewiseAccrualEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime13), NA))) expect_output(print(accrualTime13)$show()) invisible(capture.output(expect_error(summary(accrualTime13), NA))) expect_output(summary(accrualTime13)$show()) accrualTime13CodeBased <- eval(parse(text = getObjectRCode(accrualTime13, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime13CodeBased$endOfAccrualIsUserDefined, accrualTime13$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$followUpTimeMustBeUserDefined, accrualTime13$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime13$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$absoluteAccrualIntensityEnabled, accrualTime13$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$accrualTime, accrualTime13$accrualTime, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$accrualIntensity, accrualTime13$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$accrualIntensityRelative, accrualTime13$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$maxNumberOfSubjects, accrualTime13$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$remainingTime, accrualTime13$remainingTime, tolerance = 1e-05) expect_equal(accrualTime13CodeBased$piecewiseAccrualEnabled, accrualTime13$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime13), "character") df <- as.data.frame(accrualTime13) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime13) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime14 <- getAccrualTime(list( "0 - <6" = 22, "6 - <=30" = 33)) ## Comparison of the results of AccrualTime object 'accrualTime14' with expected results expect_equal(accrualTime14$endOfAccrualIsUserDefined, TRUE) expect_equal(accrualTime14$followUpTimeMustBeUserDefined, FALSE) expect_equal(accrualTime14$maxNumberOfSubjectsIsUserDefined, FALSE) expect_equal(accrualTime14$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE) expect_equal(accrualTime14$absoluteAccrualIntensityEnabled, TRUE) expect_equal(accrualTime14$accrualTime, c(0, 6, 30)) expect_equal(accrualTime14$accrualIntensity, c(22, 33)) expect_equal(accrualTime14$accrualIntensityRelative, NA_real_) expect_equal(accrualTime14$maxNumberOfSubjects, 924) expect_equal(accrualTime14$remainingTime, 24) expect_equal(accrualTime14$piecewiseAccrualEnabled, TRUE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(accrualTime14), NA))) expect_output(print(accrualTime14)$show()) invisible(capture.output(expect_error(summary(accrualTime14), NA))) expect_output(summary(accrualTime14)$show()) accrualTime14CodeBased <- eval(parse(text = getObjectRCode(accrualTime14, stringWrapParagraphWidth = NULL))) expect_equal(accrualTime14CodeBased$endOfAccrualIsUserDefined, accrualTime14$endOfAccrualIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime14CodeBased$followUpTimeMustBeUserDefined, accrualTime14$followUpTimeMustBeUserDefined, tolerance = 1e-05) expect_equal(accrualTime14CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime14$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-05) expect_equal(accrualTime14CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime14$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-05) expect_equal(accrualTime14CodeBased$absoluteAccrualIntensityEnabled, accrualTime14$absoluteAccrualIntensityEnabled, tolerance = 1e-05) expect_equal(accrualTime14CodeBased$accrualTime, accrualTime14$accrualTime, tolerance = 1e-05) expect_equal(accrualTime14CodeBased$accrualIntensity, accrualTime14$accrualIntensity, tolerance = 1e-05) expect_equal(accrualTime14CodeBased$accrualIntensityRelative, accrualTime14$accrualIntensityRelative, tolerance = 1e-05) expect_equal(accrualTime14CodeBased$maxNumberOfSubjects, accrualTime14$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(accrualTime14CodeBased$remainingTime, accrualTime14$remainingTime, tolerance = 1e-05) expect_equal(accrualTime14CodeBased$piecewiseAccrualEnabled, accrualTime14$piecewiseAccrualEnabled, tolerance = 1e-05) expect_type(names(accrualTime14), "character") df <- as.data.frame(accrualTime14) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(accrualTime14) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("Testing 'getAccrualTime': check expected warnings and errors", { # @refFS[Tab.]{fs:tab:output:getAccrualTime} expect_warning(getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33)), "The specified accrual time and intensity cannot be supplemented automatically with the missing information; therefore further calculations are not possible", fixed = TRUE) expect_warning(getAccrualTime(accrualTime = c(0, 24), accrualIntensity = c(30, 45), maxNumberOfSubjects = 720), "Last accrual intensity value (45) ignored", fixed = TRUE) .skipTestIfDisabled() expect_warning(getAccrualTime(accrualTime = c(0, 24, 30), accrualIntensity = c(30, 45, 55), maxNumberOfSubjects = 720), "Last 2 accrual intensity values (45, 55) ignored", fixed = TRUE) expect_warning(getAccrualTime(accrualTime = c(0, 24, 30, 40), accrualIntensity = c(30, 45, 55, 66), maxNumberOfSubjects = 720), "Last 2 accrual time values (30, 40) ignored", fixed = TRUE) expect_warning(getAccrualTime(accrualTime = c(0, 24, 30, 40), accrualIntensity = c(30, 45, 55, 66), maxNumberOfSubjects = 720), "Last 3 accrual intensity values (45, 55, 66) ignored", fixed = TRUE) expect_warning(getAccrualTime(accrualTime = c(0, 6, 15, 25), accrualIntensity = c(0, 22, 33)), "It makes no sense to start 'accrualIntensity' (0, 22, 33) with 0", fixed = TRUE) expect_error(getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0)), "Illegal argument: at least one 'accrualIntensity' value must be > 0", fixed = TRUE) expect_error(getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33), maxNumberOfSubjects = 1000), paste0("Conflicting arguments: 'maxNumberOfSubjects' (1000) disagrees with the defined ", "accrual time (0, 6, 30) and intensity: 6 * 22 + 24 * 33 = 924"), fixed = TRUE) }) test_that("Testing 'getAccrualTime': list-wise definition", { accrualTime1 <- list( "0 - <12" = 15, "12 - <13" = 21, "13 - <14" = 27, "14 - <15" = 33, "15 - <16" = 39, ">=16" = 45) # @refFS[Tab.]{fs:tab:output:getAccrualTime} accrualTime4 <- getAccrualTime(accrualTime = accrualTime1, maxNumberOfSubjects = 1405) expect_equal(accrualTime4$accrualTime, c( 0, 12, 13, 14, 15, 16, 40.55555556)) expect_equal(accrualTime4$accrualIntensity, c(15, 21, 27, 33, 39, 45)) expect_equal(accrualTime4$remainingTime, 24.55555556) .skipTestIfDisabled() accrualTime2 <- list( "0 - <12" = 15, "12 - <13" = 21, "13 - <14" = 27, "14 - <15" = 33, "15 - <16" = 39, "16 - ?" = 45) accrualTime5 <- getAccrualTime(accrualTime = accrualTime2, maxNumberOfSubjects = 1405) expect_equal(accrualTime5$accrualTime, c( 0, 12, 13, 14, 15, 16, 40.55555556)) expect_equal(accrualTime5$accrualIntensity, c(15, 21, 27, 33, 39, 45)) expect_equal(accrualTime5$remainingTime, 24.55555556) accrualTime3 <- list( "0 - <11" = 20, "11 - <16" = 40, ">=16" = 60) accrualTime6 <- getAccrualTime(accrualTime = accrualTime3, maxNumberOfSubjects = 800) expect_equal(accrualTime6$accrualTime, c(0, 11, 16, 22.3333333)) expect_equal(accrualTime6$accrualIntensity, c(20, 40, 60)) expect_equal(accrualTime6$remainingTime, 6.33333333) accrualTime7 <- list( "0 - <11" = 20, "11 - <16" = 40, "16 - ?" = 60) accrualTime8 <- getAccrualTime(accrualTime = accrualTime7, maxNumberOfSubjects = 800) expect_equal(accrualTime8$accrualTime, c(0, 11, 16, 22.3333333)) expect_equal(accrualTime8$accrualIntensity, c(20, 40, 60)) expect_equal(accrualTime8$remainingTime, 6.33333333) }) test_that("Testing 'getPiecewiseSurvivalTime': mixed arguments", { # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} pwSurvivalTime1 <- getPiecewiseSurvivalTime(median1 = 37, hazardRatio = 0.8) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime1' with expected results expect_equal(pwSurvivalTime1$piecewiseSurvivalTime, NA_real_) expect_equal(pwSurvivalTime1$lambda1, 0.018733708, tolerance = 1e-07) expect_equal(pwSurvivalTime1$lambda2, 0.023417134, tolerance = 1e-07) expect_equal(pwSurvivalTime1$hazardRatio, 0.8, tolerance = 1e-07) expect_equal(pwSurvivalTime1$pi1, NA_real_) expect_equal(pwSurvivalTime1$pi2, NA_real_) expect_equal(pwSurvivalTime1$median1, 37) expect_equal(pwSurvivalTime1$median2, 29.6, tolerance = 1e-07) expect_equal(pwSurvivalTime1$eventTime, NA_real_) expect_equal(pwSurvivalTime1$kappa, 1) expect_equal(pwSurvivalTime1$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime1$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime1$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime1), NA))) expect_output(print(pwSurvivalTime1)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime1), NA))) expect_output(summary(pwSurvivalTime1)$show()) pwSurvivalTime1CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime1, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalTime, pwSurvivalTime1$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$lambda1, pwSurvivalTime1$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$lambda2, pwSurvivalTime1$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$hazardRatio, pwSurvivalTime1$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$pi1, pwSurvivalTime1$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$pi2, pwSurvivalTime1$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$median1, pwSurvivalTime1$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$median2, pwSurvivalTime1$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$eventTime, pwSurvivalTime1$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$kappa, pwSurvivalTime1$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime1$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$delayedResponseAllowed, pwSurvivalTime1$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime1CodeBased$delayedResponseEnabled, pwSurvivalTime1$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime1), "character") df <- as.data.frame(pwSurvivalTime1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime2 <- getPiecewiseSurvivalTime(lambda1 = 0.01873371, median2 = 29.6) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime2$lambda1, 0.01873371, tolerance = 1e-07) expect_equal(pwSurvivalTime2$lambda2, 0.023417134, tolerance = 1e-07) expect_equal(pwSurvivalTime2$hazardRatio, 0.8000001, tolerance = 1e-07) expect_equal(pwSurvivalTime2$pi1, NA_real_) expect_equal(pwSurvivalTime2$pi2, NA_real_) expect_equal(pwSurvivalTime2$median1, 36.999995, tolerance = 1e-07) expect_equal(pwSurvivalTime2$median2, 29.6, tolerance = 1e-07) expect_equal(pwSurvivalTime2$eventTime, NA_real_) expect_equal(pwSurvivalTime2$kappa, 1) expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) expect_output(print(pwSurvivalTime2)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) expect_output(summary(pwSurvivalTime2)$show()) pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime2), "character") df <- as.data.frame(pwSurvivalTime2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } pwSurvivalTime3 <- getPiecewiseSurvivalTime(median1 = 37, lambda2 = 0.02341713) ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime3' with expected results expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime3$lambda1, 0.018733708, tolerance = 1e-07) expect_equal(pwSurvivalTime3$lambda2, 0.02341713, tolerance = 1e-07) expect_equal(pwSurvivalTime3$hazardRatio, 0.80000015, tolerance = 1e-07) expect_equal(pwSurvivalTime3$pi1, NA_real_) expect_equal(pwSurvivalTime3$pi2, NA_real_) expect_equal(pwSurvivalTime3$median1, 37) expect_equal(pwSurvivalTime3$median2, 29.600006, tolerance = 1e-07) expect_equal(pwSurvivalTime3$eventTime, NA_real_) expect_equal(pwSurvivalTime3$kappa, 1) expect_equal(pwSurvivalTime3$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime3$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime3$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime3), NA))) expect_output(print(pwSurvivalTime3)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime3), NA))) expect_output(summary(pwSurvivalTime3)$show()) pwSurvivalTime3CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime3, stringWrapParagraphWidth = NULL))) expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalTime, pwSurvivalTime3$piecewiseSurvivalTime, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$lambda1, pwSurvivalTime3$lambda1, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$lambda2, pwSurvivalTime3$lambda2, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$hazardRatio, pwSurvivalTime3$hazardRatio, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$pi1, pwSurvivalTime3$pi1, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$pi2, pwSurvivalTime3$pi2, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$median1, pwSurvivalTime3$median1, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$median2, pwSurvivalTime3$median2, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$eventTime, pwSurvivalTime3$eventTime, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$kappa, pwSurvivalTime3$kappa, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime3$piecewiseSurvivalEnabled, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$delayedResponseAllowed, pwSurvivalTime3$delayedResponseAllowed, tolerance = 1e-05) expect_equal(pwSurvivalTime3CodeBased$delayedResponseEnabled, pwSurvivalTime3$delayedResponseEnabled, tolerance = 1e-05) expect_type(names(pwSurvivalTime3), "character") df <- as.data.frame(pwSurvivalTime3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(pwSurvivalTime3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } expect_warning(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi1 = 0.3), "'hazardRatio' (0.6, 0.8) will be ignored because it will be calculated", fixed = TRUE) }) rpact/tests/testthat/test-f_analysis_base_rates.R0000644000175000017500000046313114154142422022146 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_analysis_base_rates.R ## | Creation date: 08 December 2021, 09:00:49 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing the Analysis Rates Functionality for One Treatment") test_that("'getAnalysisResults' for a group sequential design and one treatment", { design0 <- getDesignGroupSequential(kMax = 2, alpha = 0.025, informationRates = c(0.2, 1), typeOfDesign = "asKD", gammaA = 2.8) dataExample0 <- getDataset( n = c(33), events = c(23) ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x0 <- getAnalysisResults(design = design0, dataInput = dataExample0, thetaH0 = 0.4, normalApproximation = FALSE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x0' with expected results expect_equal(x0$pi1, 0.6969697, tolerance = 1e-06) expect_equal(x0$testActions, c("continue", NA_character_)) expect_equal(x0$conditionalRejectionProbabilities, c(0.28801679, NA_real_), tolerance = 1e-06) expect_equal(x0$conditionalPower, c(NA_real_, NA_real_)) expect_equal(x0$repeatedConfidenceIntervalLowerBounds, c(0.38475339, NA_real_), tolerance = 1e-06) expect_equal(x0$repeatedConfidenceIntervalUpperBounds, c(0.91556352, NA_real_), tolerance = 1e-06) expect_equal(x0$repeatedPValues, c(0.048557231, NA_real_), tolerance = 1e-06) expect_equal(x0$finalStage, NA_integer_) expect_equal(x0$finalPValues, c(NA_real_, NA_real_)) expect_equal(x0$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_)) expect_equal(x0$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_)) expect_equal(x0$medianUnbiasedEstimates, c(NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x0), NA))) expect_output(print(x0)$show()) invisible(capture.output(expect_error(summary(x0), NA))) expect_output(summary(x0)$show()) x0CodeBased <- eval(parse(text = getObjectRCode(x0, stringWrapParagraphWidth = NULL))) expect_equal(x0CodeBased$pi1, x0$pi1, tolerance = 1e-05) expect_equal(x0CodeBased$testActions, x0$testActions, tolerance = 1e-05) expect_equal(x0CodeBased$conditionalRejectionProbabilities, x0$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x0CodeBased$conditionalPower, x0$conditionalPower, tolerance = 1e-05) expect_equal(x0CodeBased$repeatedConfidenceIntervalLowerBounds, x0$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x0CodeBased$repeatedConfidenceIntervalUpperBounds, x0$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x0CodeBased$repeatedPValues, x0$repeatedPValues, tolerance = 1e-05) expect_equal(x0CodeBased$finalStage, x0$finalStage, tolerance = 1e-05) expect_equal(x0CodeBased$finalPValues, x0$finalPValues, tolerance = 1e-05) expect_equal(x0CodeBased$finalConfidenceIntervalLowerBounds, x0$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x0CodeBased$finalConfidenceIntervalUpperBounds, x0$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x0CodeBased$medianUnbiasedEstimates, x0$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x0), "character") df <- as.data.frame(x0) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x0) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults' for a four-stage group sequential design and one treatment", { .skipTestIfDisabled() design1 <- getDesignGroupSequential(kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.4, 0.8, 1), futilityBounds = c(-0.5, 0, 0.5), typeOfDesign = "asKD", gammaA = 2.8) dataExample1 <- getDataset( n = c(10, 10, 20, 11), events = c(4, 5, 5, 6) ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} x1 <- getAnalysisResults(design = design1, dataInput = dataExample1, stage = 2, thetaH0 = 0.75, normalApproximation = FALSE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results expect_equal(x1$pi1, 0.45, tolerance = 1e-07) expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(x1$conditionalRejectionProbabilities, c(0.13502024, 0.39663603, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.035340812, 0.15564775, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.88809247, 0.77284187, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues, c(0.49999905, 0.056127482, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$finalStage, NA_integer_) expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-05) expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-05) expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeSmaller} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCIOneRate} # @refFS[Formula]{fs:medianUnbiasedEstimate} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} x2 <- getAnalysisResults(design = design1, dataInput = dataExample1, stage = 3, thetaH0 = 0.75, normalApproximation = TRUE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results expect_equal(x2$pi1, 0.35, tolerance = 1e-07) expect_equal(x2$testActions, c("continue", "reject and stop", "reject and stop", NA_character_)) expect_equal(x2$conditionalRejectionProbabilities, c(0.21465031, 0.55995383, 1, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.088987896, 0.19243551, 0.20635812, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.81981958, 0.73748169, 0.52720848, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues, c(0.47958473, 0.014066714, 1.9536724e-06, NA_real_), tolerance = 1e-07) expect_equal(x2$finalStage, 2) expect_equal(x2$finalPValues, c(NA_real_, 0.0011783609, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, 0.18821106, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.62661997, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, 0.40681825, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-05) expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-05) expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneRateEffect} x3 <- getAnalysisResults(design = design1, dataInput = dataExample1, stage = 2, thetaH0 = 0.75, nPlanned = c(12,6), pi1 = 0.5, normalApproximation = FALSE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x3' with expected results expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(x3$conditionalRejectionProbabilities, c(0.13502024, 0.39663603, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.85193241, 0.94869662), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.035340812, 0.15564775, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.88809247, 0.77284187, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues, c(0.49999905, 0.056127482, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$finalStage, NA_integer_) expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-05) expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData1 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.45, 0.75, 0.05)) ## Comparison of the results of list object 'plotData1' with expected results expect_equal(plotData1$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07) expect_equal(plotData1$condPowerValues, c(0.98024945, 0.94869662, 0.88988709, 0.79611571, 0.66506207, 0.50313625, 0.32784789), tolerance = 1e-07) expect_equal(plotData1$likelihoodValues, c(1, 0.9039239, 0.66761715, 0.40289032, 0.19865977, 0.080038099, 0.026347981), tolerance = 1e-07) expect_equal(plotData1$main, "Conditional Power with Likelihood") expect_equal(plotData1$xlab, "pi1") expect_equal(plotData1$ylab, "Conditional power / Likelihood") expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 18") # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeSmaller} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:medianUnbiasedEstimate} # @refFS[Formula]{fs:finalCIOneRate} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneRateEffect} x4 <- getAnalysisResults(design = design1, dataInput = dataExample1, stage = 2, thetaH0 = 0.75, nPlanned = c(12,6), pi1 = 0.5, normalApproximation = TRUE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x4' with expected results expect_equal(x4$testActions, c("continue", "reject and stop", NA_character_, NA_character_)) expect_equal(x4$conditionalRejectionProbabilities, c(0.21465031, 0.55995383, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, 0.9494174, 0.9843063), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(0.088987896, 0.19243551, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.81981958, 0.73748169, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedPValues, c(0.47958473, 0.014066714, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$finalStage, 2) expect_equal(x4$finalPValues, c(NA_real_, 0.0011783609, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, 0.18821106, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.62661997, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, 0.40681825, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-05) expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-05) expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-05) expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData2 <- testGetAnalysisResultsPlotData(x4, piTreatmentRange = seq(0.45, 0.75, 0.05)) ## Comparison of the results of list object 'plotData2' with expected results expect_equal(plotData2$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07) expect_equal(plotData2$condPowerValues, c(0.99501417, 0.9843063, 0.96005739, 0.91353722, 0.83535366, 0.71802165, 0.55995335), tolerance = 1e-07) expect_equal(plotData2$likelihoodValues, c(1, 0.9039239, 0.66761715, 0.40289032, 0.19865977, 0.080038099, 0.026347981), tolerance = 1e-07) expect_equal(plotData2$main, "Conditional Power with Likelihood") expect_equal(plotData2$xlab, "pi1") expect_equal(plotData2$ylab, "Conditional power / Likelihood") expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 18") # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneRateEffect} x5 <- getAnalysisResults(design = design1, dataInput = dataExample1, stage = 3, thetaH0 = 0.25, normalApproximation = FALSE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x5' with expected results expect_equal(x5$pi1, 0.35, tolerance = 1e-07) expect_equal(x5$testActions, c("continue", "continue", "continue", NA_character_)) expect_equal(x5$conditionalRejectionProbabilities, c(0.033369686, 0.13517192, 0.020135527, NA_real_), tolerance = 1e-07) expect_equal(x5$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x5$repeatedConfidenceIntervalLowerBounds, c(0.035340812, 0.15564775, 0.18966473, NA_real_), tolerance = 1e-07) expect_equal(x5$repeatedConfidenceIntervalUpperBounds, c(0.88809247, 0.77284187, 0.53925561, NA_real_), tolerance = 1e-07) expect_equal(x5$repeatedPValues, c(0.49999905, 0.49999905, 0.20027888, NA_real_), tolerance = 1e-07) expect_equal(x5$finalStage, NA_integer_) expect_equal(x5$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x5$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x5), NA))) expect_output(print(x5)$show()) invisible(capture.output(expect_error(summary(x5), NA))) expect_output(summary(x5)$show()) x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) expect_equal(x5CodeBased$pi1, x5$pi1, tolerance = 1e-05) expect_equal(x5CodeBased$testActions, x5$testActions, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-05) expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-05) expect_equal(x5CodeBased$finalStage, x5$finalStage, tolerance = 1e-05) expect_equal(x5CodeBased$finalPValues, x5$finalPValues, tolerance = 1e-05) expect_equal(x5CodeBased$finalConfidenceIntervalLowerBounds, x5$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x5CodeBased$finalConfidenceIntervalUpperBounds, x5$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x5CodeBased$medianUnbiasedEstimates, x5$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x5), "character") df <- as.data.frame(x5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneRateEffect} x6 <- getAnalysisResults(design = design1, dataInput = dataExample1, stage = 3, thetaH0 = 0.25, normalApproximation = TRUE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x6' with expected results expect_equal(x6$pi1, 0.35, tolerance = 1e-07) expect_equal(x6$testActions, c("continue", "continue", "continue", NA_character_)) expect_equal(x6$conditionalRejectionProbabilities, c(0.049321561, 0.20984263, 0.048813265, NA_real_), tolerance = 1e-07) expect_equal(x6$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x6$repeatedConfidenceIntervalLowerBounds, c(0.088987896, 0.19243551, 0.20635812, NA_real_), tolerance = 1e-07) expect_equal(x6$repeatedConfidenceIntervalUpperBounds, c(0.81981958, 0.73748169, 0.52720848, NA_real_), tolerance = 1e-07) expect_equal(x6$repeatedPValues, c(0.49999905, 0.27035282, 0.14086509, NA_real_), tolerance = 1e-07) expect_equal(x6$finalStage, NA_integer_) expect_equal(x6$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x6$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x6), NA))) expect_output(print(x6)$show()) invisible(capture.output(expect_error(summary(x6), NA))) expect_output(summary(x6)$show()) x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) expect_equal(x6CodeBased$pi1, x6$pi1, tolerance = 1e-05) expect_equal(x6CodeBased$testActions, x6$testActions, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalPower, x6$conditionalPower, tolerance = 1e-05) expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-05) expect_equal(x6CodeBased$finalStage, x6$finalStage, tolerance = 1e-05) expect_equal(x6CodeBased$finalPValues, x6$finalPValues, tolerance = 1e-05) expect_equal(x6CodeBased$finalConfidenceIntervalLowerBounds, x6$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x6CodeBased$finalConfidenceIntervalUpperBounds, x6$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x6CodeBased$medianUnbiasedEstimates, x6$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x6), "character") df <- as.data.frame(x6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneRateEffect} x7 <- getAnalysisResults(design = design1, dataInput = dataExample1, stage = 2, thetaH0 = 0.25, nPlanned = c(12,6), pi1 = 0.5, normalApproximation = FALSE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x7' with expected results expect_equal(x7$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(x7$conditionalRejectionProbabilities, c(0.033369686, 0.13517192, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x7$conditionalPower, c(NA_real_, NA_real_, 0.58576815, 0.82581584), tolerance = 1e-07) expect_equal(x7$repeatedConfidenceIntervalLowerBounds, c(0.035340812, 0.15564775, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x7$repeatedConfidenceIntervalUpperBounds, c(0.88809247, 0.77284187, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x7$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x7$finalStage, NA_integer_) expect_equal(x7$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x7$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x7$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x7$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x7), NA))) expect_output(print(x7)$show()) invisible(capture.output(expect_error(summary(x7), NA))) expect_output(summary(x7)$show()) x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) expect_equal(x7CodeBased$testActions, x7$testActions, tolerance = 1e-05) expect_equal(x7CodeBased$conditionalRejectionProbabilities, x7$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x7CodeBased$conditionalPower, x7$conditionalPower, tolerance = 1e-05) expect_equal(x7CodeBased$repeatedConfidenceIntervalLowerBounds, x7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x7CodeBased$repeatedConfidenceIntervalUpperBounds, x7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x7CodeBased$repeatedPValues, x7$repeatedPValues, tolerance = 1e-05) expect_equal(x7CodeBased$finalStage, x7$finalStage, tolerance = 1e-05) expect_equal(x7CodeBased$finalPValues, x7$finalPValues, tolerance = 1e-05) expect_equal(x7CodeBased$finalConfidenceIntervalLowerBounds, x7$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x7CodeBased$finalConfidenceIntervalUpperBounds, x7$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x7CodeBased$medianUnbiasedEstimates, x7$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x7), "character") df <- as.data.frame(x7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData3 <- testGetAnalysisResultsPlotData(x7, piTreatmentRange = seq(0.25, 0.55, 0.05)) ## Comparison of the results of list object 'plotData3' with expected results expect_equal(plotData3$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07) expect_equal(plotData3$condPowerValues, c(0.099723847, 0.21903134, 0.37478113, 0.54310492, 0.6994843, 0.82581584, 0.91388883), tolerance = 1e-07) expect_equal(plotData3$likelihoodValues, c(0.19865977, 0.40289032, 0.66761715, 0.9039239, 1, 0.9039239, 0.66761715), tolerance = 1e-07) expect_equal(plotData3$main, "Conditional Power with Likelihood") expect_equal(plotData3$xlab, "pi1") expect_equal(plotData3$ylab, "Conditional power / Likelihood") expect_equal(plotData3$sub, "Stage = 2, # of remaining subjects = 18") # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneRateEffect} x8 <- getAnalysisResults(design = design1, dataInput = dataExample1, stage = 2, thetaH0 = 0.25, nPlanned = c(12,6), pi1 = 0.5, normalApproximation = TRUE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x8' with expected results expect_equal(x8$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(x8$conditionalRejectionProbabilities, c(0.049321561, 0.20984263, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x8$conditionalPower, c(NA_real_, NA_real_, 0.76152324, 0.91259792), tolerance = 1e-07) expect_equal(x8$repeatedConfidenceIntervalLowerBounds, c(0.088987896, 0.19243551, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x8$repeatedConfidenceIntervalUpperBounds, c(0.81981958, 0.73748169, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x8$repeatedPValues, c(0.49999905, 0.27035282, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x8$finalStage, NA_integer_) expect_equal(x8$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x8$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x8$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x8$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x8), NA))) expect_output(print(x8)$show()) invisible(capture.output(expect_error(summary(x8), NA))) expect_output(summary(x8)$show()) x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) expect_equal(x8CodeBased$testActions, x8$testActions, tolerance = 1e-05) expect_equal(x8CodeBased$conditionalRejectionProbabilities, x8$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x8CodeBased$conditionalPower, x8$conditionalPower, tolerance = 1e-05) expect_equal(x8CodeBased$repeatedConfidenceIntervalLowerBounds, x8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x8CodeBased$repeatedConfidenceIntervalUpperBounds, x8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x8CodeBased$repeatedPValues, x8$repeatedPValues, tolerance = 1e-05) expect_equal(x8CodeBased$finalStage, x8$finalStage, tolerance = 1e-05) expect_equal(x8CodeBased$finalPValues, x8$finalPValues, tolerance = 1e-05) expect_equal(x8CodeBased$finalConfidenceIntervalLowerBounds, x8$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x8CodeBased$finalConfidenceIntervalUpperBounds, x8$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x8CodeBased$medianUnbiasedEstimates, x8$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x8), "character") df <- as.data.frame(x8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData4 <- testGetAnalysisResultsPlotData(x8, piTreatmentRange = seq(0.25, 0.55, 0.05)) ## Comparison of the results of list object 'plotData4' with expected results expect_equal(plotData4$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07) expect_equal(plotData4$condPowerValues, c(0.20983878, 0.3743042, 0.54811429, 0.70471917, 0.82789376, 0.91259792, 0.96272982), tolerance = 1e-07) expect_equal(plotData4$likelihoodValues, c(0.19865977, 0.40289032, 0.66761715, 0.9039239, 1, 0.9039239, 0.66761715), tolerance = 1e-07) expect_equal(plotData4$main, "Conditional Power with Likelihood") expect_equal(plotData4$xlab, "pi1") expect_equal(plotData4$ylab, "Conditional power / Likelihood") expect_equal(plotData4$sub, "Stage = 2, # of remaining subjects = 18") }) test_that("'getAnalysisResults' for a four-stage inverse sequential design and one treatment", { .skipTestIfDisabled() design2 <- getDesignInverseNormal(kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.4, 0.8, 1), futilityBounds = c(-0.5, 0, 0.5), typeOfDesign = "asKD", gammaA = 2.8) dataExample2 <- getDataset( n = c(8, 10, 9, 11), # cumsum, overall n = (8, 18, 27, 38) events = c(4, 5, 5, 6) # cumsum, overall events = (4, 9, 14, 20) ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x1 <- getAnalysisResults(design = design2, dataInput = dataExample2, stage = 3, thetaH0 = 0.75, normalApproximation = FALSE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsInverseNormal object 'x1' with expected results expect_equal(x1$pi1, 0.51851852, tolerance = 1e-07) expect_equal(x1$testActions, c("continue", "continue", "continue", NA_character_)) expect_equal(x1$conditionalRejectionProbabilities, c(0.055828724, 0.15918316, 0.28098687, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.046266965, 0.16132361, 0.26858957, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.95373304, 0.83867639, 0.7687011, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues, c(0.49999905, 0.43799317, 0.045574143, NA_real_), tolerance = 1e-07) expect_equal(x1$finalStage, NA_integer_) expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-05) expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-05) expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCIOneRate} # @refFS[Formula]{fs:medianUnbiasedEstimate} x2 <- getAnalysisResults(design = design2, dataInput = dataExample2, stage = 3, thetaH0 = 0.75, normalApproximation = TRUE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsInverseNormal object 'x2' with expected results expect_equal(x2$pi1, 0.51851852, tolerance = 1e-07) expect_equal(x2$testActions, c("continue", "continue", "reject and stop", NA_character_)) expect_equal(x2$conditionalRejectionProbabilities, c(0.088079629, 0.32350577, 0.78413538, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.1131446, 0.21610037, 0.31861038, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.8868554, 0.78389963, 0.72001939, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues, c(0.49999905, 0.1020964, 0.0075111702, NA_real_), tolerance = 1e-07) expect_equal(x2$finalStage, 3) expect_equal(x2$finalPValues, c(NA_real_, NA_real_, 0.0050707339, NA_real_), tolerance = 1e-07) expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.3041323, NA_real_), tolerance = 1e-07) expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.68870859, NA_real_), tolerance = 1e-07) expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.49547717, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-05) expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-05) expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x3 <- getAnalysisResults(design = design2, dataInput = dataExample2, stage = 2, thetaH0 = 0.75, nPlanned = c(12,6), pi1 = 0.5, normalApproximation = FALSE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsInverseNormal object 'x3' with expected results expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(x3$conditionalRejectionProbabilities, c(0.055828724, 0.15918316, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.69921202, 0.88465983), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.046266965, 0.16132361, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.95373304, 0.83867639, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues, c(0.49999905, 0.43799317, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$finalStage, NA_integer_) expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-05) expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData1 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.45, 0.75, 0.05)) ## Comparison of the results of list object 'plotData1' with expected results expect_equal(plotData1$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07) expect_equal(plotData1$condPowerValues, c(0.94793138, 0.88465983, 0.78396384, 0.64581102, 0.48045808, 0.30888816, 0.15917802), tolerance = 1e-07) expect_equal(plotData1$likelihoodValues, c(0.91393119, 1, 0.91393119, 0.69767633, 0.44485807, 0.23692776, 0.10539922), tolerance = 1e-07) expect_equal(plotData1$main, "Conditional Power with Likelihood") expect_equal(plotData1$xlab, "pi1") expect_equal(plotData1$ylab, "Conditional power / Likelihood") expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 18") # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x4 <- getAnalysisResults(design = design2, dataInput = dataExample2, stage = 2, thetaH0 = 0.75, nPlanned = c(12,6), pi1 = 0.5, normalApproximation = TRUE, directionUpper = FALSE) ## Comparison of the results of AnalysisResultsInverseNormal object 'x4' with expected results expect_equal(x4$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(x4$conditionalRejectionProbabilities, c(0.088079629, 0.32350577, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, 0.85385983, 0.95015898), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(0.1131446, 0.21610037, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.8868554, 0.78389963, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedPValues, c(0.49999905, 0.1020964, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$finalStage, NA_integer_) expect_equal(x4$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-05) expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-05) expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-05) expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData2 <- testGetAnalysisResultsPlotData(x4, piTreatmentRange = seq(0.45, 0.75, 0.05)) ## Comparison of the results of list object 'plotData2' with expected results expect_equal(plotData2$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07) expect_equal(plotData2$condPowerValues, c(0.98088099, 0.95015898, 0.89232288, 0.79901831, 0.66708346, 0.50248974, 0.32350374), tolerance = 1e-07) expect_equal(plotData2$likelihoodValues, c(0.91393119, 1, 0.91393119, 0.69767633, 0.44485807, 0.23692776, 0.10539922), tolerance = 1e-07) expect_equal(plotData2$main, "Conditional Power with Likelihood") expect_equal(plotData2$xlab, "pi1") expect_equal(plotData2$ylab, "Conditional power / Likelihood") expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 18") # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x5 <- getAnalysisResults(design = design2, dataInput = dataExample2, stage = 3, thetaH0 = 0.25, normalApproximation = FALSE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsInverseNormal object 'x5' with expected results expect_equal(x5$pi1, 0.51851852, tolerance = 1e-07) expect_equal(x5$testActions, c("continue", "continue", "reject and stop", NA_character_)) expect_equal(x5$conditionalRejectionProbabilities, c(0.055828724, 0.15918316, 0.6508521, NA_real_), tolerance = 1e-07) expect_equal(x5$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x5$repeatedConfidenceIntervalLowerBounds, c(0.046266965, 0.16132361, 0.26858957, NA_real_), tolerance = 1e-07) expect_equal(x5$repeatedConfidenceIntervalUpperBounds, c(0.95373304, 0.83867639, 0.7687011, NA_real_), tolerance = 1e-07) expect_equal(x5$repeatedPValues, c(0.49999905, 0.43799317, 0.013282796, NA_real_), tolerance = 1e-07) expect_equal(x5$finalStage, 3) expect_equal(x5$finalPValues, c(NA_real_, NA_real_, 0.007752129, NA_real_), tolerance = 1e-07) expect_equal(x5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.29554194, NA_real_), tolerance = 1e-07) expect_equal(x5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.67875285, NA_real_), tolerance = 1e-07) expect_equal(x5$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.48769629, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x5), NA))) expect_output(print(x5)$show()) invisible(capture.output(expect_error(summary(x5), NA))) expect_output(summary(x5)$show()) x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) expect_equal(x5CodeBased$pi1, x5$pi1, tolerance = 1e-05) expect_equal(x5CodeBased$testActions, x5$testActions, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-05) expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-05) expect_equal(x5CodeBased$finalStage, x5$finalStage, tolerance = 1e-05) expect_equal(x5CodeBased$finalPValues, x5$finalPValues, tolerance = 1e-05) expect_equal(x5CodeBased$finalConfidenceIntervalLowerBounds, x5$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x5CodeBased$finalConfidenceIntervalUpperBounds, x5$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x5CodeBased$medianUnbiasedEstimates, x5$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x5), "character") df <- as.data.frame(x5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} x6 <- getAnalysisResults(design = design2, dataInput = dataExample2, stage = 3, thetaH0 = 0.25, normalApproximation = TRUE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsInverseNormal object 'x6' with expected results expect_equal(x6$pi1, 0.51851852, tolerance = 1e-07) expect_equal(x6$testActions, c("continue", "continue", "reject and stop", NA_character_)) expect_equal(x6$conditionalRejectionProbabilities, c(0.088079629, 0.32350577, 0.96959663, NA_real_), tolerance = 1e-07) expect_equal(x6$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x6$repeatedConfidenceIntervalLowerBounds, c(0.1131446, 0.21610037, 0.31861038, NA_real_), tolerance = 1e-07) expect_equal(x6$repeatedConfidenceIntervalUpperBounds, c(0.8868554, 0.78389963, 0.72001939, NA_real_), tolerance = 1e-07) expect_equal(x6$repeatedPValues, c(0.49999905, 0.1020964, 0.0013103922, NA_real_), tolerance = 1e-07) expect_equal(x6$finalStage, 3) expect_equal(x6$finalPValues, c(NA_real_, NA_real_, 0.002378519, NA_real_), tolerance = 1e-07) expect_equal(x6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.3437363, NA_real_), tolerance = 1e-07) expect_equal(x6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.73847376, NA_real_), tolerance = 1e-07) expect_equal(x6$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.54446903, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x6), NA))) expect_output(print(x6)$show()) invisible(capture.output(expect_error(summary(x6), NA))) expect_output(summary(x6)$show()) x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) expect_equal(x6CodeBased$pi1, x6$pi1, tolerance = 1e-05) expect_equal(x6CodeBased$testActions, x6$testActions, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalPower, x6$conditionalPower, tolerance = 1e-05) expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-05) expect_equal(x6CodeBased$finalStage, x6$finalStage, tolerance = 1e-05) expect_equal(x6CodeBased$finalPValues, x6$finalPValues, tolerance = 1e-05) expect_equal(x6CodeBased$finalConfidenceIntervalLowerBounds, x6$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x6CodeBased$finalConfidenceIntervalUpperBounds, x6$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x6CodeBased$medianUnbiasedEstimates, x6$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x6), "character") df <- as.data.frame(x6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneRateEffect} x7 <- getAnalysisResults(design = design2, dataInput = dataExample2, stage = 2, thetaH0 = 0.25, nPlanned = c(12,6), pi1 = 0.5, normalApproximation = FALSE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsInverseNormal object 'x7' with expected results expect_equal(x7$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(x7$conditionalRejectionProbabilities, c(0.055828724, 0.15918316, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x7$conditionalPower, c(NA_real_, NA_real_, 0.69921202, 0.88465983), tolerance = 1e-07) expect_equal(x7$repeatedConfidenceIntervalLowerBounds, c(0.046266965, 0.16132361, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x7$repeatedConfidenceIntervalUpperBounds, c(0.95373304, 0.83867639, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x7$repeatedPValues, c(0.49999905, 0.43799317, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x7$finalStage, NA_integer_) expect_equal(x7$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x7$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x7$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x7$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x7), NA))) expect_output(print(x7)$show()) invisible(capture.output(expect_error(summary(x7), NA))) expect_output(summary(x7)$show()) x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) expect_equal(x7CodeBased$testActions, x7$testActions, tolerance = 1e-05) expect_equal(x7CodeBased$conditionalRejectionProbabilities, x7$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x7CodeBased$conditionalPower, x7$conditionalPower, tolerance = 1e-05) expect_equal(x7CodeBased$repeatedConfidenceIntervalLowerBounds, x7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x7CodeBased$repeatedConfidenceIntervalUpperBounds, x7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x7CodeBased$repeatedPValues, x7$repeatedPValues, tolerance = 1e-05) expect_equal(x7CodeBased$finalStage, x7$finalStage, tolerance = 1e-05) expect_equal(x7CodeBased$finalPValues, x7$finalPValues, tolerance = 1e-05) expect_equal(x7CodeBased$finalConfidenceIntervalLowerBounds, x7$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x7CodeBased$finalConfidenceIntervalUpperBounds, x7$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x7CodeBased$medianUnbiasedEstimates, x7$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x7), "character") df <- as.data.frame(x7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData3 <- testGetAnalysisResultsPlotData(x7, piTreatmentRange = seq(0.25, 0.55, 0.05)) ## Comparison of the results of list object 'plotData3' with expected results expect_equal(plotData3$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07) expect_equal(plotData3$condPowerValues, c(0.15917802, 0.30888816, 0.48045808, 0.64581102, 0.78396384, 0.88465983, 0.94793138), tolerance = 1e-07) expect_equal(plotData3$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07) expect_equal(plotData3$main, "Conditional Power with Likelihood") expect_equal(plotData3$xlab, "pi1") expect_equal(plotData3$ylab, "Conditional power / Likelihood") expect_equal(plotData3$sub, "Stage = 2, # of remaining subjects = 18") # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerOneRateEffect} x8 <- getAnalysisResults(design = design2, dataInput = dataExample2, stage = 2, thetaH0 = 0.25, nPlanned = c(12,6), pi1 = 0.5, normalApproximation = TRUE, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsInverseNormal object 'x8' with expected results expect_equal(x8$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(x8$conditionalRejectionProbabilities, c(0.088079629, 0.32350577, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x8$conditionalPower, c(NA_real_, NA_real_, 0.85385983, 0.95015898), tolerance = 1e-07) expect_equal(x8$repeatedConfidenceIntervalLowerBounds, c(0.1131446, 0.21610037, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x8$repeatedConfidenceIntervalUpperBounds, c(0.8868554, 0.78389963, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x8$repeatedPValues, c(0.49999905, 0.1020964, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x8$finalStage, NA_integer_) expect_equal(x8$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x8$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x8$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x8$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x8), NA))) expect_output(print(x8)$show()) invisible(capture.output(expect_error(summary(x8), NA))) expect_output(summary(x8)$show()) x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) expect_equal(x8CodeBased$testActions, x8$testActions, tolerance = 1e-05) expect_equal(x8CodeBased$conditionalRejectionProbabilities, x8$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x8CodeBased$conditionalPower, x8$conditionalPower, tolerance = 1e-05) expect_equal(x8CodeBased$repeatedConfidenceIntervalLowerBounds, x8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x8CodeBased$repeatedConfidenceIntervalUpperBounds, x8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x8CodeBased$repeatedPValues, x8$repeatedPValues, tolerance = 1e-05) expect_equal(x8CodeBased$finalStage, x8$finalStage, tolerance = 1e-05) expect_equal(x8CodeBased$finalPValues, x8$finalPValues, tolerance = 1e-05) expect_equal(x8CodeBased$finalConfidenceIntervalLowerBounds, x8$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x8CodeBased$finalConfidenceIntervalUpperBounds, x8$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x8CodeBased$medianUnbiasedEstimates, x8$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x8), "character") df <- as.data.frame(x8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData4 <- testGetAnalysisResultsPlotData(x8, piTreatmentRange = seq(0.25, 0.55, 0.05)) ## Comparison of the results of list object 'plotData4' with expected results expect_equal(plotData4$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07) expect_equal(plotData4$condPowerValues, c(0.32350374, 0.50248974, 0.66708346, 0.79901831, 0.89232288, 0.95015898, 0.98088099), tolerance = 1e-07) expect_equal(plotData4$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07) expect_equal(plotData4$main, "Conditional Power with Likelihood") expect_equal(plotData4$xlab, "pi1") expect_equal(plotData4$ylab, "Conditional power / Likelihood") expect_equal(plotData4$sub, "Stage = 2, # of remaining subjects = 18") }) test_that("'getAnalysisResults' for a four-stage Fisher design and one treatment", { .skipTestIfDisabled() design3 <- getDesignFisher(kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.4, 0.8, 1)) dataExample3 <- getDataset( n = c(8, 10, 9, 11), # cumsum, overall n = (8, 18, 27, 38) events = c(4, 5, 5, 6) # cumsum, overall events = (4, 9, 14, 20) ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} x1 <- getAnalysisResults(design = design3, dataInput = dataExample3, stage = 3, thetaH0 = 0.75, normalApproximation = FALSE, directionUpper = FALSE, iterations = 1000, seed = 123) ## Comparison of the results of AnalysisResultsFisher object 'x1' with expected results expect_equal(x1$pi1, 0.51851852, tolerance = 1e-07) expect_equal(x1$testActions, c("continue", "continue", "continue", NA_character_)) expect_equal(x1$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, 0.018233808, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, 0.23521677, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, 0.79971589, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues, c(0.23393398, 0.11483365, 0.11050779, NA_real_), tolerance = 1e-07) expect_equal(x1$finalStage, NA_integer_) expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-05) expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-05) expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} x2 <- getAnalysisResults(design = design3, dataInput = dataExample3, stage = 3, thetaH0 = 0.75, normalApproximation = TRUE, directionUpper = FALSE, iterations = 1000, seed = 123) ## Comparison of the results of AnalysisResultsFisher object 'x2' with expected results expect_equal(x2$pi1, 0.51851852, tolerance = 1e-07) expect_equal(x2$testActions, c("continue", "continue", "reject and stop", NA_character_)) expect_equal(x2$conditionalRejectionProbabilities, c(0.051264101, 0.1206033, 1, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.18175814, 0.2424364, 0.28642867, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.81824186, 0.7575636, 0.7496417, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues, c(0.11554509, 0.032131177, 0.024656293, NA_real_), tolerance = 1e-07) expect_equal(x2$finalStage, NA_integer_) expect_equal(x2$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-05) expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-05) expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionFisherInterim} x3 <- getAnalysisResults(design = design3, dataInput = dataExample3, stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, normalApproximation = FALSE, directionUpper = FALSE, iterations = 1000, seed = 123) ## Comparison of the results of AnalysisResultsFisher object 'x3' with expected results expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(x3$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues, c(0.23393398, 0.11483365, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$finalStage, NA_integer_) expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.522, 0.672), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-05) expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPowerSimulated, x3$conditionalPowerSimulated, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData1 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.25, 0.55, 0.05)) ## Comparison of the results of list object 'plotData1' with expected results expect_equal(plotData1$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07) expect_equal(plotData1$condPowerValues, c(0.997, 0.99, 0.967, 0.9, 0.822, 0.659, 0.534), tolerance = 1e-07) expect_equal(plotData1$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07) expect_equal(plotData1$main, "Conditional Power with Likelihood") expect_equal(plotData1$xlab, "pi1") expect_equal(plotData1$ylab, "Conditional power / Likelihood") expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 18") # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} x4 <- getAnalysisResults(design = design3, dataInput = dataExample3, stage = 3, thetaH0 = 0.25, normalApproximation = FALSE, directionUpper = TRUE, iterations = 1000, seed = 123) ## Comparison of the results of AnalysisResultsFisher object 'x4' with expected results expect_equal(x4$pi1, 0.51851852, tolerance = 1e-07) expect_equal(x4$testActions, c("continue", "continue", "continue", NA_character_)) expect_equal(x4$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, 0.10237226, NA_real_), tolerance = 1e-07) expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, 0.23521677, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, 0.79971589, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedPValues, c(0.23393398, 0.11483365, 0.040061917, NA_real_), tolerance = 1e-07) expect_equal(x4$finalStage, NA_integer_) expect_equal(x4$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$pi1, x4$pi1, tolerance = 1e-05) expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-05) expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-05) expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-05) expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} x5 <- getAnalysisResults(design = design3, dataInput = dataExample3, stage = 3, thetaH0 = 0.25, normalApproximation = TRUE, directionUpper = TRUE, iterations = 1000, seed = 123) ## Comparison of the results of AnalysisResultsFisher object 'x5' with expected results expect_equal(x5$pi1, 0.51851852, tolerance = 1e-07) expect_equal(x5$testActions, c("continue", "continue", "reject and stop", NA_character_)) expect_equal(x5$conditionalRejectionProbabilities, c(0.051264101, 0.1206033, 1, NA_real_), tolerance = 1e-07) expect_equal(x5$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x5$repeatedConfidenceIntervalLowerBounds, c(0.18175814, 0.2424364, 0.28642867, NA_real_), tolerance = 1e-07) expect_equal(x5$repeatedConfidenceIntervalUpperBounds, c(0.81824186, 0.7575636, 0.7496417, NA_real_), tolerance = 1e-07) expect_equal(x5$repeatedPValues, c(0.11554509, 0.032131177, 0.0055275316, NA_real_), tolerance = 1e-07) expect_equal(x5$finalStage, NA_integer_) expect_equal(x5$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x5$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x5), NA))) expect_output(print(x5)$show()) invisible(capture.output(expect_error(summary(x5), NA))) expect_output(summary(x5)$show()) x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) expect_equal(x5CodeBased$pi1, x5$pi1, tolerance = 1e-05) expect_equal(x5CodeBased$testActions, x5$testActions, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-05) expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-05) expect_equal(x5CodeBased$finalStage, x5$finalStage, tolerance = 1e-05) expect_equal(x5CodeBased$finalPValues, x5$finalPValues, tolerance = 1e-05) expect_equal(x5CodeBased$finalConfidenceIntervalLowerBounds, x5$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x5CodeBased$finalConfidenceIntervalUpperBounds, x5$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x5CodeBased$medianUnbiasedEstimates, x5$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x5), "character") df <- as.data.frame(x5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticOneRateApproximation} # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionFisherInterim} x6 <- getAnalysisResults(design = design3, dataInput = dataExample3, stage = 2, thetaH0 = 0.25, nPlanned = c(12,6), pi1 = 0.5, normalApproximation = FALSE, directionUpper = TRUE, iterations = 1000, seed = 123) ## Comparison of the results of AnalysisResultsFisher object 'x6' with expected results expect_equal(x6$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(x6$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x6$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x6$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x6$repeatedPValues, c(0.23393398, 0.11483365, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x6$finalStage, NA_integer_) expect_equal(x6$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x6$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x6$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.522, 0.672), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x6), NA))) expect_output(print(x6)$show()) invisible(capture.output(expect_error(summary(x6), NA))) expect_output(summary(x6)$show()) x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) expect_equal(x6CodeBased$testActions, x6$testActions, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-05) expect_equal(x6CodeBased$finalStage, x6$finalStage, tolerance = 1e-05) expect_equal(x6CodeBased$finalPValues, x6$finalPValues, tolerance = 1e-05) expect_equal(x6CodeBased$finalConfidenceIntervalLowerBounds, x6$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x6CodeBased$finalConfidenceIntervalUpperBounds, x6$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x6CodeBased$medianUnbiasedEstimates, x6$medianUnbiasedEstimates, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalPowerSimulated, x6$conditionalPowerSimulated, tolerance = 1e-05) expect_type(names(x6), "character") df <- as.data.frame(x6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData2 <- testGetAnalysisResultsPlotData(x6, piTreatmentRange = seq(0.25, 0.55, 0.05)) ## Comparison of the results of list object 'plotData2' with expected results expect_equal(plotData2$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07) expect_equal(plotData2$condPowerValues, c(0.039, 0.114, 0.208, 0.363, 0.54, 0.659, 0.817), tolerance = 1e-07) expect_equal(plotData2$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07) expect_equal(plotData2$main, "Conditional Power with Likelihood") expect_equal(plotData2$xlab, "pi1") expect_equal(plotData2$ylab, "Conditional power / Likelihood") expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 18") }) context("Testing the Analysis Rates Functionality for Two Treatments") test_that("'getAnalysisResults' for a four-stage group sequential design and two treatments", { .skipTestIfDisabled() design7 <- getDesignGroupSequential(kMax = 4, alpha = 0.025, typeOfDesign = "WT", deltaWT = 0.25, informationRates = c(0.2, 0.4, 0.8, 1), futilityBounds = c(0, 0.5, 0.8), bindingFutility = TRUE) dataExample5 <- getDataset( n1 = c(17, 18, 22), n2 = c(18, 17, 19), events1 = c(11, 12, 17), events2 = c(5, 10, 7) ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} x1 <- getAnalysisResults(design7, dataExample5, thetaH0 = 0, stage = 2, nPlanned = c(60, 30), pi2 = 0.4, pi1 = 0.8, directionUpper = TRUE, allocationRatioPlanned = 2) ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(x1$conditionalRejectionProbabilities, c(0.19002543, 0.18837824, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, 0.97639752, 0.99770454), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.14000095, -0.076268589, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.72492425, 0.49449415, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues, c(0.083297609, 0.074571507, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$finalStage, NA_integer_) expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-05) expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData1 <- testGetAnalysisResultsPlotData(x1, piTreatmentRange = seq(0.5, 0.8, 0.05), allocationRatioPlanned = 2) ## Comparison of the results of list object 'plotData1' with expected results expect_equal(plotData1$xValues, c(0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8), tolerance = 1e-07) expect_equal(plotData1$condPowerValues, c(0.47726473, 0.64780315, 0.79588169, 0.90153211, 0.96202912, 0.98889368, 0.99770454), tolerance = 1e-07) expect_equal(plotData1$likelihoodValues, c(0.14689674, 0.40998118, 0.77598415, 0.99604498, 0.86704618, 0.51184997, 0.20491809), tolerance = 1e-07) expect_equal(plotData1$main, "Conditional Power with Likelihood") expect_equal(plotData1$xlab, "pi1") expect_equal(plotData1$ylab, "Conditional power / Likelihood") expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.4, allocation ratio = 2") # reversed "directionUpper" # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} x2 <- getAnalysisResults(design7, dataExample5, thetaH0 = 0, stage = 2, nPlanned = c(60,30), pi2 = 0.8, pi1 = 0.4, directionUpper = FALSE, allocationRatioPlanned = 0.5) ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results expect_equal(x2$testActions, c("accept and stop", "accept and stop", NA_character_, NA_character_)) expect_equal(x2$conditionalRejectionProbabilities, c(0, 0, NA_real_, NA_real_)) expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, 0.037603851, 0.34743098), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.14000095, -0.076268589, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.72492425, 0.49449415, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$finalStage, 1) expect_equal(x2$finalPValues, c(0.98580558, NA_real_, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$finalConfidenceIntervalLowerBounds, c(0.039328967, NA_real_, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$finalConfidenceIntervalUpperBounds, c(0.62730986, NA_real_, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$medianUnbiasedEstimates, c(0.36928105, NA_real_, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-05) expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData2 <- testGetAnalysisResultsPlotData(x2, piTreatmentRange = seq(0.2, 0.5, 0.05), allocationRatioPlanned = 0.5) ## Comparison of the results of list object 'plotData2' with expected results expect_equal(plotData2$xValues, c(0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), tolerance = 1e-07) expect_equal(plotData2$condPowerValues, c(0.98964948, 0.93182725, 0.78360503, 0.56553646, 0.34743098, 0.18277547, 0.082851862), tolerance = 1e-07) expect_equal(plotData2$likelihoodValues, c(8.9244677e-08, 2.5604189e-06, 4.9816924e-05, 0.00065732471, 0.0058819346, 0.035694195, 0.14689674), tolerance = 1e-07) expect_equal(plotData2$main, "Conditional Power with Likelihood") expect_equal(plotData2$xlab, "pi1") expect_equal(plotData2$ylab, "Conditional power / Likelihood") expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.8, allocation ratio = 0.5") }) test_that("'getAnalysisResults' for a four-stage inverse normal design and two treatments", { .skipTestIfDisabled() design8 <- getDesignInverseNormal(kMax = 4, alpha = 0.025, typeOfDesign = "WT", deltaWT = 0.25, informationRates = c(0.2, 0.4, 0.8, 1), futilityBounds = c(0, 0.5, 0.8), bindingFutility = TRUE) dataExample6 <- getDataset( n1 = c(17, 18, 22), n2 = c(18, 17, 19), events1 = c(11, 12, 17), events2 = c(5, 10, 7) ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} x1 <- getAnalysisResults(design8, dataExample6, thetaH0 = 0.0, stage = 2, nPlanned = c(30,30), pi2 = 0.2, pi1 = 0.4, directionUpper = TRUE) ## Comparison of the results of AnalysisResultsInverseNormal object 'x1' with expected results expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(x1$conditionalRejectionProbabilities, c(0.19002543, 0.18093983, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, 0.51829859, 0.74637814), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.14000095, -0.078581055, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.72492425, 0.48870099, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues, c(0.083297609, 0.077943692, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$finalStage, NA_integer_) expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-05) expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData1 <- testGetAnalysisResultsPlotData(x1, piTreatmentRange = seq(0.4, 0.7, 0.05), nPlanned = c(30,30)) ## Comparison of the results of list object 'plotData1' with expected results expect_equal(plotData1$xValues, c(0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7), tolerance = 1e-07) expect_equal(plotData1$condPowerValues, c(0.74637814, 0.85191228, 0.92421447, 0.96693166, 0.98816058, 0.99670572, 0.99934119), tolerance = 1e-07) expect_equal(plotData1$likelihoodValues, c(0.0058819346, 0.035694195, 0.14689674, 0.40998118, 0.77598415, 0.99604498, 0.86704618), tolerance = 1e-07) expect_equal(plotData1$main, "Conditional Power with Likelihood") expect_equal(plotData1$xlab, "pi1") expect_equal(plotData1$ylab, "Conditional power / Likelihood") expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 60, pi2 = 0.2, allocation ratio = 1") # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} x3 <- getAnalysisResults(design8, dataExample6, thetaH0 = 0, stage = 2, nPlanned = c(60, 30), pi2 = 0.4, pi1 = 0.8, directionUpper = TRUE, allocationRatioPlanned = 2) ## Comparison of the results of AnalysisResultsInverseNormal object 'x3' with expected results expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(x3$conditionalRejectionProbabilities, c(0.19002543, 0.18093983, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.97637134, 0.99770045), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(-0.14000095, -0.078581055, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.72492425, 0.48870099, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues, c(0.083297609, 0.077943692, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$finalStage, NA_integer_) expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-05) expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData4 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.5, 0.8, 0.05), allocationRatioPlanned = 2) ## Comparison of the results of list object 'plotData4' with expected results expect_equal(plotData4$xValues, c(0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8), tolerance = 1e-07) expect_equal(plotData4$condPowerValues, c(0.4771434, 0.64764919, 0.79574037, 0.90143545, 0.96198044, 0.98887633, 0.99770045), tolerance = 1e-07) expect_equal(plotData4$likelihoodValues, c(0.14689674, 0.40998118, 0.77598415, 0.99604498, 0.86704618, 0.51184997, 0.20491809), tolerance = 1e-07) expect_equal(plotData4$main, "Conditional Power with Likelihood") expect_equal(plotData4$xlab, "pi1") expect_equal(plotData4$ylab, "Conditional power / Likelihood") expect_equal(plotData4$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.4, allocation ratio = 2") # reversed "directionUpper" # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} x4 <- getAnalysisResults(design8, dataExample6, thetaH0 = 0, stage = 2, nPlanned = c(60,30), pi2 = 0.8, pi1 = 0.4, directionUpper = FALSE, allocationRatioPlanned = 0.5) ## Comparison of the results of AnalysisResultsInverseNormal object 'x4' with expected results expect_equal(x4$testActions, c("accept and stop", "accept and stop", NA_character_, NA_character_)) expect_equal(x4$conditionalRejectionProbabilities, c(0, 0, NA_real_, NA_real_)) expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, 0.037603851, 0.34743098), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(-0.14000095, -0.078581055, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.72492425, 0.48870099, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$finalStage, 1) expect_equal(x4$finalPValues, c(0.98580558, NA_real_, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$finalConfidenceIntervalLowerBounds, c(0.039328967, NA_real_, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$finalConfidenceIntervalUpperBounds, c(0.62730986, NA_real_, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$medianUnbiasedEstimates, c(0.36928105, NA_real_, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-05) expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-05) expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-05) expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData5 <- testGetAnalysisResultsPlotData(x4, piTreatmentRange = seq(0.2, 0.5, 0.05), allocationRatioPlanned = 0.5) ## Comparison of the results of list object 'plotData5' with expected results expect_equal(plotData5$xValues, c(0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), tolerance = 1e-07) expect_equal(plotData5$condPowerValues, c(0.98964948, 0.93182725, 0.78360503, 0.56553646, 0.34743098, 0.18277547, 0.082851862), tolerance = 1e-07) expect_equal(plotData5$likelihoodValues, c(8.9244677e-08, 2.5604189e-06, 4.9816924e-05, 0.00065732471, 0.0058819346, 0.035694195, 0.14689674), tolerance = 1e-07) expect_equal(plotData5$main, "Conditional Power with Likelihood") expect_equal(plotData5$xlab, "pi1") expect_equal(plotData5$ylab, "Conditional power / Likelihood") expect_equal(plotData5$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.8, allocation ratio = 0.5") }) test_that("'getAnalysisResults' for a four-stage Fisher design and two treatments", { .skipTestIfDisabled() design9 <- getDesignFisher(kMax = 4, alpha = 0.025, method = "equalAlpha", informationRates = c(0.2, 0.4, 0.8, 1)) dataExample7 <- getDataset( n1 = c(17, 23, 22), n2 = c(18, 20, 19), events1 = c(11, 12, 17), events2 = c(5, 10, 7) ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionFisherInterim} # @refFS[Formula]{fs:conditionalRejectionFisherLastInterim} # @refFS[Formula]{fs:conditionalRejectionFisherweights} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} x1 <- getAnalysisResults(design9, dataExample7, thetaH0 = 0, stage = 2, nPlanned = c(60, 30), pi2 = 0.4, pi1 = 0.8, directionUpper = TRUE, allocationRatioPlanned = 2, seed = 123) ## Comparison of the results of AnalysisResultsFisher object 'x1' with expected results expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(x1$conditionalRejectionProbabilities, c(0.13898608, 0.050808351, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.023853561, -0.068378457, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.66428984, 0.40418869, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues, c(0.035427069, 0.088523734, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$finalStage, NA_integer_) expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.925, 0.972), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-05) expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPowerSimulated, x1$conditionalPowerSimulated, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData1 <- testGetAnalysisResultsPlotData(x1, piTreatmentRange = seq(0.5, 0.8, 0.05), allocationRatioPlanned = 2) ## Comparison of the results of list object 'plotData1' with expected results expect_equal(plotData1$xValues, c(0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8), tolerance = 1e-07) expect_equal(plotData1$condPowerValues, c(0.199, 0.364, 0.506, 0.686, 0.839, 0.927, 0.979), tolerance = 1e-07) expect_equal(plotData1$likelihoodValues, c(0.63105765, 0.95013529, 0.95013529, 0.63105765, 0.27837883, 0.081561833, 0.015871623), tolerance = 1e-07) expect_equal(plotData1$main, "Conditional Power with Likelihood") expect_equal(plotData1$xlab, "pi1") expect_equal(plotData1$ylab, "Conditional power / Likelihood") expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.4, allocation ratio = 2") # reversed "directionUpper" # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionFisherInterim} # @refFS[Formula]{fs:conditionalRejectionFisherLastInterim} # @refFS[Formula]{fs:conditionalRejectionFisherweights} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} x2 <- getAnalysisResults(design9, dataExample7, thetaH0 = 0, stage = 2, nPlanned = c(60,30), pi2 = 0.8, pi1 = 0.4, directionUpper = FALSE, allocationRatioPlanned = 0.5, seed = 123) ## Comparison of the results of AnalysisResultsFisher object 'x2' with expected results expect_equal(x2$testActions, c("continue", "continue", NA_character_, NA_character_)) expect_equal(x2$conditionalRejectionProbabilities, c(0.0056634595, 0.0023089469, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.023853561, -0.068378457, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.66428984, 0.40418869, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$finalStage, NA_integer_) expect_equal(x2$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x2$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.591, 0.788), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-05) expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPowerSimulated, x2$conditionalPowerSimulated, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData2 <- testGetAnalysisResultsPlotData(x2,piTreatmentRange = seq(0.2, 0.5, 0.05), allocationRatioPlanned = 0.5) ## Comparison of the results of list object 'plotData2' with expected results expect_equal(plotData2$xValues, c(0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), tolerance = 1e-07) expect_equal(plotData2$condPowerValues, c(0.998, 0.992, 0.967, 0.892, 0.807, 0.623, 0.493), tolerance = 1e-07) expect_equal(plotData2$likelihoodValues, c(1.003982e-05, 0.00017609247, 0.0020513476, 0.015871623, 0.081561833, 0.27837883, 0.63105765), tolerance = 1e-07) expect_equal(plotData2$main, "Conditional Power with Likelihood") expect_equal(plotData2$xlab, "pi1") expect_equal(plotData2$ylab, "Conditional power / Likelihood") expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.8, allocation ratio = 0.5") }) test_that("'getAnalysisResults' produces the correct exact tests and final CIs ", { .skipTestIfDisabled() dataExample8 <- getDataset( n2 = c(31, 72), n1 = c(30, 69), events2 = c(8, 54), events1 = c(6, 45) ) design10 <- getDesignGroupSequential(kMax = 2, alpha = 0.025, typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.3, 1)) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} # @refFS[Formula]{fs:orderingPValueUpper} # @refFS[Formula]{fs:finalCITwoRates} # @refFS[Formula]{fs:medianUnbiasedEstimate} x1 <- getAnalysisResults(design10, dataExample8, thetaH0 = 0, stage = 2, directionUpper = FALSE, normalApproximation = FALSE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results expect_equal(x1$pi1, 0.51515152, tolerance = 1e-07) expect_equal(x1$pi2, 0.60194175, tolerance = 1e-07) expect_equal(x1$testActions, c("continue", "accept")) expect_equal(x1$conditionalRejectionProbabilities, c(0.013966781, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower, c(NA_real_, NA_real_)) expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.39509356, -0.22101239), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.29306133, 0.050448659), tolerance = 1e-07) expect_equal(x1$repeatedPValues, c(0.49999905, 0.15271161), tolerance = 1e-07) expect_equal(x1$finalStage, 2) expect_equal(x1$finalPValues, c(NA_real_, 0.13570939), tolerance = 1e-07) expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.21309581), tolerance = 1e-07) expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.059922132), tolerance = 1e-07) expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, -0.076600295), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-05) expect_equal(x1CodeBased$pi2, x1$pi2, tolerance = 1e-05) expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-05) expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design11 <- getDesignInverseNormal(kMax = 2, alpha = 0.025, typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.3, 1)) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} # @refFS[Formula]{fs:testStatisticNormalCombinationTest} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} x2 <- getAnalysisResults(design11, dataExample8, thetaH0 = 0, stage = 2, directionUpper = FALSE, normalApproximation = FALSE) ## Comparison of the results of AnalysisResultsInverseNormal object 'x2' with expected results expect_equal(x2$pi1, 0.51515152, tolerance = 1e-07) expect_equal(x2$pi2, 0.60194175, tolerance = 1e-07) expect_equal(x2$testActions, c("continue", "accept")) expect_equal(x2$conditionalRejectionProbabilities, c(0.013966781, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower, c(NA_real_, NA_real_)) expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.39509356, -0.20744996), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.29306133, 0.038390611), tolerance = 1e-07) expect_equal(x2$repeatedPValues, c(0.49999905, 0.171251), tolerance = 1e-07) expect_equal(x2$finalStage, 2) expect_equal(x2$finalPValues, c(NA_real_, 0.15026298), tolerance = 1e-07) expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.20860056), tolerance = 1e-07) expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.064410651), tolerance = 1e-07) expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, -0.072106168), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-05) expect_equal(x2CodeBased$pi2, x2$pi2, tolerance = 1e-05) expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-05) expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design12 <- getDesignFisher(kMax = 2, alpha = 0.025, method = "fullAlpha", informationRates = c(0.3, 1)) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} # @refFS[Formula]{fs:testStatisticFisherCombinationTest} # @refFS[Formula]{fs:definitionRCIFisherCombination} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:conditionalRejectionFisherInterim} # @refFS[Formula]{fs:conditionalRejectionFisherLastInterim} # @refFS[Formula]{fs:conditionalRejectionFisherweights} # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} x3 <- getAnalysisResults(design12, dataExample8, thetaH0 = 0, stage = 2, directionUpper = FALSE, normalApproximation = FALSE, seed = 123) ## Comparison of the results of AnalysisResultsFisher object 'x3' with expected results expect_equal(x3$pi1, 0.51515152, tolerance = 1e-07) expect_equal(x3$pi2, 0.60194175, tolerance = 1e-07) expect_equal(x3$testActions, c("continue", "accept")) expect_equal(x3$conditionalRejectionProbabilities, c(0.016431334, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalPower, c(NA_real_, NA_real_)) expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(-0.39357809, -0.2198965), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.29140184, 0.047490149), tolerance = 1e-07) expect_equal(x3$repeatedPValues, c(0.49999905, 0.18563047), tolerance = 1e-07) expect_equal(x3$finalStage, 2) expect_equal(x3$finalPValues, c(NA_real_, 0.18562957), tolerance = 1e-07) expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_)) expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_)) expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$pi1, x3$pi1, tolerance = 1e-05) expect_equal(x3CodeBased$pi2, x3$pi2, tolerance = 1e-05) expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-05) expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults' produces the correct non-inferiority results for a group sequential design", { .skipTestIfDisabled() design13 <- getDesignGroupSequential(kMax = 2, alpha = 0.025, typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.3, 1)) dataExample9 <- getDataset( n1 = c(29, 70), n2 = c(31, 71), events1 = c(8, 54), events2 = c(6, 45) ) # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} x1 <- getAnalysisResults(design13, dataExample9, thetaH0 = -0.1, stage = 2, directionUpper = TRUE, normalApproximation = TRUE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results expect_equal(x1$pi1, 0.62626263, tolerance = 1e-07) expect_equal(x1$pi2, 0.5, tolerance = 1e-07) expect_equal(x1$testActions, c("continue", "reject")) expect_equal(x1$conditionalRejectionProbabilities, c(0.1027905, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower, c(NA_real_, NA_real_)) expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.26992433, -0.011398061), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.42527258, 0.25916403), tolerance = 1e-07) expect_equal(x1$repeatedPValues, c(0.17488831, 0.00058560119), tolerance = 1e-07) expect_equal(x1$finalStage, 2) expect_equal(x1$finalPValues, c(NA_real_, 0.0012732763), tolerance = 1e-07) expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.016122347), tolerance = 1e-07) expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.26034096), tolerance = 1e-07) expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, 0.12355576), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-05) expect_equal(x1CodeBased$pi2, x1$pi2, tolerance = 1e-05) expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-05) expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} x2 <- getAnalysisResults(design13, dataExample9, thetaH0 = -0.1, stage = 1, nPlanned = 40, pi1 = 0.45, pi2 = 0.4, directionUpper = TRUE, normalApproximation = TRUE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results expect_equal(x2$testActions, c("continue", NA_character_)) expect_equal(x2$conditionalRejectionProbabilities, c(0.1027905, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower, c(NA_real_, 0.38169554), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.26992433, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.42527258, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues, c(0.17488831, NA_real_), tolerance = 1e-07) expect_equal(x2$finalStage, NA_integer_) expect_equal(x2$finalPValues, c(NA_real_, NA_real_)) expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_)) expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_)) expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-05) expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } plotData1 <- testGetAnalysisResultsPlotData(x2, piTreatmentRange = seq(0.25, 0.7, 0.05)) ## Comparison of the results of list object 'plotData1' with expected results expect_equal(plotData1$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7), tolerance = 1e-07) expect_equal(plotData1$condPowerValues, c(0.053165998, 0.1027905, 0.17500031, 0.26934912, 0.38169554, 0.50456648, 0.62825352, 0.74249459, 0.83846571, 0.91065807), tolerance = 1e-07) expect_equal(plotData1$likelihoodValues, c(0.95261056, 0.95859015, 0.67101367, 0.32674624, 0.11068039, 0.026080239, 0.0042749722, 0.00048745649, 3.866511e-05, 2.1334549e-06), tolerance = 1e-07) expect_equal(plotData1$main, "Conditional Power with Likelihood") expect_equal(plotData1$xlab, "pi1") expect_equal(plotData1$ylab, "Conditional power / Likelihood") expect_equal(plotData1$sub, "Stage = 1, # of remaining subjects = 40, pi2 = 0.4, allocation ratio = 1") # non-inferiority, reversed "directionUpper" # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} x3 <- getAnalysisResults(design13, dataExample9, thetaH0 = 0.1, stage = 2, directionUpper = FALSE, normalApproximation = TRUE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x3' with expected results expect_equal(x3$pi1, 0.62626263, tolerance = 1e-07) expect_equal(x3$pi2, 0.5, tolerance = 1e-07) expect_equal(x3$testActions, c("continue", "accept")) expect_equal(x3$conditionalRejectionProbabilities, c(0.012395218, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalPower, c(NA_real_, NA_real_)) expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(-0.26992433, -0.011398061), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.42527258, 0.25916403), tolerance = 1e-07) expect_equal(x3$repeatedPValues, c(0.49999905, 0.49999905), tolerance = 1e-07) expect_equal(x3$finalStage, 2) expect_equal(x3$finalPValues, c(NA_real_, 0.64703032), tolerance = 1e-07) expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.0098227441), tolerance = 1e-07) expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.26218829), tolerance = 1e-07) expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, 0.12618258), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$pi1, x3$pi1, tolerance = 1e-05) expect_equal(x3CodeBased$pi2, x3$pi2, tolerance = 1e-05) expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-05) expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} # @refFS[Formula]{fs:testStatisticGroupSequential} # @refFS[Formula]{fs:definitionRCIInverseNormal} # @refFS[Formula]{fs:calculationRepeatedpValue} # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} x4 <- getAnalysisResults(design13, dataExample9, thetaH0 = 0.1, stage = 1, nPlanned = 40, pi1 = 0.4, pi2 = 0.45, directionUpper = FALSE, normalApproximation = TRUE) ## Comparison of the results of AnalysisResultsGroupSequential object 'x4' with expected results expect_equal(x4$testActions, c("continue", NA_character_)) expect_equal(x4$conditionalRejectionProbabilities, c(0.012395218, NA_real_), tolerance = 1e-07) expect_equal(x4$conditionalPower, c(NA_real_, 0.10084143), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(-0.26992433, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.42527258, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedPValues, c(0.49999905, NA_real_), tolerance = 1e-07) expect_equal(x4$finalStage, NA_integer_) expect_equal(x4$finalPValues, c(NA_real_, NA_real_)) expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_)) expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_)) expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, NA_real_)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-05) expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-05) expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-05) expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults' with a dataset of rates and without defining a design", { .skipTestIfDisabled() data <- getDataset( n1 = c(10), n2 = c(15), events1 = c(8), events2 = c(6) ) # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} analysisResults1 <- getAnalysisResults(data, alpha = 0.02) ## Comparison of the results of AnalysisResultsInverseNormal object 'analysisResults1' with expected results expect_equal(analysisResults1$pi1, 0.8, tolerance = 1e-07) expect_equal(analysisResults1$pi2, 0.4, tolerance = 1e-07) expect_equal(analysisResults1$testActions, "accept") expect_equal(analysisResults1$repeatedConfidenceIntervalLowerBounds, -0.016534105, tolerance = 1e-07) expect_equal(analysisResults1$repeatedConfidenceIntervalUpperBounds, 0.68698807, tolerance = 1e-07) expect_equal(analysisResults1$repeatedPValues, 0.024199112, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(analysisResults1), NA))) expect_output(print(analysisResults1)$show()) invisible(capture.output(expect_error(summary(analysisResults1), NA))) expect_output(summary(analysisResults1)$show()) analysisResults1CodeBased <- eval(parse(text = getObjectRCode(analysisResults1, stringWrapParagraphWidth = NULL))) expect_equal(analysisResults1CodeBased$pi1, analysisResults1$pi1, tolerance = 1e-05) expect_equal(analysisResults1CodeBased$pi2, analysisResults1$pi2, tolerance = 1e-05) expect_equal(analysisResults1CodeBased$testActions, analysisResults1$testActions, tolerance = 1e-05) expect_equal(analysisResults1CodeBased$repeatedConfidenceIntervalLowerBounds, analysisResults1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(analysisResults1CodeBased$repeatedConfidenceIntervalUpperBounds, analysisResults1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(analysisResults1CodeBased$repeatedPValues, analysisResults1$repeatedPValues, tolerance = 1e-05) expect_type(names(analysisResults1), "character") df <- as.data.frame(analysisResults1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(analysisResults1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults' produces the correct critical values for a boundary recalculation at the last stage", { .skipTestIfDisabled() data1 <- getDataset(overallN = c(22, 33, 45), overallEvents = c(11, 18, 28)) data2 <- getDataset(overallN = c(22, 33, 40), overallEvents = c(11, 18, 23)) data3 <- getDataset(overallN = c(22, 33, 38), overallEvents = c(11, 18, 21)) design <- getDesignGroupSequential( typeOfDesign = "asP") expect_warning(result1 <- getAnalysisResults(design, data1, thetaH0 = 0.5, maxInformation = 40)) result2 <- getAnalysisResults(design, data2, thetaH0 = 0.5, maxInformation = 40) expect_warning(result3 <- getAnalysisResults(design, data3, thetaH0 = 0.5, maxInformation = 40, informationEpsilon = 2)) expect_equal(result1$.design$criticalValues[1:2], result2$.design$criticalValues[1:2], tolerance = 1e-07) expect_equal(result1$.design$criticalValues[1:2], result3$.design$criticalValues[1:2], tolerance = 1e-07) expect_equal(result2$.design$criticalValues[1:2], result3$.design$criticalValues[1:2], tolerance = 1e-07) }) rpact/tests/testthat/test-f_design_utilities.R0000644000175000017500000003766614154142422021511 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_design_utilities.R ## | Creation date: 08 December 2021, 09:09:22 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Design Utility Functions") test_that("'getPiByLambda' and 'getLambdaByPi' produce corresponding results", { expect_equal(getLambdaByPi(getPiByLambda(0.01, eventTime = 1, kappa = 1), eventTime = 1, kappa = 1), 0.01, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.03, eventTime = 1, kappa = 1), eventTime = 1, kappa = 1), 0.03, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.05, eventTime = 1, kappa = 1), eventTime = 1, kappa = 1), 0.05, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.07, eventTime = 1, kappa = 1), eventTime = 1, kappa = 1), 0.07, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.09, eventTime = 1, kappa = 1), eventTime = 1, kappa = 1), 0.09, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.01, eventTime = 1, kappa = 3), eventTime = 1, kappa = 3), 0.01, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.03, eventTime = 1, kappa = 3), eventTime = 1, kappa = 3), 0.03, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.05, eventTime = 1, kappa = 3), eventTime = 1, kappa = 3), 0.05, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.07, eventTime = 1, kappa = 3), eventTime = 1, kappa = 3), 0.07, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.09, eventTime = 1, kappa = 3), eventTime = 1, kappa = 3), 0.09, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.01, eventTime = 1, kappa = 5), eventTime = 1, kappa = 5), 0.01, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.03, eventTime = 1, kappa = 5), eventTime = 1, kappa = 5), 0.03, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.05, eventTime = 1, kappa = 5), eventTime = 1, kappa = 5), 0.05, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.07, eventTime = 1, kappa = 5), eventTime = 1, kappa = 5), 0.07, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.09, eventTime = 1, kappa = 5), eventTime = 1, kappa = 5), 0.09, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.01, eventTime = 6, kappa = 1), eventTime = 6, kappa = 1), 0.01, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.03, eventTime = 6, kappa = 1), eventTime = 6, kappa = 1), 0.03, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.05, eventTime = 6, kappa = 1), eventTime = 6, kappa = 1), 0.05, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.07, eventTime = 6, kappa = 1), eventTime = 6, kappa = 1), 0.07, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.09, eventTime = 6, kappa = 1), eventTime = 6, kappa = 1), 0.09, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.01, eventTime = 6, kappa = 3), eventTime = 6, kappa = 3), 0.01, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.03, eventTime = 6, kappa = 3), eventTime = 6, kappa = 3), 0.03, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.05, eventTime = 6, kappa = 3), eventTime = 6, kappa = 3), 0.05, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.07, eventTime = 6, kappa = 3), eventTime = 6, kappa = 3), 0.07, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.09, eventTime = 6, kappa = 3), eventTime = 6, kappa = 3), 0.09, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.01, eventTime = 6, kappa = 5), eventTime = 6, kappa = 5), 0.01, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.03, eventTime = 6, kappa = 5), eventTime = 6, kappa = 5), 0.03, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.05, eventTime = 6, kappa = 5), eventTime = 6, kappa = 5), 0.05, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.07, eventTime = 6, kappa = 5), eventTime = 6, kappa = 5), 0.07, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.09, eventTime = 6, kappa = 5), eventTime = 6, kappa = 5), 0.09, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.01, eventTime = 11, kappa = 1), eventTime = 11, kappa = 1), 0.01, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.03, eventTime = 11, kappa = 1), eventTime = 11, kappa = 1), 0.03, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.05, eventTime = 11, kappa = 1), eventTime = 11, kappa = 1), 0.05, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.07, eventTime = 11, kappa = 1), eventTime = 11, kappa = 1), 0.07, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.09, eventTime = 11, kappa = 1), eventTime = 11, kappa = 1), 0.09, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.01, eventTime = 11, kappa = 3), eventTime = 11, kappa = 3), 0.01, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.03, eventTime = 11, kappa = 3), eventTime = 11, kappa = 3), 0.03, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.05, eventTime = 11, kappa = 3), eventTime = 11, kappa = 3), 0.05, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.07, eventTime = 11, kappa = 3), eventTime = 11, kappa = 3), 0.07, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.09, eventTime = 11, kappa = 3), eventTime = 11, kappa = 3), 0.09, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.01, eventTime = 11, kappa = 5), eventTime = 11, kappa = 5), 0.01, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.03, eventTime = 11, kappa = 5), eventTime = 11, kappa = 5), 0.03, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.05, eventTime = 11, kappa = 5), eventTime = 11, kappa = 5), 0.05, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.07, eventTime = 11, kappa = 5), eventTime = 11, kappa = 5), 0.07, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.09, eventTime = 11, kappa = 5), eventTime = 11, kappa = 5), 0.09, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.01, eventTime = 16, kappa = 1), eventTime = 16, kappa = 1), 0.01, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.03, eventTime = 16, kappa = 1), eventTime = 16, kappa = 1), 0.03, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.05, eventTime = 16, kappa = 1), eventTime = 16, kappa = 1), 0.05, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.07, eventTime = 16, kappa = 1), eventTime = 16, kappa = 1), 0.07, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.09, eventTime = 16, kappa = 1), eventTime = 16, kappa = 1), 0.09, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.01, eventTime = 16, kappa = 3), eventTime = 16, kappa = 3), 0.01, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.03, eventTime = 16, kappa = 3), eventTime = 16, kappa = 3), 0.03, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.05, eventTime = 16, kappa = 3), eventTime = 16, kappa = 3), 0.05, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.07, eventTime = 16, kappa = 3), eventTime = 16, kappa = 3), 0.07, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.09, eventTime = 16, kappa = 3), eventTime = 16, kappa = 3), 0.09, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.01, eventTime = 16, kappa = 5), eventTime = 16, kappa = 5), 0.01, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.03, eventTime = 16, kappa = 5), eventTime = 16, kappa = 5), 0.03, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.05, eventTime = 16, kappa = 5), eventTime = 16, kappa = 5), 0.05, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.07, eventTime = 16, kappa = 5), eventTime = 16, kappa = 5), 0.07, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.09, eventTime = 16, kappa = 5), eventTime = 16, kappa = 5), 0.09, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.01, eventTime = 21, kappa = 1), eventTime = 21, kappa = 1), 0.01, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.03, eventTime = 21, kappa = 1), eventTime = 21, kappa = 1), 0.03, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.05, eventTime = 21, kappa = 1), eventTime = 21, kappa = 1), 0.05, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.07, eventTime = 21, kappa = 1), eventTime = 21, kappa = 1), 0.07, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.09, eventTime = 21, kappa = 1), eventTime = 21, kappa = 1), 0.09, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.01, eventTime = 21, kappa = 3), eventTime = 21, kappa = 3), 0.01, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.03, eventTime = 21, kappa = 3), eventTime = 21, kappa = 3), 0.03, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.05, eventTime = 21, kappa = 3), eventTime = 21, kappa = 3), 0.05, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.07, eventTime = 21, kappa = 3), eventTime = 21, kappa = 3), 0.07, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.09, eventTime = 21, kappa = 3), eventTime = 21, kappa = 3), 0.09, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.01, eventTime = 21, kappa = 5), eventTime = 21, kappa = 5), 0.01, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.03, eventTime = 21, kappa = 5), eventTime = 21, kappa = 5), 0.03, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.05, eventTime = 21, kappa = 5), eventTime = 21, kappa = 5), 0.05, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.07, eventTime = 21, kappa = 5), eventTime = 21, kappa = 5), 0.07, tolerance = 1e-04) expect_equal(getLambdaByPi(getPiByLambda(0.09, eventTime = 21, kappa = 5), eventTime = 21, kappa = 5), 0.09, tolerance = 1e-04) }) test_that("'getPiecewiseExponentialDistribution' and 'getPiecewiseExponentialQuantile' produce corresponding results", { # @refFS[Formula]{fs:pieceWiseExponentialSurvival} piecewiseLambda <- c(0.03, 0.05, 0.08) piecewiseSurvivalTime <- c(0, 16, 22) time <- seq(2, 50, 4) quantile <- getPiecewiseExponentialDistribution(time, piecewiseSurvivalTime = piecewiseSurvivalTime, piecewiseLambda = piecewiseLambda) y <- getPiecewiseExponentialQuantile(quantile, piecewiseSurvivalTime = piecewiseSurvivalTime, piecewiseLambda = piecewiseLambda) expect_equal(y, time, tolerance = 1e-06) }) test_that("'ppwexp' and 'qpwexp' produce corresponding results", { # @refFS[Formula]{fs:pieceWiseExponentialSurvival} piecewiseLambda <- c(0.03, 0.05, 0.08) piecewiseSurvivalTime <- c(0, 16, 22) time <- seq(2, 50, 4) quantile <- ppwexp(time, s = piecewiseSurvivalTime, lambda = piecewiseLambda) y <- qpwexp(quantile, s = piecewiseSurvivalTime, lambda = piecewiseLambda) expect_equal(y, time, tolerance = 1e-06) }) test_that("'getPiecewiseExponentialDistribution' and 'getPiecewiseExponentialQuantile' produce corresponding results ('piecewiseSurvivalTime' defined as list)", { # @refFS[Formula]{fs:pieceWiseExponentialSurvival} piecewiseSurvivalTime <- list( "<16" = 0.03, "16 - <22" = 0.05, ">=22" = 0.08) time <- seq(2, 50, 4) quantile <- getPiecewiseExponentialDistribution(time, piecewiseSurvivalTime = piecewiseSurvivalTime) y <- getPiecewiseExponentialQuantile(quantile, piecewiseSurvivalTime = piecewiseSurvivalTime) expect_equal(y, time, tolerance = 1e-06) }) test_that("'ppwexp' and 'qpwexp' produce corresponding results ('piecewiseSurvivalTime' defined as list)", { # @refFS[Formula]{fs:pieceWiseExponentialSurvival} piecewiseSurvivalTime <- list( "<16" = 0.03, "16 - <22" = 0.05, ">=22" = 0.08) time <- seq(2, 50, 4) quantile <- ppwexp(time, s = piecewiseSurvivalTime) y <- qpwexp(quantile, s = piecewiseSurvivalTime) expect_equal(y, time, tolerance = 1e-06) }) test_that("'getPiecewiseExponentialRandomNumbers': test that mean random numbers are as expected", { # @refFS[Formula]{fs:pieceWiseExponentialSurvival} set.seed(12345) piecewiseSurvivalTime <- c(0, 16, 22) piecewiseLambda <- c(0.003, 0.003, 0.003) y <- 1 / mean(getPiecewiseExponentialRandomNumbers(5000, piecewiseSurvivalTime = piecewiseSurvivalTime, piecewiseLambda = piecewiseLambda, kappa = 1)) expect_equal(y, piecewiseLambda[1], tolerance = 5e-04) }) test_that("'rpwexp': test that mean random numbers are as expected", { # @refFS[Formula]{fs:pieceWiseExponentialSurvival} set.seed(12345) piecewiseSurvivalTime <- c(0, 16, 22) piecewiseLambda <- c(0.003, 0.003, 0.003) y <- 1 / mean(rpwexp(5000, s = piecewiseSurvivalTime, lambda = piecewiseLambda, kappa = 1)) expect_equal(y, piecewiseLambda[1], tolerance = 5e-04) }) test_that("'getPiecewiseExponentialRandomNumbers': test that mean random numbers are as expected ('piecewiseSurvivalTime' defined as list)", { # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} set.seed(12345) piecewiseSurvivalTime <- list( "<16" = 0.003, "16 - <22" = 0.003, ">=22" = 0.003) y <- 1 / mean(getPiecewiseExponentialRandomNumbers(5000, piecewiseSurvivalTime = piecewiseSurvivalTime, kappa = 1)) expect_equal(y, 0.003, tolerance = 5e-04) }) test_that("'rpwexp': test that mean random numbers are as expected ('piecewiseSurvivalTime' defined as list)", { # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} set.seed(12345) piecewiseSurvivalTime <- list( "<16" = 0.003, "16 - <22" = 0.003, ">=22" = 0.003) y <- 1 / mean(rpwexp(5000, s = piecewiseSurvivalTime, kappa = 1)) expect_equal(y, 0.003, tolerance = 5e-04) }) test_that("'getPiecewiseExponentialDistribution': test that function call with singel lambda is working", { expect_equal(getPiecewiseExponentialDistribution(4, piecewiseLambda = 0.003), 0.01192829, tolerance = 5e-05) }) test_that("'.convertStageWiseToOverallValues': test that function is working as expected", { x1 <- .convertStageWiseToOverallValues(c(1:5)) ## Comparison of the results of matrixarray object 'x1' with expected results expect_equal(x1[1, ], 1) expect_equal(x1[2, ], 3) expect_equal(x1[3, ], 6) expect_equal(x1[4, ], 10) expect_equal(x1[5, ], 15) x2 <- .convertStageWiseToOverallValues(matrix(c(1:5), ncol = 1)) ## Comparison of the results of matrixarray object 'x2' with expected results expect_equal(x2[1, ], 1) expect_equal(x2[2, ], 3) expect_equal(x2[3, ], 6) expect_equal(x2[4, ], 10) expect_equal(x2[5, ], 15) x3 <- .convertStageWiseToOverallValues(matrix(c(1:5), nrow = 1)) ## Comparison of the results of matrixarray object 'x3' with expected results expect_equal(x3[1, ], c(1, 2, 3, 4, 5)) x4 <- .convertStageWiseToOverallValues(matrix(c(1:5, 1:5), ncol = 2)) ## Comparison of the results of matrixarray object 'x4' with expected results expect_equal(x4[1, ], c(1, 1)) expect_equal(x4[2, ], c(3, 3)) expect_equal(x4[3, ], c(6, 6)) expect_equal(x4[4, ], c(10, 10)) expect_equal(x4[5, ], c(15, 15)) x5 <- .convertStageWiseToOverallValues(matrix(sort(rep(1:5, 2)), nrow = 2)) ## Comparison of the results of matrixarray object 'x5' with expected results expect_equal(x5[1, ], c(1, 2, 3, 4, 5)) expect_equal(x5[2, ], c(2, 4, 6, 8, 10)) }) rpact/tests/testthat/test-f_design_sample_size_calculator.R0000644000175000017500000241656414154142422024222 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_design_sample_size_calculator.R ## | Creation date: 08 December 2021, 09:09:00 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing the Sample Size Calculation of Testing Means for Different Designs and Arguments") test_that("'getSampleSizeMeans': Sample size calculation of testing means for one sided group sequential design", { # @refFS[Formula]{fs:criticalValuesWangTiatis} # @refFS[Formula]{fs:inflationFactor} # @refFS[Formula]{fs:expectedReduction} designGS1pretest <- getDesignGroupSequential(informationRates = c(0.2,0.5,1), sided = 1, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) ## Comparison of the results of TrialDesignGroupSequential object 'designGS1pretest' with expected results expect_equal(designGS1pretest$alphaSpent, c(0.0020595603, 0.0098772988, 0.02499999), tolerance = 1e-07) expect_equal(designGS1pretest$criticalValues, c(2.8688923, 2.3885055, 2.0793148), tolerance = 1e-07) expect_equal(designGS1pretest$stageLevels, c(0.0020595603, 0.0084585282, 0.018794214), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(designGS1pretest), NA))) expect_output(print(designGS1pretest)$show()) invisible(capture.output(expect_error(summary(designGS1pretest), NA))) expect_output(summary(designGS1pretest)$show()) designGS1pretestCodeBased <- eval(parse(text = getObjectRCode(designGS1pretest, stringWrapParagraphWidth = NULL))) expect_equal(designGS1pretestCodeBased$alphaSpent, designGS1pretest$alphaSpent, tolerance = 1e-05) expect_equal(designGS1pretestCodeBased$criticalValues, designGS1pretest$criticalValues, tolerance = 1e-05) expect_equal(designGS1pretestCodeBased$stageLevels, designGS1pretest$stageLevels, tolerance = 1e-05) expect_type(names(designGS1pretest), "character") df <- as.data.frame(designGS1pretest) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(designGS1pretest) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } designGS1 <- getDesignGroupSequential(informationRates = c(0.2,0.5,1), sided = 1, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeOneMeanVarianceUnknownOnesided} # @refFS[Formula]{fs:sampleSizePerStageOneMean} sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 1, thetaH0 = 0.5, stDev = 2, normalApproximation = FALSE, alternative = 0.8) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 494.6455, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 98.929099, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 247.32275, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 494.6455, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 491.89699, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 462.87248, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 360.24062, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 1.090771, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 0.80583608, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 0.68748891, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeOneMeanVarianceKnownOnesided} # @refFS[Formula]{fs:sampleSizePerStageOneMean} sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 1, thetaH0 = 0.5, stDev = 2, normalApproximation = TRUE, alternative = 0.8) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 492.61495, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 98.522991, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 246.30748, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 492.61495, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 489.87773, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 460.97237, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 358.76182, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 1.0780634, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 0.80438093, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 0.68736844, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansDiffVarianceUnknownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 2, thetaH0 = 0, stDev = 2, normalApproximation = FALSE, alternative = 1.3, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 107.00299, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 53.501497, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 53.501497, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 21.400599, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 53.501497, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 107.00299, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 106.40843, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 100.12977, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 77.928183, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 2.8110917, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 1.3500437, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 0.81436669, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansDiffVarianceKnownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 2, thetaH0 = 0, stDev = 2, normalApproximation = TRUE, alternative = 1.3, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 104.93573, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 52.467865, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 52.467865, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 20.987146, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 52.467865, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 104.93573, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 104.35265, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 98.195298, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 76.422636, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 2.5049412, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 1.318984, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 0.81192991, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansDiffVarianceUnknownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 2, thetaH0 = 0, stDev = 2, normalApproximation = FALSE, alternative = 1.3, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 141.97133, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 106.4785, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 35.492832, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 28.394266, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 70.985664, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 141.97133, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 21.295699, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 53.239248, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 106.4785, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 7.0985664, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 17.746416, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 35.492832, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 141.18246, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 132.85195, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 103.39494, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 2.7228801, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 1.3419598, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 0.81376184, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansDiffVarianceKnownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 2, thetaH0 = 0, stDev = 2, normalApproximation = TRUE, alternative = 1.3, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 139.91431, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 104.93573, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 34.978577, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 27.982861, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 69.957153, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 139.91431, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 20.987146, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 52.467865, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 104.93573, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 6.9957153, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 17.489288, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 34.978577, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 139.13687, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 130.92706, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 101.89685, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 2.5049412, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 1.318984, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 0.81192991, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansDiffVarianceUnknownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 2, thetaH0 = 0.5, stDev = 2, normalApproximation = FALSE, alternative = 2.1, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 71.36231, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 35.681155, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 35.681155, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 14.272462, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 35.681155, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 71.36231, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 70.965784, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 66.77843, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 51.971772, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.222748, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.1829515, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.5038177, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansDiffVarianceKnownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 2, thetaH0 = 0.5, stDev = 2, normalApproximation = TRUE, alternative = 2.1, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 69.273978, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 34.636989, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 34.636989, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 13.854796, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 34.636989, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 69.273978, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 68.889056, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 64.824239, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 50.450881, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 3.5830046, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.123365, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.4992983, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansDiffVarianceUnknownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 2, thetaH0 = 0.5, stDev = 2, normalApproximation = FALSE, alternative = 2.1, allocationRatioPlanned = 0.4) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 86.937573, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 24.839307, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 62.098267, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 17.387515, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 43.468787, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 86.937573, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 4.9678613, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 12.419653, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 24.839307, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 12.419653, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 31.049133, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 62.098267, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 86.454503, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 81.353233, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 63.314931, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.0734522, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.1712593, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.5029983, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansDiffVarianceKnownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 2, thetaH0 = 0.5, stDev = 2, normalApproximation = TRUE, alternative = 2.1, allocationRatioPlanned = 0.4) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 84.860623, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 24.245892, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 60.614731, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 16.972125, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 42.430311, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 84.860623, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 4.8491785, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 12.122946, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 24.245892, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 12.122946, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 30.307365, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 60.614731, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 84.389093, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 79.409693, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 61.802329, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 3.5830046, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.123365, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.4992983, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansRatioVarianceUnknownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 2, meanRatio = TRUE, thetaH0 = 0.9, stDev = 3, normalApproximation = FALSE, alternative = 1.9, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 363.14949, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 181.57474, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 181.57474, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 72.629897, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 181.57474, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 363.14949, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 361.13164, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 339.82298, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 264.47466, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 2.8861856, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 1.9212807, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.5251098, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansRatioVarianceKnownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 2, meanRatio = TRUE, thetaH0 = 0.9, stDev = 3, normalApproximation = TRUE, alternative = 1.9, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 361.11139, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 180.5557, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 180.5557, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 72.222278, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 180.5557, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 361.11139, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 359.10487, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 337.9158, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 262.99035, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 2.8268779, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 1.9146031, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.5245615, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansRatioVarianceUnknownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 2, meanRatio = TRUE, thetaH0 = 0.9, stDev = 3, normalApproximation = FALSE, alternative = 1.9, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 458.2463, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 343.68473, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 114.56158, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 91.64926, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 229.12315, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 458.2463, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 68.736945, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 171.84236, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 343.68473, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 22.912315, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 57.280788, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 114.56158, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 455.70005, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 428.81135, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 333.7318, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 2.8732837, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 1.9198713, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.5249957, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansRatioVarianceKnownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 2, meanRatio = TRUE, thetaH0 = 0.9, stDev = 3, normalApproximation = TRUE, alternative = 1.9, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 456.21071, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 342.15803, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 114.05268, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 91.242142, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 228.10535, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 456.21071, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 68.431606, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 171.07902, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 342.15803, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 22.810535, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 57.026339, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 114.05268, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 453.67577, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 426.90651, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 332.24932, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 2.8268779, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 1.9146031, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.5245615, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansRatioVarianceKnownOnesided} # @refFS[Formula]{fs:sampleSizeRatioMeansOptimumAllocationRatio} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 2, meanRatio = TRUE, thetaH0 = 0.9, stDev = 3, normalApproximation = TRUE, alternative = 1.9, allocationRatioPlanned = 0) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$allocationRatioPlanned, 1.1111111, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 360.11385, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 189.5336, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 170.58024, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 72.022769, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 180.05692, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 360.11385, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 37.906721, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 94.766802, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 189.5336, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 34.116049, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 85.290122, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 170.58024, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 358.11287, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 336.98233, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 262.26386, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 2.8268779, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 1.9146031, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.5245615, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$allocationRatioPlanned, sampleSizeResult$allocationRatioPlanned, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeMeans': Sample size calculation of testing means for two sided group sequential design", { # @refFS[Formula]{fs:criticalValuesWangTiatis} # @refFS[Formula]{fs:inflationFactor} # @refFS[Formula]{fs:expectedReduction} designGS2pretest <- getDesignGroupSequential(informationRates = c(0.2,0.5,1), alpha = 0.4, sided = 2, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) ## Comparison of the results of TrialDesignGroupSequential object 'designGS2pretest' with expected results expect_equal(designGS2pretest$alphaSpent, c(0.12265406, 0.26238998, 0.39999999), tolerance = 1e-07) expect_equal(designGS2pretest$criticalValues, c(1.5437287, 1.2852363, 1.1188632), tolerance = 1e-07) expect_equal(designGS2pretest$stageLevels, c(0.06132703, 0.099354859, 0.13159925), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(designGS2pretest), NA))) expect_output(print(designGS2pretest)$show()) invisible(capture.output(expect_error(summary(designGS2pretest), NA))) expect_output(summary(designGS2pretest)$show()) designGS2pretestCodeBased <- eval(parse(text = getObjectRCode(designGS2pretest, stringWrapParagraphWidth = NULL))) expect_equal(designGS2pretestCodeBased$alphaSpent, designGS2pretest$alphaSpent, tolerance = 1e-05) expect_equal(designGS2pretestCodeBased$criticalValues, designGS2pretest$criticalValues, tolerance = 1e-05) expect_equal(designGS2pretestCodeBased$stageLevels, designGS2pretest$stageLevels, tolerance = 1e-05) expect_type(names(designGS2pretest), "character") df <- as.data.frame(designGS2pretest) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(designGS2pretest) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } designGS2 <- getDesignGroupSequential(informationRates = c(0.2,0.5,1), alpha = 0.4, sided = 2, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeOneMeanVarianceUnknownOnesided} # @refFS[Formula]{fs:sampleSizePerStageOneMean} sampleSizeResult <- getSampleSizeMeans(designGS2, groups = 1, thetaH0 = 0.5, stDev = 2, normalApproximation = FALSE, alternative = 0.8) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.30276671, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.3601177, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.23711559, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.66288441, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 234.92433, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 46.984866, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 117.46217, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 234.92433, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 195.45911, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 176.81177, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 134.60888, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.041134725, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.26146972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.3536511, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 0.95886527, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 0.73853028, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 0.6463489, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.12265406, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.19870972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.26319851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeOneMeanVarianceKnownOnesided} # @refFS[Formula]{fs:sampleSizePerStageOneMean} sampleSizeResult <- getSampleSizeMeans(designGS2, groups = 1, thetaH0 = 0.5, stDev = 2, normalApproximation = TRUE, alternative = 0.8) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.30276671, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.3601177, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.23711559, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.66288441, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 234.50706, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 46.901412, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 117.25353, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 234.50706, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 195.11194, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 176.49772, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 134.36979, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.049174965, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.26261678, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.35387349, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 0.95082503, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 0.73738322, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 0.64612651, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.12265406, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.19870972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.26319851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansDiffVarianceUnknownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS2, groups = 2, thetaH0 = 0, stDev = 2, normalApproximation = FALSE, alternative = 1.3, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.30276671, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.3601177, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.23711559, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.66288441, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 50.39219, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 25.196095, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 25.196095, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 10.078438, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 25.196095, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 50.39219, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 41.926745, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 37.926818, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 28.874132, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], -2.1720469, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], -1.0543228, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], -0.63787834, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 2.1720469, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.0543228, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 0.63787834, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.12265406, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.19870972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.26319851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansDiffVarianceKnownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS2, groups = 2, thetaH0 = 0, stDev = 2, normalApproximation = TRUE, alternative = 1.3, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.30276671, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.3601177, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.23711559, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.66288441, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 49.954167, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 24.977083, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 24.977083, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 9.9908334, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 24.977083, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 49.954167, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 41.562306, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 37.597148, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 28.62315, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], -1.9535752, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], -1.0286606, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], -0.63321489, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 1.9535752, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.0286606, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 0.63321489, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.12265406, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.19870972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.26319851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansDiffVarianceUnknownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS2, groups = 2, thetaH0 = 0, stDev = 2, normalApproximation = FALSE, alternative = 1.3, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.30276671, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.3601177, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.23711559, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.66288441, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 67.037534, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 50.27815, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 16.759383, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 13.407507, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 33.518767, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 67.037534, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 10.05563, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 25.139075, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 50.27815, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 3.3518767, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 8.3796917, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 16.759383, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 55.775818, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 50.454651, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 38.411718, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], -2.1030977, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], -1.0473776, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], -0.63668307, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 2.1030977, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.0473776, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 0.63668307, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.12265406, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.19870972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.26319851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeMeans} # @refFS[Formula]{fs:sampleSizeTwoMeansDiffVarianceKnownOnesided} # @refFS[Formula]{fs:sampleSizePerStageTwoMeans} sampleSizeResult <- getSampleSizeMeans(designGS2, groups = 2, thetaH0 = 0, stDev = 2, normalApproximation = TRUE, alternative = 1.3, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanMeans object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.30276671, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.3601177, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.23711559, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.66288441, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 66.605556, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 49.954167, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 16.651389, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 13.321111, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 33.302778, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 66.605556, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 9.9908334, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 24.977083, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 49.954167, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 3.3302778, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 8.3256945, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 16.651389, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 55.416408, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 50.12953, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 38.164199, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], -1.9535752, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], -1.0286606, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], -0.63321489, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 1.9535752, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.0286606, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 0.63321489, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.12265406, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.19870972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.26319851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ######################################################################################################################## ######################################################################################################################## }) context("Testing the Sample Size Calculation of Testing Rates for Different Designs and Arguments") test_that("'getSampleSizeRates': Sample size calculation of testing rates for one sided group sequential design", { designGS1 <- getDesignGroupSequential(informationRates = c(0.2,0.5,1), sided = 1, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:sampleSizeOneRateExactOnesidedLargerpi1} # @refFS[Formula]{fs:sampleSizePerStageOneRate} sampleSizeResult <- getSampleSizeRates(designGS1, groups = 1, thetaH0 = 0.5, pi1 = 0.8, normalApproximation = FALSE) ## Comparison of the results of TrialDesignPlanRates object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 29.536017, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 5.9072033, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 14.768008, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 29.536017, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 29.371899, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 27.638803, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 21.510502, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 1.090192, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 0.81076728, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 0.6912997, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:sampleSizeOneRateExactOnesidedSmallerpi1} # @refFS[Formula]{fs:sampleSizePerStageOneRate} sampleSizeResult <- getSampleSizeRates(designGS1, groups = 1, thetaH0 = 0.5, pi1 = 0.2, normalApproximation = FALSE) ## Comparison of the results of TrialDesignPlanRates object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, FALSE) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 29.536017, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 5.9072033, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 14.768008, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 29.536017, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 29.371899, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 27.638803, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 21.510502, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], -0.090191958, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 0.18923272, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 0.3087003, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:sampleSizeOneRateApproximation} # @refFS[Formula]{fs:sampleSizePerStageOneRate} sampleSizeResult <- getSampleSizeRates(designGS1, groups = 1, thetaH0 = 0.5, pi1 = 0.8, normalApproximation = TRUE) ## Comparison of the results of TrialDesignPlanRates object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 26.111979, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 5.2223957, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 13.055989, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 26.111979, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 25.966887, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 24.434704, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 19.016842, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 1.127696, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 0.83051514, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 0.70345593, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:sampleSizeOneRateExactOnesidedSmallerpi1} # @refFS[Formula]{fs:sampleSizePerStageTwoRates} sampleSizeResult <- getSampleSizeRates(designGS1, groups = 2, thetaH0 = 0, pi1 = 0.5, pi2 = 0.3, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanRates object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 261.60183, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 130.80091, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 130.80091, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 52.320365, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 130.80091, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 261.60183, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 260.14823, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 244.79812, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 190.51949, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 0.39662162, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 0.20482715, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 0.12354802, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:sampleSizeTwoRatesDiff} # @refFS[Formula]{fs:sampleSizePerStageTwoRates} sampleSizeResult <- getSampleSizeRates(designGS1, groups = 2, thetaH0 = 0, pi1 = 0.5, pi2 = 0.3, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanRates object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 349.41307, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 262.0598, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 87.353268, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 69.882614, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 174.70654, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 349.41307, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 52.411961, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 131.0299, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 262.0598, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 17.470654, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 43.676634, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 87.353268, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 347.47155, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 326.9689, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 254.47069, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 0.38949339, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 0.20784714, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 0.12553463, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} # @refFS[Formula]{fs:sampleSizeTwoRatesDiff} # @refFS[Formula]{fs:sampleSizePerStageTwoRates} sampleSizeResult <- getSampleSizeRates(designGS1, groups = 2, thetaH0 = 0.2, pi1 = 0.5, pi2 = 0.1, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanRates object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 201.70565, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 100.85283, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 100.85283, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 40.341131, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 100.85283, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 201.70565, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 200.58487, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 188.74931, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 146.89828, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 0.6326463, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 0.40827798, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 0.32212934, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} # @refFS[Formula]{fs:sampleSizeTwoRatesDiff} # @refFS[Formula]{fs:sampleSizePerStageTwoRates} sampleSizeResult <- getSampleSizeRates(designGS1, groups = 2, thetaH0 = 0.2, pi1 = 0.5, pi2 = 0.1, allocationRatioPlanned = 0.4) ## Comparison of the results of TrialDesignPlanRates object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 267.48868, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 76.425337, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 191.06334, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 53.497736, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 133.74434, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 267.48868, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 15.285067, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 38.212668, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 76.425337, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 38.212668, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 95.531671, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 191.06334, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 266.00237, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 250.30683, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 194.80676, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 0.59822838, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 0.40051537, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 0.32119139, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} # @refFS[Formula]{fs:sampleSizeTwoRatesDiff} # @refFS[Formula]{fs:sampleSizeRatesDiffOptimumAllocationRatio} # @refFS[Formula]{fs:sampleSizePerStageTwoRates} sampleSizeResult <- getSampleSizeRates(designGS1, groups = 2, thetaH0 = 0.2, pi1 = 0.5, pi2 = 0.1, allocationRatioPlanned = 0) ## Comparison of the results of TrialDesignPlanRates object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$allocationRatioPlanned, 1.1669392, tolerance = 1e-07) expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 200.45189, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 107.94727, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 92.504622, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 40.090378, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 100.22594, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 200.45189, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 21.589453, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 53.973634, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 107.94727, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 18.500924, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 46.252311, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 92.504622, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 199.33807, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 187.57608, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 145.98518, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 0.63834776, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 0.41018483, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 0.32243267, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$allocationRatioPlanned, sampleSizeResult$allocationRatioPlanned, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:EstimatesRatioFarringtonManning} # @refFS[Formula]{fs:sampleSizeTwoRatesRatio} # @refFS[Formula]{fs:sampleSizePerStageTwoRates} sampleSizeResult <- getSampleSizeRates(designGS1, groups = 2, riskRatio = TRUE, thetaH0 = 0.9, pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanRates object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 171.20812, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 85.604059, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 85.604059, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 34.241624, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 85.604059, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 171.20812, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 170.2568, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 160.21075, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 124.68752, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 3.1899424, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.0225352, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.5569402, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:EstimatesRatioFarringtonManning} # @refFS[Formula]{fs:sampleSizeTwoRatesRatio} # @refFS[Formula]{fs:sampleSizePerStageTwoRates} sampleSizeResult <- getSampleSizeRates(designGS1, groups = 2, riskRatio = TRUE, thetaH0 = 0.9, pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanRates object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 221.72371, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 166.29278, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 55.430927, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 44.344741, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 110.86185, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 221.72371, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 33.258556, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 83.14639, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 166.29278, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 11.086185, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 27.715463, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 55.430927, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 220.4917, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 207.48153, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 161.47703, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 3.1917697, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.0740853, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.5843199, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:EstimatesRatioFarringtonManning} # @refFS[Formula]{fs:sampleSizePerStageTwoRates} # @refFS[Formula]{fs:sampleSizeTwoRatesRatioOptimumAllocationRatio} sampleSizeResult <- getSampleSizeRates(designGS1, groups = 2, riskRatio = TRUE, thetaH0 = 0.9, pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 0) ## Comparison of the results of TrialDesignPlanRates object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$allocationRatioPlanned, 1.0304199, tolerance = 1e-07) expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 171.17189, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 86.868201, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 84.303693, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 34.234379, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 85.585947, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 171.17189, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 17.37364, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 43.434101, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 86.868201, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 16.860739, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 42.151846, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 84.303693, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 170.22077, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 160.17685, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 124.66114, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 3.1919838, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.0241846, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.5576701, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$allocationRatioPlanned, sampleSizeResult$allocationRatioPlanned, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeRates': Sample size calculation of testing rates for two sided group sequential design", { designGS2 <- getDesignGroupSequential(informationRates = c(0.2,0.5,1), alpha = 0.4, sided = 2, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:sampleSizeOneRateApproximation} # @refFS[Formula]{fs:sampleSizePerStageOneRate} sampleSizeResult <- getSampleSizeRates(designGS2, groups = 1, thetaH0 = 0.5, pi1 = 0.8, normalApproximation = TRUE) ## Comparison of the results of TrialDesignPlanRates object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.30276671, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.3601177, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.23711559, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.66288441, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 11.331566, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 2.2663131, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 5.6657828, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 11.331566, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 9.4279622, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 8.5285086, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 6.4928537, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], -0.01272092, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.23002532, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.33381109, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 1.0127209, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 0.76997468, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 0.66618891, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.12265406, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.19870972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.26319851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:sampleSizeTwoRatesDiff} # @refFS[Formula]{fs:sampleSizePerStageTwoRates} sampleSizeResult <- getSampleSizeRates(designGS2, groups = 2, thetaH0 = 0, pi1 = 0.5, pi2 = 0.3, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanRates object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.30276671, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.3601177, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.23711559, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.66288441, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 123.43553, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 61.717765, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 61.717765, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 24.687106, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 61.717765, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 123.43553, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 102.69945, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 92.901636, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 70.727105, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], -0.23899172, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], -0.13791313, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], -0.087906186, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 0.30941892, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 0.15876644, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 0.095938144, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.12265406, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.19870972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.26319851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeRates} # @refFS[Formula]{fs:sampleSizeTwoRatesDiff} # @refFS[Formula]{fs:sampleSizePerStageTwoRates} sampleSizeResult <- getSampleSizeRates(designGS2, groups = 2, thetaH0 = 0, pi1 = 0.5, pi2 = 0.3, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanRates object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.30276671, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.3601177, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.23711559, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.66288441, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 162.30744, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 121.73058, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 40.576859, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 32.461488, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 81.153719, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 162.30744, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 24.346116, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 60.865289, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 121.73058, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 8.1153719, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 20.28843, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 40.576859, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 135.04122, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 122.15791, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 93.000251, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], -0.21587527, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], -0.13203224, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], -0.086052993, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 0.31213587, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 0.16272503, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 0.09811449, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.12265406, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.19870972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.26319851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH0, sampleSizeResult$expectedNumberOfSubjectsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH01, sampleSizeResult$expectedNumberOfSubjectsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ######################################################################################################################## ######################################################################################################################## }) context("Testing the Sample Size Calculation of Survival Designs for Different Designs and Arguments") test_that("'getSampleSizeSurvival': Fixed sample size with minimum required definitions, pi1 = c(0.4, 0.5, 0.6) and pi2 = 0.2 at event time 12, accrual time 12 and follow-up time 6 as default, only alpha = 0.01 is specified ", { # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityNotAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(alpha = 0.01) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, c(TRUE, TRUE, TRUE)) expect_equal(sampleSizeResult$median1, c(16.282985, 12, 9.0776496), tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, c(0.042568802, 0.057762265, 0.076357561), tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, c(2.2892242, 3.1062837, 4.1062837), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, c(58.52451, 31.248898, 20.120262), tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, c(16.482222, 7.5670212, 4.2761841), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsFixed, c(58.52451, 31.248898, 20.120262), tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed, c(197.78666, 90.804254, 51.314209), tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed1, c(98.893329, 45.402127, 25.657105), tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed2, c(98.893329, 45.402127, 25.657105), tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 18) expect_equal(sampleSizeResult$studyDuration, 18) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], c(1.8370942, 2.2986321, 2.821477), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsFixed, sampleSizeResult$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed, sampleSizeResult$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed1, sampleSizeResult$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed2, sampleSizeResult$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': Sample size calculation of survival designs for one sided group sequential design and typeOfComputation = 'Schoenfeld'", { designGS1 <- getDesignGroupSequential(informationRates = c(0.2,0.5,1), sided = 1, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityNotAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(designGS1, accountForObservationTimes = FALSE, typeOfComputation = "Schoenfeld", pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 2) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 16.282985, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 218.14225, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 145.42817, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 72.714085, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 72.714085, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 18.178521, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[1, ], 14.542817, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 36.357042, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 72.714085, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 72.310048, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 68.043375, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 52.956243, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 218.14225, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 145.42817, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 72.714085, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.9325954, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.3170793, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.6774418, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityNotAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "Schoenfeld", pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 16.282985, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 250.03082, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 187.52311, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 62.507704, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 86.179656, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 20.835901, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 7.0363139, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 11.430238, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 14.391854, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 17.235931, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 43.089828, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 86.179656, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 85.700797, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 80.644, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 62.762955, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 146.60794, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 238.15931, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 250.03082, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 109.95596, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 178.61948, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 187.52311, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 36.651986, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 59.539826, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 62.507704, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 236.50497, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.9325954, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.3170793, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.6774418, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityNotAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(designGS1, accountForObservationTimes = FALSE, typeOfComputation = "Schoenfeld", thetaH0 = 1.2, pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 16.282985, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 354.24994, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 177.12497, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 177.12497, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 106.27498, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 29.520829, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[1, ], 21.254997, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 53.137492, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 106.27498, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 105.68446, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 99.448526, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 77.397988, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 354.24994, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.1656631, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.3109184, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.7962847, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityNotAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(designGS1, accountForObservationTimes = FALSE, typeOfComputation = "Schoenfeld", thetaH0 = 1.2, pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 16.282985, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 404.85708, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 303.64281, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 101.21427, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 141.69998, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 33.73809, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[1, ], 28.339996, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 70.849989, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 141.69998, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 140.91262, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 132.59803, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 103.19732, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 404.85708, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 303.64281, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 101.21427, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.1656631, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.3109184, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.7962847, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "Schoenfeld", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 216.4138, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 108.2069, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 108.2069, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 64.634742, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 27.051725, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.2267714, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.327532, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.872604, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 12.926948, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 32.317371, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 64.634742, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 64.275598, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 60.483, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 47.072216, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 168.44491, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 216.4138, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 216.4138, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 212.39441, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.9325954, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.3170793, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.6774418, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "Schoenfeld", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 247.45413, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 185.5906, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 61.863534, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 86.179656, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 30.931767, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1694167, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.240925, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.832344, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 17.235931, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 43.089828, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 86.179656, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 85.700797, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 80.644, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 62.762955, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 190.83096, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 247.45413, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 247.45413, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 143.12322, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 185.5906, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 185.5906, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 47.70774, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 61.863534, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 61.863534, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 242.70959, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.9325954, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.3170793, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.6774418, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "Schoenfeld", thetaH0 = 1.2, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 355.83608, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 177.91804, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 177.91804, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 106.27498, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 44.47951, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.2267714, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.327532, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.872604, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 21.254997, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 53.137492, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 106.27498, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 105.68446, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 99.448526, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 77.397988, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 276.96374, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 355.83608, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 355.83608, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 349.22724, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.1656631, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.3109184, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.7962847, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "Schoenfeld", thetaH0 = 1.2, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 406.87381, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 305.15536, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 101.71845, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 141.69998, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 50.859227, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1694167, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.240925, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.832344, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 28.339996, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 70.849989, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 141.69998, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 140.91262, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 132.59803, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 103.19732, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 313.77176, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 406.87381, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 406.87381, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 235.32882, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 305.15536, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 305.15536, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 78.442941, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 101.71845, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 101.71845, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 399.07264, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.1656631, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.3109184, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.7962847, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "Schoenfeld", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime =16, accountForObservationTimes = TRUE, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 224.258, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 112.129, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 112.129, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 64.634742, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 28.03225, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1480342, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.21033, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.818027, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 12.926948, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 32.317371, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 64.634742, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 64.275598, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 60.483, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 47.072216, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 172.34323, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 224.258, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 224.258, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 219.90797, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.9325954, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.3170793, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.6774418, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "Schoenfeld", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime =16, accountForObservationTimes = TRUE, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 257.43359, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 193.07519, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 64.358398, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 86.179656, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 32.179199, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.0820828, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.109775, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.771337, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 17.235931, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 43.089828, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 86.179656, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 85.700797, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 80.644, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 62.762955, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 195.71655, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 257.43359, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 257.43359, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 146.78741, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 193.07519, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 193.07519, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 48.929138, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 64.358398, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 64.358398, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 252.26222, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.9325954, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.3170793, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.6774418, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "Schoenfeld", thetaH0 = 1.2, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime = 16, accountForObservationTimes = TRUE, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 368.73381, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 184.36691, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 184.36691, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 106.27498, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 46.091727, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1480342, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.21033, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.818027, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 21.254997, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 53.137492, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 106.27498, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 105.68446, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 99.448526, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 77.397988, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 283.37351, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 368.73381, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 368.73381, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 361.58134, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.1656631, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.3109184, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.7962847, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "Schoenfeld", thetaH0 = 1.2, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime = 16, accountForObservationTimes = TRUE, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 423.28243, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 317.46182, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 105.82061, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 141.69998, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 52.910303, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.0820828, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.109775, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.771337, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 28.339996, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 70.849989, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 141.69998, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 140.91262, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 132.59803, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 103.19732, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 321.80485, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 423.28243, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 423.28243, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 241.35364, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 317.46182, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 317.46182, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 80.451212, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 105.82061, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 105.82061, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 414.77946, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.1656631, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.3109184, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.7962847, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} # @refFS[Formula]{fs:sampleSizeSurvivalOptimumAllocationRatio} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "Schoenfeld", thetaH0 = 1.2, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime = 16, accountForObservationTimes = TRUE, allocationRatioPlanned = 0) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 359.78876, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 206.97289, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 152.81587, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 108.73874, tolerance = 1e-07) expect_equal(sampleSizeResult$allocationRatioPlanned, 1.3543939, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 44.973595, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1258711, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.176695, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.802401, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 21.747749, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 54.369372, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 108.73874, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 108.13454, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 101.75403, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 79.192297, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 275.50245, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 359.78876, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 359.78876, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 158.48615, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 206.97289, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 206.97289, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 117.01629, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 152.81587, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 152.81587, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 352.72627, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.1656631, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.3109184, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.7962847, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$allocationRatioPlanned, sampleSizeResult$allocationRatioPlanned, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': sample size calculation of survival designs for one sided group sequential design and typeOfComputation = 'Freedman'", { designGS1 <- getDesignGroupSequential(informationRates = c(0.2,0.5,1), sided = 1, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedman} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityNotAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(designGS1, accountForObservationTimes = FALSE, typeOfComputation = "Freedman", pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 16.282985, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 240.49104, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 120.24552, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 120.24552, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 72.147312, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 20.04092, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[1, ], 14.429462, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 36.073656, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 72.147312, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 71.746424, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 67.513008, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 52.543474, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 240.49104, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.52897, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.2152278, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.6316611, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedman} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityNotAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(designGS1, accountForObservationTimes = FALSE, typeOfComputation = "Freedman", pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 16.282985, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 393.13025, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 294.84769, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 98.282562, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 137.59559, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 32.760854, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[1, ], 27.519117, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 68.797794, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 137.59559, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 136.83103, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 128.75728, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 100.20817, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 393.13025, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 294.84769, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 98.282562, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 3.5359417, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 1.9445403, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.5058707, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedman} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "Freedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 241.56782, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 120.78391, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 120.78391, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 72.147312, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 30.195978, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.2267714, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.327532, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.872604, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 14.429462, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 36.073656, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 72.147312, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 71.746424, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 67.513008, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 52.543474, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 188.02345, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 241.56782, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 241.56782, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 237.08125, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.52897, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.2152278, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.6316611, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedman} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "Freedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 395.08857, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 296.31643, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 98.772142, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 137.59559, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 49.386071, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1694167, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.240925, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.832344, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 27.519117, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 68.797794, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 137.59559, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 136.83103, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 128.75728, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 100.20817, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 304.68325, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 395.08857, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 395.08857, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 228.51244, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 296.31643, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 296.31643, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 76.170813, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 98.772142, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 98.772142, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 387.51336, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 3.5359417, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 1.9445403, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.5058707, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedman} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "Freedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime =16, accountForObservationTimes = TRUE, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 250.32376, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 125.16188, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 125.16188, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 72.147312, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 31.29047, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1480342, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.21033, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.818027, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 14.429462, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 36.073656, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 72.147312, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 71.746424, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 67.513008, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 52.543474, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 192.37488, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 250.32376, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 250.32376, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 245.46813, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.52897, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.2152278, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.6316611, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedman} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} # @refFS[Formula]{fs:sampleSizeSurvivalOptimumAllocationRatio} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "Freedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime =16, accountForObservationTimes = TRUE, allocationRatioPlanned = 0) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 236.31869, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 89.479288, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 146.8394, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 62.770758, tolerance = 1e-07) expect_equal(sampleSizeResult$allocationRatioPlanned, 0.60936839, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 29.539836, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1891498, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.272294, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.846839, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 12.554152, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 31.385379, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 62.770758, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 62.421971, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 58.738747, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 45.714713, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 182.82647, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 236.31869, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 236.31869, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 69.22509, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 89.479288, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 89.479288, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 113.60138, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 146.8394, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 146.8394, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 231.83649, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 5.3084847, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.4084373, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.7178517, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$allocationRatioPlanned, sampleSizeResult$allocationRatioPlanned, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': sample size calculation of survival designs for one sided group sequential design and typeOfComputation = 'HsiehFreedman'", { designGS1 <- getDesignGroupSequential(informationRates = c(0.2,0.5,1), sided = 1, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedmanHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityNotAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(designGS1, accountForObservationTimes = FALSE, typeOfComputation = "HsiehFreedman", pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 16.282985, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 240.49104, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 120.24552, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 120.24552, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 72.147312, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 20.04092, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[1, ], 14.429462, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 36.073656, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 72.147312, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 71.746424, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 67.513008, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 52.543474, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 240.49104, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.52897, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.2152278, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.6316611, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedmanHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityNotAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(designGS1, accountForObservationTimes = FALSE, typeOfComputation = "HsiehFreedman", pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 16.282985, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 274.8469, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 206.13518, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 68.711726, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 96.196416, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 22.903909, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[1, ], 19.239283, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 48.098208, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 96.196416, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 95.661899, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 90.017344, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 70.057965, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 274.8469, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 206.13518, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 68.711726, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.52897, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.2152278, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.6316611, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedmanHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "HsiehFreedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 241.56782, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 120.78391, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 120.78391, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 72.147312, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 30.195978, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.2267714, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.327532, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.872604, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 14.429462, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 36.073656, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 72.147312, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 71.746424, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 67.513008, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 52.543474, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 188.02345, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 241.56782, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 241.56782, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 237.08125, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.52897, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.2152278, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.6316611, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedmanHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "HsiehFreedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 276.21601, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 207.16201, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 69.054003, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 96.196416, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 34.527001, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1694167, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.240925, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.832344, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 19.239283, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 48.098208, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 96.196416, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 95.661899, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 90.017344, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 70.057965, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 213.01146, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 276.21601, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 276.21601, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 159.75859, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 207.16201, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 207.16201, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 53.252865, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 69.054003, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 69.054003, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 270.92, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.52897, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.2152278, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.6316611, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedmanHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "HsiehFreedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime =16, accountForObservationTimes = TRUE, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 250.32376, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 125.16188, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 125.16188, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 72.147312, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 31.29047, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1480342, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.21033, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.818027, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 14.429462, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 36.073656, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 72.147312, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 71.746424, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 67.513008, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 52.543474, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 192.37488, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 250.32376, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 250.32376, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 245.46813, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.52897, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.2152278, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.6316611, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedmanHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} # @refFS[Formula]{fs:sampleSizeSurvivalOptimumAllocationRatio} sampleSizeResult <- getSampleSizeSurvival(designGS1, typeOfComputation = "HsiehFreedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime =16, accountForObservationTimes = TRUE, allocationRatioPlanned = 0) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 244.2512, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 140.50849, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 103.74271, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 73.819895, tolerance = 1e-07) expect_equal(sampleSizeResult$allocationRatioPlanned, 1.3543939, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 30.5314, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1258711, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.176695, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 13.802401, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 14.763979, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 36.909947, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 73.819895, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 73.409713, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 69.078154, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 53.761583, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 187.03142, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 244.2512, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 244.2512, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 107.59211, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 140.50849, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 140.50849, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 79.439306, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 103.74271, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 103.74271, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 239.45666, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 4.52897, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 2.2152278, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 1.6316611, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$allocationRatioPlanned, sampleSizeResult$allocationRatioPlanned, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': sample size calculation of survival data for two sided group sequential design and typeOfComputation = 'Schoenfeld'", { designGS2 <- getDesignGroupSequential(informationRates = c(0.2,0.5,1), alpha = 0.4, sided = 2, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityNotAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(designGS2, accountForObservationTimes = FALSE, typeOfComputation = "Schoenfeld", pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 16.282985, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 102.56356, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 51.281781, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 51.281781, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 30.769069, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 8.5469636, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.30276671, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.3601177, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.23711559, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.66288441, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[1, ], 6.1538138, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 15.384534, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 30.769069, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 25.600136, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 23.157812, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 17.630314, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 102.56356, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.28805692, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.51926225, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.66803619, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 3.4715361, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.9258092, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.4969249, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.12265406, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.19870972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.26319851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityNotAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(designGS2, accountForObservationTimes = FALSE, typeOfComputation = "Schoenfeld", pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 16.282985, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 117.2155, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 87.911625, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 29.303875, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 41.025425, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 9.7679584, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.30276671, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.3601177, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.23711559, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.66288441, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[1, ], 8.205085, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 20.512713, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 41.025425, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 34.133514, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 30.877083, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 23.507086, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 117.2155, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 87.911625, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 29.303875, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.28805692, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.51926225, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.66803619, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 3.4715361, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.9258092, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.4969249, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.12265406, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.19870972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.26319851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS2, typeOfComputation = "Schoenfeld", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 103.02279, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 51.511393, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 51.511393, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 30.769069, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 12.877848, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.30276671, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.3601177, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.23711559, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.66288441, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.2267714, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.327532, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 11.672467, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 6.1538138, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 15.384534, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 30.769069, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 25.600136, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 23.157812, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 17.630314, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 80.187417, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 103.02279, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 103.02279, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 96.108996, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.28805692, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.51926225, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.66803619, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 3.4715361, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.9258092, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.4969249, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.12265406, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.19870972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.26319851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS2, typeOfComputation = "Schoenfeld", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 117.79939, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 88.349544, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 29.449848, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 41.025425, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 14.724924, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.30276671, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.3601177, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.23711559, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.66288441, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1694167, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.240925, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 11.623913, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 8.205085, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 20.512713, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 41.025425, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 34.133514, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 30.877083, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 23.507086, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 90.844192, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 117.79939, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 117.79939, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 68.133144, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 88.349544, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 88.349544, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 22.711048, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 29.449848, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 29.449848, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 109.63825, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.28805692, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.51926225, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.66803619, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 3.4715361, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.9258092, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.4969249, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.12265406, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.19870972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.26319851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS2, typeOfComputation = "Schoenfeld", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime =16, accountForObservationTimes = TRUE, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 106.75698, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 53.378489, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 53.378489, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 30.769069, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 13.344622, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.30276671, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.3601177, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.23711559, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.66288441, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1480342, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.21033, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 11.606421, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 6.1538138, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 15.384534, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 30.769069, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 25.600136, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 23.157812, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 17.630314, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 82.043195, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 106.75698, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 106.75698, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 99.274467, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.28805692, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.51926225, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.66803619, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 3.4715361, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.9258092, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.4969249, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.12265406, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.19870972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.26319851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalSchoenfeld} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} # @refFS[Formula]{fs:sampleSizeSurvivalOptimumAllocationRatio} sampleSizeResult <- getSampleSizeSurvival(designGS2, typeOfComputation = "Schoenfeld", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime =16, accountForObservationTimes = TRUE, allocationRatioPlanned = 0) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 104.16718, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 59.923444, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 44.243734, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 31.482385, tolerance = 1e-07) expect_equal(sampleSizeResult$allocationRatioPlanned, 1.3543939, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 13.020897, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.30276671, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.3601177, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.23711559, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.66288441, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1258711, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.176695, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 11.587598, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 6.2964769, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 15.741192, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 31.482385, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 26.193621, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 23.694677, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 18.039036, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 79.764338, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 104.16718, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 104.16718, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 45.885412, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 59.923444, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 59.923444, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 33.878926, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 44.243734, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 44.243734, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 96.778811, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.28805692, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.51926225, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.66803619, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 3.4715361, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.9258092, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.4969249, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.12265406, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.19870972, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.26319851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$allocationRatioPlanned, sampleSizeResult$allocationRatioPlanned, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': sample size calculation of survival data for two sided group sequential design and typeOfComputation = 'Freedman'", { designGS2 <- getDesignGroupSequential(informationRates = c(0.2,0.5,1), alpha = 0.25, sided = 2, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedman} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityNotAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(designGS2, typeOfComputation = "Freedman", pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 16.282985, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 146.14538, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 73.072689, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 73.072689, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 43.244002, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 12.178781, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.22742698, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.38942935, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.28314367, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.61685633, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[1, ], 0.2, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[2, ], 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[3, ], 1) expect_equal(sampleSizeResult$analysisTime[1, ], 7.0974672, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 11.495939, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 12.987598, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 8.6488004, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 21.622001, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 43.244002, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 39.334079, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 35.691647, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 26.91074, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 86.438503, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 140.00653, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 146.14538, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 130.17577, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.27467837, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.50642065, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.65781752, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 3.6406215, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.974643, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.5201784, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.057428091, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.11367628, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.16847851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$informationRates, sampleSizeResult$informationRates, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedman} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityNotAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(designGS2, accountForObservationTimes = FALSE, typeOfComputation = "Freedman", pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 16.282985, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 235.6363, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 176.72722, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 58.909074, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 82.472703, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 19.636358, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.22742698, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.38942935, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.28314367, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.61685633, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[1, ], 0.2, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[2, ], 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[3, ], 1) expect_equal(sampleSizeResult$eventsPerStage[1, ], 16.494541, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 41.236352, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 82.472703, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 75.015902, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 68.069247, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 51.322759, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 235.6363, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 176.72722, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 58.909074, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.33945377, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.56614959, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.70454917, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 2.9459092, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.7663176, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.4193473, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.057428091, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.11367628, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.16847851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$informationRates, sampleSizeResult$informationRates, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedman} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS2, typeOfComputation = "Freedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 144.79208, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 72.396041, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 72.396041, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 43.244002, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 18.09901, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.22742698, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.38942935, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.28314367, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.61685633, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[1, ], 0.2, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[2, ], 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[3, ], 1) expect_equal(sampleSizeResult$analysisTime[1, ], 6.2267714, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.327532, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 12.334566, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 8.6488004, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 21.622001, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 43.244002, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 39.334079, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 35.691647, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 26.91074, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 112.6984, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 144.79208, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 144.79208, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 137.49311, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.27467837, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.50642065, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.65781752, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 3.6406215, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.974643, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.5201784, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.057428091, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.11367628, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.16847851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$informationRates, sampleSizeResult$informationRates, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedman} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS2, typeOfComputation = "Freedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 236.81008, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 177.60756, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 59.20252, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 82.472703, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 29.60126, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.22742698, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.38942935, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.28314367, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.61685633, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[1, ], 0.2, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[2, ], 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[3, ], 1) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1694167, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.240925, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 12.287795, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 16.494541, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 41.236352, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 82.472703, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 75.015902, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 68.069247, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 51.322759, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 182.62251, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 236.81008, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 236.81008, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 136.96688, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 177.60756, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 177.60756, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 45.655628, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 59.20252, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 59.20252, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 224.48637, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.33945377, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.56614959, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.70454917, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 2.9459092, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.7663176, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.4193473, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.057428091, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.11367628, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.16847851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$informationRates, sampleSizeResult$informationRates, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedman} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS2, typeOfComputation = "Freedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime =16, accountForObservationTimes = TRUE, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 150.04026, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 75.020128, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 75.020128, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 43.244002, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 18.755032, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.22742698, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.38942935, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.28314367, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.61685633, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[1, ], 0.2, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[2, ], 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[3, ], 1) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1480342, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.21033, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 12.271017, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 8.6488004, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 21.622001, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 43.244002, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 39.334079, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 35.691647, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 26.91074, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 115.30658, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 150.04026, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 150.04026, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 142.14088, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.27467837, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.50642065, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.65781752, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 3.6406215, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.974643, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.5201784, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.057428091, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.11367628, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.16847851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$informationRates, sampleSizeResult$informationRates, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedman} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} # @refFS[Formula]{fs:sampleSizeSurvivalOptimumAllocationRatio} sampleSizeResult <- getSampleSizeSurvival(designGS2, typeOfComputation = "Freedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime =16, accountForObservationTimes = TRUE, allocationRatioPlanned = 0) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 141.64583, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 53.632525, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 88.013303, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 37.623838, tolerance = 1e-07) expect_equal(sampleSizeResult$allocationRatioPlanned, 0.60936839, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 17.705728, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.22742698, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.38942935, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.28314367, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.61685633, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[1, ], 0.2, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[2, ], 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[3, ], 1) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1891498, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.272294, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 12.304499, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 7.5247676, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 18.811919, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 37.623838, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 34.222064, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 31.053018, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 23.413313, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 109.58341, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 141.64583, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 141.64583, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 41.492467, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 53.632525, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 53.632525, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 68.09094, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 88.013303, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 88.013303, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 134.35397, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.23978557, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.47145911, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.62947897, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 4.1703928, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 2.1210747, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.5886154, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.057428091, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.11367628, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.16847851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$allocationRatioPlanned, sampleSizeResult$allocationRatioPlanned, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$informationRates, sampleSizeResult$informationRates, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } getDesignCharacteristics(designGS2) }) test_that("'getSampleSizeSurvival': sample size calculation of survival data for two sided group sequential design and typeOfComputation = 'HsiehFreedman'", { designGS2 <- getDesignGroupSequential(informationRates = c(0.2,0.5,1), alpha = 0.25, sided = 2, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedmanHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityNotAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS2, accountForObservationTimes = FALSE, typeOfComputation = "HsiehFreedman", pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 16.282985, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 144.14667, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 72.073337, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 72.073337, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 43.244002, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 12.012223, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.22742698, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.38942935, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.28314367, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.61685633, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[1, ], 0.2, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[2, ], 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[3, ], 1) expect_equal(sampleSizeResult$eventsPerStage[1, ], 8.6488004, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 21.622001, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 43.244002, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 39.334079, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 35.691647, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 26.91074, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[2, ], NA_real_) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 144.14667, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.27467837, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.50642065, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.65781752, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 3.6406215, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.974643, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.5201784, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.057428091, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.11367628, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.16847851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$informationRates, sampleSizeResult$informationRates, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedmanHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityNotAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(designGS2, typeOfComputation = "HsiehFreedman", pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 16.282985, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 167.28361, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 125.46271, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 41.820903, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 57.658669, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 13.940301, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.22742698, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.38942935, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.28314367, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.61685633, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[1, ], 0.2, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[2, ], 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[3, ], 1) expect_equal(sampleSizeResult$analysisTime[1, ], 7.0363139, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 11.430238, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 12.948104, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 11.531734, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 28.829335, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 57.658669, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 52.445438, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 47.588863, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 35.880987, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 98.088334, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 159.34095, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 167.28361, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 73.56625, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 119.50572, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 125.46271, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 24.522083, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 39.835239, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 41.820903, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 148.45363, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.27467837, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.50642065, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.65781752, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 3.6406215, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.974643, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.5201784, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.057428091, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.11367628, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.16847851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$informationRates, sampleSizeResult$informationRates, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedmanHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS2, typeOfComputation = "HsiehFreedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 1) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 144.79208, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 72.396041, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 72.396041, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 43.244002, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 18.09901, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.22742698, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.38942935, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.28314367, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.61685633, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[1, ], 0.2, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[2, ], 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[3, ], 1) expect_equal(sampleSizeResult$analysisTime[1, ], 6.2267714, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.327532, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 12.334566, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 8.6488004, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 21.622001, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 43.244002, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 39.334079, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 35.691647, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 26.91074, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 112.6984, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 144.79208, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 144.79208, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 137.49311, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.27467837, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.50642065, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.65781752, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 3.6406215, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.974643, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.5201784, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.057428091, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.11367628, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.16847851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$informationRates, sampleSizeResult$informationRates, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedmanHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS2, typeOfComputation = "HsiehFreedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 165.55968, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 124.16976, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 41.389919, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 57.658669, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 20.69496, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.22742698, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.38942935, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.28314367, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.61685633, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[1, ], 0.2, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[2, ], 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[3, ], 1) expect_equal(sampleSizeResult$analysisTime[1, ], 6.1694167, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.240925, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 12.287795, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 11.531734, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 28.829335, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 57.658669, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 52.445438, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 47.588863, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 35.880987, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 127.67583, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 165.55968, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 165.55968, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 95.756873, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 124.16976, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 124.16976, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 31.918958, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 41.389919, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 41.389919, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 156.94387, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.27467837, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.50642065, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.65781752, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 3.6406215, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.974643, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.5201784, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.057428091, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.11367628, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.16847851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$informationRates, sampleSizeResult$informationRates, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedmanHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS2, typeOfComputation = "HsiehFreedman", thetaH0 = 1, pi1 = c(0.3,0.4), pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime =16, accountForObservationTimes = TRUE, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, c(TRUE, TRUE)) expect_equal(sampleSizeResult$median1, c(27.207015, 18.996816), tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, c(0.025476782, 0.036487545), tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, c(1.5984103, 2.2892242), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, c(634.39599, 172.23645), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, c(475.79699, 129.17734), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, c(158.599, 43.059113), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, c(167.01364, 57.658669), tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, c(79.299498, 21.529557), tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.22742698, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.38942935, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.28314367, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.61685633, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[1, ], 0.2, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[2, ], 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[3, ], 1) expect_equal(sampleSizeResult$analysisTime[1, ], c(6.2267383, 6.0820828), tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], c(10.326085, 10.109775), tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], c(18, 18)) expect_equal(sampleSizeResult$studyDuration, c(12.333995, 12.216859), tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, c(18, 18)) expect_equal(sampleSizeResult$eventsPerStage[1, ], c(33.402728, 11.531734), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], c(83.50682, 28.829335), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], c(167.01364, 57.658669), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, c(151.91304, 52.445438), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, c(137.84552, 47.588863), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, c(103.93258, 35.880987), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], c(493.77723, 130.94455), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], c(634.39599, 172.23645), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], c(634.39599, 172.23645), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], c(370.33292, 98.20841), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], c(475.79699, 129.17734), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], c(475.79699, 129.17734), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], c(123.44431, 32.736137), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], c(158.599, 43.059113), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], c(158.599, 43.059113), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, c(602.41549, 162.84556), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], c(0.4680288, 0.27467837), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], c(0.67047266, 0.50642065), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], c(0.78185284, 0.65781752), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], c(2.1366206, 3.6406215), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], c(1.4914851, 1.974643), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], c(1.2790131, 1.5201784), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.057428091, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.11367628, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.16847851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$informationRates, sampleSizeResult$informationRates, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedmanHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS2, typeOfComputation = "HsiehFreedman", thetaH0 = 1, pi1 = 0.3, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime =16, accountForObservationTimes = TRUE, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 27.207015, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.025476782, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 1.5984103, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 634.39599, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 475.79699, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 158.599, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 167.01364, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 79.299498, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.22742698, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.38942935, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.28314367, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.61685633, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[1, ], 0.2, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[2, ], 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[3, ], 1) expect_equal(sampleSizeResult$analysisTime[1, ], 6.2267383, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.326085, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 12.333995, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 33.402728, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 83.50682, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 167.01364, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 151.91304, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 137.84552, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 103.93258, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 493.77723, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 634.39599, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 634.39599, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 370.33292, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 475.79699, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 475.79699, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 123.44431, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 158.599, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 158.599, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 602.41549, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.4680288, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.67047266, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.78185284, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 2.1366206, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.4914851, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.2790131, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.057428091, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.11367628, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.16847851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$informationRates, sampleSizeResult$informationRates, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedmanHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS2, typeOfComputation = "HsiehFreedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime =16, accountForObservationTimes = TRUE, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$median1, 18.996816, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.036487545, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 172.23645, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 129.17734, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 43.059113, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 57.658669, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 21.529557, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.22742698, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.38942935, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.28314367, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.61685633, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[1, ], 0.2, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[2, ], 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[3, ], 1) expect_equal(sampleSizeResult$analysisTime[1, ], 6.0820828, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 10.109775, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], 18) expect_equal(sampleSizeResult$studyDuration, 12.216859, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 11.531734, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 28.829335, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], 57.658669, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 52.445438, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 47.588863, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 35.880987, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 130.94455, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 172.23645, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 172.23645, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], 98.20841, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], 129.17734, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], 129.17734, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], 32.736137, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], 43.059113, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], 43.059113, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 162.84556, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], 0.27467837, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], 0.50642065, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], 0.65781752, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], 3.6406215, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], 1.974643, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], 1.5201784, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.057428091, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.11367628, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.16847851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$informationRates, sampleSizeResult$informationRates, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedmanHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} sampleSizeResult <- getSampleSizeSurvival(designGS2, maxNumberOfSubjects = 0, typeOfComputation = "HsiehFreedman", thetaH0 = 1, pi1 = c(0.3,0.4), pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime = 16, accountForObservationTimes = TRUE, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, c(TRUE, TRUE)) expect_equal(sampleSizeResult$median1, c(27.207015, 18.996816), tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, c(0.025476782, 0.036487545), tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, c(1.5984103, 2.2892242), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, c(634.39599, 172.23645), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, c(475.79699, 129.17734), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, c(158.599, 43.059113), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, c(167.01364, 57.658669), tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, c(79.299498, 21.529557), tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.22742698, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.38942935, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.28314367, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.61685633, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[1, ], 0.2, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[2, ], 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[3, ], 1) expect_equal(sampleSizeResult$analysisTime[1, ], c(6.2267383, 6.0820828), tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], c(10.326085, 10.109775), tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], c(18, 18)) expect_equal(sampleSizeResult$studyDuration, c(12.333995, 12.216859), tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, c(18, 18)) expect_equal(sampleSizeResult$eventsPerStage[1, ], c(33.402728, 11.531734), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], c(83.50682, 28.829335), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], c(167.01364, 57.658669), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, c(151.91304, 52.445438), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, c(137.84552, 47.588863), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, c(103.93258, 35.880987), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], c(493.77723, 130.94455), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], c(634.39599, 172.23645), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], c(634.39599, 172.23645), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], c(370.33292, 98.20841), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], c(475.79699, 129.17734), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], c(475.79699, 129.17734), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], c(123.44431, 32.736137), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], c(158.599, 43.059113), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], c(158.599, 43.059113), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, c(602.41549, 162.84556), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], c(0.4680288, 0.27467837), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], c(0.67047266, 0.50642065), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], c(0.78185284, 0.65781752), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], c(2.1366206, 3.6406215), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], c(1.4914851, 1.974643), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], c(1.2790131, 1.5201784), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.057428091, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.11367628, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.16847851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$informationRates, sampleSizeResult$informationRates, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalFreedmanHsieh} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventProbabilityAcccountForOberservationTimes} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} # @refFS[Formula]{fs:sampleSizeSurvivalExpectedTimePoints} # @refFS[Formula]{fs:sampleSizeSurvivalOptimumAllocationRatio} sampleSizeResult <- getSampleSizeSurvival(maxNumberOfSubjects = 468, designGS2, typeOfComputation = "HsiehFreedman", thetaH0 = 1, pi1 = c(0.3,0.4), pi2 = 0.2, eventTime = 14, accrualTime = 8, dropoutRate1 = 0.1, dropoutRate2 = 0.05, dropoutTime =16, accountForObservationTimes = TRUE, allocationRatioPlanned = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, c(TRUE, TRUE)) expect_equal(sampleSizeResult$median1, c(27.207015, 18.996816), tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 43.487972, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, c(0.025476782, 0.036487545), tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.015938825, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, c(1.5984103, 2.2892242), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, c(468, 468)) expect_equal(sampleSizeResult$maxNumberOfSubjects1, c(351, 351)) expect_equal(sampleSizeResult$maxNumberOfSubjects2, c(117, 117)) expect_equal(sampleSizeResult$maxNumberOfEvents, c(167.01364, 57.658669), tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 58.5, tolerance = 1e-07) expect_equal(sampleSizeResult$followUpTime, c(16.753912, 0.380791), tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.22742698, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.38942935, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.28314367, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.61685633, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[1, ], 0.2, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[2, ], 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$informationRates[3, ], 1) expect_equal(sampleSizeResult$analysisTime[1, ], c(7.2865998, 3.6319976), tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], c(12.859517, 5.8243524), tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[3, ], c(24.753912, 8.380791), tolerance = 1e-07) expect_equal(sampleSizeResult$studyDuration, c(16.149347, 6.305235), tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, c(24.753912, 8.380791), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[1, ], c(33.402728, 11.531734), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], c(83.50682, 28.829335), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[3, ], c(167.01364, 57.658669), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, c(151.91304, 52.445438), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, c(137.84552, 47.588863), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, c(103.93258, 35.880987), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], c(426.26609, 212.47186), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], c(468, 340.72461), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], c(468, 468)) expect_equal(sampleSizeResult$numberOfSubjects1[1, ], c(319.69957, 159.35389), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[2, ], c(351, 255.54346), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects1[3, ], c(351, 351)) expect_equal(sampleSizeResult$numberOfSubjects2[1, ], c(106.56652, 53.117965), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[2, ], c(117, 85.181153), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects2[3, ], c(117, 117)) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, c(458.50858, 360.32124), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[1, ], c(0.4680288, 0.27467837), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[2, ], c(0.67047266, 0.50642065), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleLower[3, ], c(0.78185284, 0.65781752), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[1, ], c(2.1366206, 3.6406215), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[2, ], c(1.4914851, 1.974643), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScaleUpper[3, ], c(1.2790131, 1.5201784), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[1, ], 0.057428091, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[2, ], 0.11367628, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesPValueScale[3, ], 0.16847851, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$followUpTime, sampleSizeResult$followUpTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$informationRates, sampleSizeResult$informationRates, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects1, sampleSizeResult$numberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects2, sampleSizeResult$numberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleLower, sampleSizeResult$criticalValuesEffectScaleLower, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScaleUpper, sampleSizeResult$criticalValuesEffectScaleUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesPValueScale, sampleSizeResult$criticalValuesPValueScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } ######################################################################################################################## ######################################################################################################################## }) context("Testing the Sample Size Calculation of Survival Designs for Other Parameter Variants") test_that("'getSampleSizeSurvival': For fixed sample design, determine necessary accrual time if 200 subjects and 30 subjects per time unit can be recruited ", { # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(accrualTime = c(0), accrualIntensity = c(30), maxNumberOfSubjects = 120) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, c(TRUE, TRUE, TRUE)) expect_equal(sampleSizeResult$median1, c(16.282985, 12, 9.0776496), tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, c(0.042568802, 0.057762265, 0.076357561), tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, c(2.2892242, 3.1062837, 4.1062837), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, c(45.770282, 24.438835, 15.735459), tolerance = 1e-07) expect_equal(sampleSizeResult$followUpTime, c(14.350651, 4.1854022, 1.0840261), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsFixed, c(45.770282, 24.438835, 15.735459), tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed, c(120, 120, 120)) expect_equal(sampleSizeResult$nFixed1, c(60, 60, 60)) expect_equal(sampleSizeResult$nFixed2, c(60, 60, 60)) expect_equal(sampleSizeResult$analysisTime[1, ], c(18.350651, 8.1854022, 5.0840261), tolerance = 1e-07) expect_equal(sampleSizeResult$studyDuration, c(18.350651, 8.1854022, 5.0840261), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], c(1.7849857, 2.2098739, 2.686355), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$followUpTime, sampleSizeResult$followUpTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsFixed, sampleSizeResult$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed, sampleSizeResult$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed1, sampleSizeResult$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed2, sampleSizeResult$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': Determine necessary accrual time if 200 subjects and if the first 6 time units 20 subjects per time unit can be recruited, then 30 subjects per time unit", { # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(beta = 0.01, accrualTime = c(0, 4), accrualIntensity = c(10, 20), maxNumberOfSubjects = 180) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, c(TRUE, TRUE, TRUE)) expect_equal(sampleSizeResult$median1, c(16.282985, 12, 9.0776496), tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, c(0.042568802, 0.057762265, 0.076357561), tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, c(2.2892242, 3.1062837, 4.1062837), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, c(107.13798, 57.20584, 36.833186), tolerance = 1e-07) expect_equal(sampleSizeResult$totalAccrualTime, 11) expect_equal(sampleSizeResult$followUpTime, c(27.319035, 6.0447949, 0.58657023), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsFixed, c(107.13798, 57.20584, 36.833186), tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed, c(180, 180, 180)) expect_equal(sampleSizeResult$nFixed1, c(90, 90, 90)) expect_equal(sampleSizeResult$nFixed2, c(90, 90, 90)) expect_equal(sampleSizeResult$analysisTime[1, ], c(38.319035, 17.044795, 11.58657), tolerance = 1e-07) expect_equal(sampleSizeResult$studyDuration, c(38.319035, 17.044795, 11.58657), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], c(1.4603989, 1.6791239, 1.9076838), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$totalAccrualTime, sampleSizeResult$totalAccrualTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$followUpTime, sampleSizeResult$followUpTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsFixed, sampleSizeResult$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed, sampleSizeResult$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed1, sampleSizeResult$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed2, sampleSizeResult$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': Determine maximum number of Subjects if the first 6 time units 20 subjects per time unit can be recruited, and after 10 time units 30 subjects per time unit", { # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(accrualTime = c(0, 3, 5), accrualIntensity = c(20, 30)) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, c(TRUE, TRUE, TRUE)) expect_equal(sampleSizeResult$median1, c(16.282985, 12, 9.0776496), tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, c(0.042568802, 0.057762265, 0.076357561), tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, c(2.2892242, 3.1062837, 4.1062837), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, c(120, 120, 120)) expect_equal(sampleSizeResult$maxNumberOfEvents, c(45.770282, 24.438835, 15.735459), tolerance = 1e-07) expect_equal(sampleSizeResult$totalAccrualTime, 5) expect_equal(sampleSizeResult$followUpTime, c(14.113265, 3.9529427, 0.85781252), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsFixed, c(45.770282, 24.438835, 15.735459), tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed, c(120, 120, 120)) expect_equal(sampleSizeResult$nFixed1, c(60, 60, 60)) expect_equal(sampleSizeResult$nFixed2, c(60, 60, 60)) expect_equal(sampleSizeResult$analysisTime[1, ], c(19.113265, 8.9529427, 5.8578125), tolerance = 1e-07) expect_equal(sampleSizeResult$studyDuration, c(19.113265, 8.9529427, 5.8578125), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], c(1.7849857, 2.2098739, 2.686355), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$totalAccrualTime, sampleSizeResult$totalAccrualTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$followUpTime, sampleSizeResult$followUpTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsFixed, sampleSizeResult$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed, sampleSizeResult$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed1, sampleSizeResult$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed2, sampleSizeResult$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': Specify accrual time as a list", { # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} at <- list("0 - <3" = 20, "3 - Inf" = 30) sampleSizeResult <- getSampleSizeSurvival(accrualTime = at, maxNumberOfSubjects = 120) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, c(TRUE, TRUE, TRUE)) expect_equal(sampleSizeResult$median1, c(16.282985, 12, 9.0776496), tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, c(0.042568802, 0.057762265, 0.076357561), tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, c(2.2892242, 3.1062837, 4.1062837), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, c(45.770282, 24.438835, 15.735459), tolerance = 1e-07) expect_equal(sampleSizeResult$totalAccrualTime, 5) expect_equal(sampleSizeResult$followUpTime, c(14.113265, 3.9529427, 0.85781252), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsFixed, c(45.770282, 24.438835, 15.735459), tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed, c(120, 120, 120)) expect_equal(sampleSizeResult$nFixed1, c(60, 60, 60)) expect_equal(sampleSizeResult$nFixed2, c(60, 60, 60)) expect_equal(sampleSizeResult$analysisTime[1, ], c(19.113265, 8.9529427, 5.8578125), tolerance = 1e-07) expect_equal(sampleSizeResult$studyDuration, c(19.113265, 8.9529427, 5.8578125), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], c(1.7849857, 2.2098739, 2.686355), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$totalAccrualTime, sampleSizeResult$totalAccrualTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$followUpTime, sampleSizeResult$followUpTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsFixed, sampleSizeResult$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed, sampleSizeResult$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed1, sampleSizeResult$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed2, sampleSizeResult$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': Specify accrual time as a list, if maximum number of subjects need to be calculated", { # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} at <- list("0 - <3" = 20, "3 - <=5" = 30) sampleSizeResult <- getSampleSizeSurvival(accrualTime = at) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, c(TRUE, TRUE, TRUE)) expect_equal(sampleSizeResult$median1, c(16.282985, 12, 9.0776496), tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, c(0.042568802, 0.057762265, 0.076357561), tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, c(2.2892242, 3.1062837, 4.1062837), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, c(120, 120, 120)) expect_equal(sampleSizeResult$maxNumberOfEvents, c(45.770282, 24.438835, 15.735459), tolerance = 1e-07) expect_equal(sampleSizeResult$totalAccrualTime, 5) expect_equal(sampleSizeResult$followUpTime, c(14.113265, 3.9529427, 0.85781252), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsFixed, c(45.770282, 24.438835, 15.735459), tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed, c(120, 120, 120)) expect_equal(sampleSizeResult$nFixed1, c(60, 60, 60)) expect_equal(sampleSizeResult$nFixed2, c(60, 60, 60)) expect_equal(sampleSizeResult$analysisTime[1, ], c(19.113265, 8.9529427, 5.8578125), tolerance = 1e-07) expect_equal(sampleSizeResult$studyDuration, c(19.113265, 8.9529427, 5.8578125), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], c(1.7849857, 2.2098739, 2.686355), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$totalAccrualTime, sampleSizeResult$totalAccrualTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$followUpTime, sampleSizeResult$followUpTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsFixed, sampleSizeResult$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed, sampleSizeResult$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed1, sampleSizeResult$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed2, sampleSizeResult$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': Effect size is based on event rate at specified event time for the reference group and hazard ratio ", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(design = getDesignGroupSequential(kMax = 2), hazardRatio = 0.5, pi2 = 0.3, eventTime = 24) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, FALSE) expect_equal(sampleSizeResult$pi1, 0.16333997, tolerance = 1e-07) expect_equal(sampleSizeResult$median1, 93.281194, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 46.640597, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.007430728, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda2, 0.014861456, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 532.72433, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 266.36217, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 266.36217, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 65.854457, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 44.393694, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.20960506, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.59039494, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.20960506, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 11.816947, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 18) expect_equal(sampleSizeResult$studyDuration, 16.704001, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 32.927229, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 65.854457, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 65.76941, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 64.676952, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 58.952743, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 524.59793, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 532.72433, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 531.021, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 0.37730742, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 0.61425355, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$pi1, sampleSizeResult$pi1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda2, sampleSizeResult$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': Effect size is based on hazard rate for the reference group and hazard ratio", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalPatientNumber} # @refFS[Formula]{fs:sampleSizeSurvivalEventsPerStage} sampleSizeResult <- getSampleSizeSurvival(design = getDesignGroupSequential(kMax = 2), hazardRatio = 0.5, lambda2 = 0.02) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, FALSE) expect_equal(sampleSizeResult$median1, 69.314718, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 34.657359, tolerance = 1e-07) expect_equal(sampleSizeResult$lambda1, 0.01, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 406.47112, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 203.23556, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 203.23556, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 65.854457, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 33.872594, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.20960506, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.59039494, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.20960506, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 11.754955, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 18) expect_equal(sampleSizeResult$studyDuration, 16.691007, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 32.927229, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 65.854457, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 65.76941, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 64.676952, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 58.952743, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 398.17083, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 406.47112, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 404.73134, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 0.37730742, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 0.61425355, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$lambda1, sampleSizeResult$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': Specification of piecewise exponential survival time and hazard ratios ", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalExponentialPieceWiseAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalGeneralPieceWiseAccrual} # @refFS[Formula]{fs:pieceWiseExponentialSurvival} sampleSizeResult <- getSampleSizeSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.01, 0.02, 0.04), hazardRatio = c(1.5, 1.8, 2)) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, c(TRUE, TRUE, TRUE)) expect_equal(sampleSizeResult$maxNumberOfSubjects, c(762.70199, 333.19844, 227.99548), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, c(381.35099, 166.59922, 113.99774), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, c(381.35099, 166.59922, 113.99774), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, c(192.45497, 91.579156, 65.854457), tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, c(63.558499, 27.766537, 18.999624), tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.20960506, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.59039494, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.20960506, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], c(13.350554, 13.286013, 13.241069), tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], c(18, 18, 18)) expect_equal(sampleSizeResult$studyDuration, c(17.025453, 17.011925, 17.002504), tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, c(18, 18, 18)) expect_equal(sampleSizeResult$eventsPerStage[1, ], c(96.227483, 45.789578, 32.927229), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], c(192.45497, 91.579156, 65.854457), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, c(192.20642, 91.460887, 65.76941), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, c(189.01379, 89.941683, 64.676952), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, c(172.2852, 81.981429, 58.952743), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], c(762.70199, 333.19844, 227.99548), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], c(762.70199, 333.19844, 227.99548), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, c(762.70199, 333.19844, 227.99548), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], c(1.76855, 2.2853938, 2.6503587), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], c(1.3298684, 1.5117519, 1.6279922), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': Specification of piecewise exponential survival time as a list and hazard ratios ", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalExponentialPieceWiseAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalGeneralPieceWiseAccrual} # @refFS[Formula]{fs:pieceWiseExponentialSurvival} pws <- list("0 - <5" = 0.01, "5 - <10" = 0.02, ">=10" = 0.04) sampleSizeResult <- getSampleSizeSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = pws, hazardRatio = c(1.5, 1.8, 2)) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, c(TRUE, TRUE, TRUE)) expect_equal(sampleSizeResult$maxNumberOfSubjects, c(762.70199, 333.19844, 227.99548), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, c(381.35099, 166.59922, 113.99774), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, c(381.35099, 166.59922, 113.99774), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, c(192.45497, 91.579156, 65.854457), tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, c(63.558499, 27.766537, 18.999624), tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.20960506, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.59039494, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.20960506, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], c(13.350554, 13.286013, 13.241069), tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], c(18, 18, 18)) expect_equal(sampleSizeResult$studyDuration, c(17.025453, 17.011925, 17.002504), tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, c(18, 18, 18)) expect_equal(sampleSizeResult$eventsPerStage[1, ], c(96.227483, 45.789578, 32.927229), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], c(192.45497, 91.579156, 65.854457), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, c(192.20642, 91.460887, 65.76941), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, c(189.01379, 89.941683, 64.676952), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, c(172.2852, 81.981429, 58.952743), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], c(762.70199, 333.19844, 227.99548), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], c(762.70199, 333.19844, 227.99548), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, c(762.70199, 333.19844, 227.99548), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], c(1.76855, 2.2853938, 2.6503587), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], c(1.3298684, 1.5117519, 1.6279922), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': Specification of piecewise exponential survival time for both treatment arms", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalExponentialPieceWiseAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalGeneralPieceWiseAccrual} # @refFS[Formula]{fs:pieceWiseExponentialSurvival} sampleSizeResult <- getSampleSizeSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = c(0, 5, 10), lambda2 = c(0.01, 0.02, 0.04), lambda1 = c(0.015, 0.03, 0.06)) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, TRUE) expect_equal(sampleSizeResult$hazardRatio, 1.5, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 762.70199, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, 381.35099, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, 381.35099, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 192.45497, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 63.558499, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.20960506, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.59039494, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.20960506, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 13.350554, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], 18) expect_equal(sampleSizeResult$studyDuration, 17.025453, tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, 18) expect_equal(sampleSizeResult$eventsPerStage[1, ], 96.227483, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], 192.45497, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, 192.20642, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, 189.01379, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, 172.2852, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 762.70199, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 762.70199, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 762.70199, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 1.76855, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 1.3298684, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': Specification of piecewise exponential survival time as a list", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalExponentialPieceWiseAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalGeneralPieceWiseAccrual} # @refFS[Formula]{fs:pieceWiseExponentialSurvival} pws <- list("0 - <5" = 0.01, "5 - <10" = 0.02, ">=10" = 0.04) sampleSizeResult <- getSampleSizeSurvival(design = getDesignGroupSequential(kMax = 2), piecewiseSurvivalTime = pws, hazardRatio = c(1.5, 1.8, 2)) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, c(TRUE, TRUE, TRUE)) expect_equal(sampleSizeResult$maxNumberOfSubjects, c(762.70199, 333.19844, 227.99548), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects1, c(381.35099, 166.59922, 113.99774), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects2, c(381.35099, 166.59922, 113.99774), tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, c(192.45497, 91.579156, 65.854457), tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, c(63.558499, 27.766537, 18.999624), tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.20960506, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.59039494, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.20960506, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], c(13.350554, 13.286013, 13.241069), tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[2, ], c(18, 18, 18)) expect_equal(sampleSizeResult$studyDuration, c(17.025453, 17.011925, 17.002504), tolerance = 1e-07) expect_equal(sampleSizeResult$maxStudyDuration, c(18, 18, 18)) expect_equal(sampleSizeResult$eventsPerStage[1, ], c(96.227483, 45.789578, 32.927229), tolerance = 1e-07) expect_equal(sampleSizeResult$eventsPerStage[2, ], c(192.45497, 91.579156, 65.854457), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH0, c(192.20642, 91.460887, 65.76941), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH01, c(189.01379, 89.941683, 64.676952), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedEventsH1, c(172.2852, 81.981429, 58.952743), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], c(762.70199, 333.19844, 227.99548), tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], c(762.70199, 333.19844, 227.99548), tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, c(762.70199, 333.19844, 227.99548), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], c(1.76855, 2.2853938, 2.6503587), tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], c(1.3298684, 1.5117519, 1.6279922), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects1, sampleSizeResult$maxNumberOfSubjects1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects2, sampleSizeResult$maxNumberOfSubjects2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$rejectPerStage, sampleSizeResult$rejectPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$earlyStop, sampleSizeResult$earlyStop, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxStudyDuration, sampleSizeResult$maxStudyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsPerStage, sampleSizeResult$eventsPerStage, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH0, sampleSizeResult$expectedEventsH0, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH01, sampleSizeResult$expectedEventsH01, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedEventsH1, sampleSizeResult$expectedEventsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$numberOfSubjects, sampleSizeResult$numberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$expectedNumberOfSubjectsH1, sampleSizeResult$expectedNumberOfSubjectsH1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': Specify effect size based on median survival times (median1 = 5, median2 = 3)", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:lambdabymedian} sampleSizeResult <- getSampleSizeSurvival(lambda1 = log(2) / 5, lambda2 = log(2) / 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, FALSE) expect_equal(sampleSizeResult$median1, 5) expect_equal(sampleSizeResult$median2, 3) expect_equal(sampleSizeResult$hazardRatio, 0.6, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 120.3157, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 11.772201, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsFixed, 120.3157, tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed, 141.26641, tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed1, 70.633206, tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed2, 70.633206, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 18) expect_equal(sampleSizeResult$studyDuration, 18) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 0.6995143, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsFixed, sampleSizeResult$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed, sampleSizeResult$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed1, sampleSizeResult$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed2, sampleSizeResult$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:lambdabymedian} sampleSizeResult2 <- getSampleSizeSurvival(median1 = 5, median2 = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult2' with expected results expect_equal(sampleSizeResult2$directionUpper, FALSE) expect_equal(sampleSizeResult2$lambda1, 0.13862944, tolerance = 1e-07) expect_equal(sampleSizeResult2$lambda2, 0.23104906, tolerance = 1e-07) expect_equal(sampleSizeResult2$hazardRatio, 0.6, tolerance = 1e-07) expect_equal(sampleSizeResult2$maxNumberOfEvents, 120.3157, tolerance = 1e-07) expect_equal(sampleSizeResult2$accrualIntensity, 11.772201, tolerance = 1e-07) expect_equal(sampleSizeResult2$eventsFixed, 120.3157, tolerance = 1e-07) expect_equal(sampleSizeResult2$nFixed, 141.26641, tolerance = 1e-07) expect_equal(sampleSizeResult2$nFixed1, 70.633206, tolerance = 1e-07) expect_equal(sampleSizeResult2$nFixed2, 70.633206, tolerance = 1e-07) expect_equal(sampleSizeResult2$analysisTime[1, ], 18) expect_equal(sampleSizeResult2$studyDuration, 18) expect_equal(sampleSizeResult2$criticalValuesEffectScale[1, ], 0.6995143, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult2), NA))) expect_output(print(sampleSizeResult2)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult2), NA))) expect_output(summary(sampleSizeResult2)$show()) sampleSizeResult2CodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult2, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResult2CodeBased$directionUpper, sampleSizeResult2$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$lambda1, sampleSizeResult2$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$lambda2, sampleSizeResult2$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$hazardRatio, sampleSizeResult2$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$maxNumberOfEvents, sampleSizeResult2$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$accrualIntensity, sampleSizeResult2$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$eventsFixed, sampleSizeResult2$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$nFixed, sampleSizeResult2$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$nFixed1, sampleSizeResult2$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$nFixed2, sampleSizeResult2$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$analysisTime, sampleSizeResult2$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$studyDuration, sampleSizeResult2$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$criticalValuesEffectScale, sampleSizeResult2$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult2), "character") df <- as.data.frame(sampleSizeResult2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:lambdabymedian} sampleSizeResult <- getSampleSizeSurvival( lambda1 = getLambdaByMedian(median = 5, kappa = 2), lambda2 = getLambdaByMedian(median = 3, kappa = 2), kappa = 2) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, FALSE) expect_equal(sampleSizeResult$median1, 5) expect_equal(sampleSizeResult$median2, 3) expect_equal(sampleSizeResult$hazardRatio, 0.36, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 30.078926, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 2.6040472, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsFixed, 30.078926, tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed, 31.248566, tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed1, 15.624283, tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed2, 15.624283, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 18) expect_equal(sampleSizeResult$studyDuration, 18) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 0.48932026, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsFixed, sampleSizeResult$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed, sampleSizeResult$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed1, sampleSizeResult$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed2, sampleSizeResult$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:lambdabymedian} sampleSizeResult2 <- getSampleSizeSurvival(median1 = 5, median2 = 3, kappa = 2) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult2' with expected results expect_equal(sampleSizeResult2$directionUpper, FALSE) expect_equal(sampleSizeResult2$lambda1, 0.16651092, tolerance = 1e-07) expect_equal(sampleSizeResult2$lambda2, 0.2775182, tolerance = 1e-07) expect_equal(sampleSizeResult2$hazardRatio, 0.36, tolerance = 1e-07) expect_equal(sampleSizeResult2$maxNumberOfEvents, 30.078926, tolerance = 1e-07) expect_equal(sampleSizeResult2$accrualIntensity, 2.6040472, tolerance = 1e-07) expect_equal(sampleSizeResult2$eventsFixed, 30.078926, tolerance = 1e-07) expect_equal(sampleSizeResult2$nFixed, 31.248566, tolerance = 1e-07) expect_equal(sampleSizeResult2$nFixed1, 15.624283, tolerance = 1e-07) expect_equal(sampleSizeResult2$nFixed2, 15.624283, tolerance = 1e-07) expect_equal(sampleSizeResult2$analysisTime[1, ], 18) expect_equal(sampleSizeResult2$studyDuration, 18) expect_equal(sampleSizeResult2$criticalValuesEffectScale[1, ], 0.48932026, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult2), NA))) expect_output(print(sampleSizeResult2)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult2), NA))) expect_output(summary(sampleSizeResult2)$show()) sampleSizeResult2CodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult2, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResult2CodeBased$directionUpper, sampleSizeResult2$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$lambda1, sampleSizeResult2$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$lambda2, sampleSizeResult2$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$hazardRatio, sampleSizeResult2$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$maxNumberOfEvents, sampleSizeResult2$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$accrualIntensity, sampleSizeResult2$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$eventsFixed, sampleSizeResult2$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$nFixed, sampleSizeResult2$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$nFixed1, sampleSizeResult2$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$nFixed2, sampleSizeResult2$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$analysisTime, sampleSizeResult2$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$studyDuration, sampleSizeResult2$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$criticalValuesEffectScale, sampleSizeResult2$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult2), "character") df <- as.data.frame(sampleSizeResult2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': Specify effect size based on rates with kappa = 3", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:lambdabypi} sampleSizeResult <- getSampleSizeSurvival(lambda1 = (-log(1 - 0.23))^(1/3) / 14, lambda2 = (-log(1 - 0.38))^(1/3) / 14, kappa = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, FALSE) expect_equal(sampleSizeResult$median1, 19.378531, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 15.845881, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 0.54674726, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 86.124472, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualIntensity, 30.926108, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsFixed, 86.124472, tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed, 371.1133, tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed1, 185.55665, tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed2, 185.55665, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 18) expect_equal(sampleSizeResult$studyDuration, 18) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 0.65547761, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualIntensity, sampleSizeResult$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsFixed, sampleSizeResult$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed, sampleSizeResult$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed1, sampleSizeResult$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed2, sampleSizeResult$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:lambdabypi} sampleSizeResult2 <- getSampleSizeSurvival(pi1 = 0.23, pi2 = 0.38, eventTime = 14, kappa = 3) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult2' with expected results expect_equal(sampleSizeResult2$directionUpper, FALSE) expect_equal(sampleSizeResult2$median1, 19.378531, tolerance = 1e-07) expect_equal(sampleSizeResult2$median2, 15.845881, tolerance = 1e-07) expect_equal(sampleSizeResult2$lambda1, 0.045668945, tolerance = 1e-07) expect_equal(sampleSizeResult2$lambda2, 0.055850291, tolerance = 1e-07) expect_equal(sampleSizeResult2$hazardRatio, 0.54674726, tolerance = 1e-07) expect_equal(sampleSizeResult2$maxNumberOfEvents, 86.124472, tolerance = 1e-07) expect_equal(sampleSizeResult2$accrualIntensity, 30.926108, tolerance = 1e-07) expect_equal(sampleSizeResult2$eventsFixed, 86.124472, tolerance = 1e-07) expect_equal(sampleSizeResult2$nFixed, 371.1133, tolerance = 1e-07) expect_equal(sampleSizeResult2$nFixed1, 185.55665, tolerance = 1e-07) expect_equal(sampleSizeResult2$nFixed2, 185.55665, tolerance = 1e-07) expect_equal(sampleSizeResult2$analysisTime[1, ], 18) expect_equal(sampleSizeResult2$studyDuration, 18) expect_equal(sampleSizeResult2$criticalValuesEffectScale[1, ], 0.65547761, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult2), NA))) expect_output(print(sampleSizeResult2)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult2), NA))) expect_output(summary(sampleSizeResult2)$show()) sampleSizeResult2CodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult2, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResult2CodeBased$directionUpper, sampleSizeResult2$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$median1, sampleSizeResult2$median1, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$median2, sampleSizeResult2$median2, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$lambda1, sampleSizeResult2$lambda1, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$lambda2, sampleSizeResult2$lambda2, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$hazardRatio, sampleSizeResult2$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$maxNumberOfEvents, sampleSizeResult2$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$accrualIntensity, sampleSizeResult2$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$eventsFixed, sampleSizeResult2$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$nFixed, sampleSizeResult2$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$nFixed1, sampleSizeResult2$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$nFixed2, sampleSizeResult2$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$analysisTime, sampleSizeResult2$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$studyDuration, sampleSizeResult2$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResult2CodeBased$criticalValuesEffectScale, sampleSizeResult2$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult2), "character") df <- as.data.frame(sampleSizeResult2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': Calculation of maximum number of subjects for given follow-up time", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} sampleSizeResult <- getSampleSizeSurvival(accrualTime = c(0, 6), accrualIntensity = c(22, 53), lambda2 = 0.02, lambda1 = c(0.01), followUpTime = 5) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult' with expected results expect_equal(sampleSizeResult$directionUpper, FALSE) expect_equal(sampleSizeResult$median1, 69.314718, tolerance = 1e-07) expect_equal(sampleSizeResult$median2, 34.657359, tolerance = 1e-07) expect_equal(sampleSizeResult$hazardRatio, 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfSubjects, 477.30924, tolerance = 1e-07) expect_equal(sampleSizeResult$maxNumberOfEvents, 65.345659, tolerance = 1e-07) expect_equal(sampleSizeResult$accrualTime, c(6, 12.515269), tolerance = 1e-07) expect_equal(sampleSizeResult$totalAccrualTime, 12.515269, tolerance = 1e-07) expect_equal(sampleSizeResult$eventsFixed, 65.345659, tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed, 477.30924, tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed1, 238.65462, tolerance = 1e-07) expect_equal(sampleSizeResult$nFixed2, 238.65462, tolerance = 1e-07) expect_equal(sampleSizeResult$analysisTime[1, ], 17.515269, tolerance = 1e-07) expect_equal(sampleSizeResult$studyDuration, 17.515269, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 0.61574672, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) sampleSizeResultCodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResultCodeBased$directionUpper, sampleSizeResult$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median1, sampleSizeResult$median1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$median2, sampleSizeResult$median2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$hazardRatio, sampleSizeResult$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfSubjects, sampleSizeResult$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$maxNumberOfEvents, sampleSizeResult$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$accrualTime, sampleSizeResult$accrualTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$totalAccrualTime, sampleSizeResult$totalAccrualTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$eventsFixed, sampleSizeResult$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed, sampleSizeResult$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed1, sampleSizeResult$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$nFixed2, sampleSizeResult$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$analysisTime, sampleSizeResult$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$studyDuration, sampleSizeResult$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResultCodeBased$criticalValuesEffectScale, sampleSizeResult$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult), "character") df <- as.data.frame(sampleSizeResult) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} sampleSizeResult3 <- getSampleSizeSurvival(accrualTime = c(0, 6), accrualIntensity = c(22), lambda2 = 0.02, lambda1 = c(0.01)) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult3' with expected results expect_equal(sampleSizeResult3$directionUpper, FALSE) expect_equal(sampleSizeResult3$median1, 69.314718, tolerance = 1e-07) expect_equal(sampleSizeResult3$median2, 34.657359, tolerance = 1e-07) expect_equal(sampleSizeResult3$hazardRatio, 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult3$maxNumberOfSubjects, 132) expect_equal(sampleSizeResult3$maxNumberOfEvents, 65.345659, tolerance = 1e-07) expect_equal(sampleSizeResult3$followUpTime, 44.431065, tolerance = 1e-07) expect_equal(sampleSizeResult3$eventsFixed, 65.345659, tolerance = 1e-07) expect_equal(sampleSizeResult3$nFixed, 132) expect_equal(sampleSizeResult3$nFixed1, 66) expect_equal(sampleSizeResult3$nFixed2, 66) expect_equal(sampleSizeResult3$analysisTime[1, ], 50.431065, tolerance = 1e-07) expect_equal(sampleSizeResult3$studyDuration, 50.431065, tolerance = 1e-07) expect_equal(sampleSizeResult3$criticalValuesEffectScale[1, ], 0.61574672, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult3), NA))) expect_output(print(sampleSizeResult3)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult3), NA))) expect_output(summary(sampleSizeResult3)$show()) sampleSizeResult3CodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult3, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResult3CodeBased$directionUpper, sampleSizeResult3$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResult3CodeBased$median1, sampleSizeResult3$median1, tolerance = 1e-05) expect_equal(sampleSizeResult3CodeBased$median2, sampleSizeResult3$median2, tolerance = 1e-05) expect_equal(sampleSizeResult3CodeBased$hazardRatio, sampleSizeResult3$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResult3CodeBased$maxNumberOfSubjects, sampleSizeResult3$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResult3CodeBased$maxNumberOfEvents, sampleSizeResult3$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResult3CodeBased$followUpTime, sampleSizeResult3$followUpTime, tolerance = 1e-05) expect_equal(sampleSizeResult3CodeBased$eventsFixed, sampleSizeResult3$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResult3CodeBased$nFixed, sampleSizeResult3$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResult3CodeBased$nFixed1, sampleSizeResult3$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResult3CodeBased$nFixed2, sampleSizeResult3$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResult3CodeBased$analysisTime, sampleSizeResult3$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResult3CodeBased$studyDuration, sampleSizeResult3$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResult3CodeBased$criticalValuesEffectScale, sampleSizeResult3$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult3), "character") df <- as.data.frame(sampleSizeResult3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} sampleSizeResult4 <- getSampleSizeSurvival(accrualTime = c(0, 6), accrualIntensity = c(22), lambda2 = 0.02, lambda1 = c(0.01)) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult4' with expected results expect_equal(sampleSizeResult4$directionUpper, FALSE) expect_equal(sampleSizeResult4$median1, 69.314718, tolerance = 1e-07) expect_equal(sampleSizeResult4$median2, 34.657359, tolerance = 1e-07) expect_equal(sampleSizeResult4$hazardRatio, 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult4$maxNumberOfSubjects, 132) expect_equal(sampleSizeResult4$maxNumberOfEvents, 65.345659, tolerance = 1e-07) expect_equal(sampleSizeResult4$followUpTime, 44.431065, tolerance = 1e-07) expect_equal(sampleSizeResult4$eventsFixed, 65.345659, tolerance = 1e-07) expect_equal(sampleSizeResult4$nFixed, 132) expect_equal(sampleSizeResult4$nFixed1, 66) expect_equal(sampleSizeResult4$nFixed2, 66) expect_equal(sampleSizeResult4$analysisTime[1, ], 50.431065, tolerance = 1e-07) expect_equal(sampleSizeResult4$studyDuration, 50.431065, tolerance = 1e-07) expect_equal(sampleSizeResult4$criticalValuesEffectScale[1, ], 0.61574672, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult4), NA))) expect_output(print(sampleSizeResult4)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult4), NA))) expect_output(summary(sampleSizeResult4)$show()) sampleSizeResult4CodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult4, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResult4CodeBased$directionUpper, sampleSizeResult4$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResult4CodeBased$median1, sampleSizeResult4$median1, tolerance = 1e-05) expect_equal(sampleSizeResult4CodeBased$median2, sampleSizeResult4$median2, tolerance = 1e-05) expect_equal(sampleSizeResult4CodeBased$hazardRatio, sampleSizeResult4$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResult4CodeBased$maxNumberOfSubjects, sampleSizeResult4$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResult4CodeBased$maxNumberOfEvents, sampleSizeResult4$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResult4CodeBased$followUpTime, sampleSizeResult4$followUpTime, tolerance = 1e-05) expect_equal(sampleSizeResult4CodeBased$eventsFixed, sampleSizeResult4$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResult4CodeBased$nFixed, sampleSizeResult4$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResult4CodeBased$nFixed1, sampleSizeResult4$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResult4CodeBased$nFixed2, sampleSizeResult4$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResult4CodeBased$analysisTime, sampleSizeResult4$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResult4CodeBased$studyDuration, sampleSizeResult4$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResult4CodeBased$criticalValuesEffectScale, sampleSizeResult4$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult4), "character") df <- as.data.frame(sampleSizeResult4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} sampleSizeResult6 <- getSampleSizeSurvival(accrualTime = c(0), accrualIntensity = c(22), lambda2 = 0.02, lambda1 = c(0.01), maxNumberOfSubjects = 300) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult6' with expected results expect_equal(sampleSizeResult6$directionUpper, FALSE) expect_equal(sampleSizeResult6$median1, 69.314718, tolerance = 1e-07) expect_equal(sampleSizeResult6$median2, 34.657359, tolerance = 1e-07) expect_equal(sampleSizeResult6$hazardRatio, 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult6$maxNumberOfEvents, 65.345659, tolerance = 1e-07) expect_equal(sampleSizeResult6$followUpTime, 9.9154676, tolerance = 1e-07) expect_equal(sampleSizeResult6$eventsFixed, 65.345659, tolerance = 1e-07) expect_equal(sampleSizeResult6$nFixed, 300) expect_equal(sampleSizeResult6$nFixed1, 150) expect_equal(sampleSizeResult6$nFixed2, 150) expect_equal(sampleSizeResult6$analysisTime[1, ], 23.551831, tolerance = 1e-07) expect_equal(sampleSizeResult6$studyDuration, 23.551831, tolerance = 1e-07) expect_equal(sampleSizeResult6$criticalValuesEffectScale[1, ], 0.61574672, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult6), NA))) expect_output(print(sampleSizeResult6)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult6), NA))) expect_output(summary(sampleSizeResult6)$show()) sampleSizeResult6CodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult6, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResult6CodeBased$directionUpper, sampleSizeResult6$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResult6CodeBased$median1, sampleSizeResult6$median1, tolerance = 1e-05) expect_equal(sampleSizeResult6CodeBased$median2, sampleSizeResult6$median2, tolerance = 1e-05) expect_equal(sampleSizeResult6CodeBased$hazardRatio, sampleSizeResult6$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResult6CodeBased$maxNumberOfEvents, sampleSizeResult6$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResult6CodeBased$followUpTime, sampleSizeResult6$followUpTime, tolerance = 1e-05) expect_equal(sampleSizeResult6CodeBased$eventsFixed, sampleSizeResult6$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResult6CodeBased$nFixed, sampleSizeResult6$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResult6CodeBased$nFixed1, sampleSizeResult6$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResult6CodeBased$nFixed2, sampleSizeResult6$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResult6CodeBased$analysisTime, sampleSizeResult6$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResult6CodeBased$studyDuration, sampleSizeResult6$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResult6CodeBased$criticalValuesEffectScale, sampleSizeResult6$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult6), "character") df <- as.data.frame(sampleSizeResult6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} sampleSizeResult7 <- getSampleSizeSurvival(accrualTime = c(0, 3), accrualIntensity = c(22, 53), lambda2 = 0.02, lambda1 = c(0.01), followUpTime = 44) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult7' with expected results expect_equal(sampleSizeResult7$directionUpper, FALSE) expect_equal(sampleSizeResult7$median1, 69.314718, tolerance = 1e-07) expect_equal(sampleSizeResult7$median2, 34.657359, tolerance = 1e-07) expect_equal(sampleSizeResult7$hazardRatio, 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult7$maxNumberOfSubjects, 135.32074, tolerance = 1e-07) expect_equal(sampleSizeResult7$maxNumberOfEvents, 65.345659, tolerance = 1e-07) expect_equal(sampleSizeResult7$accrualTime, c(3, 4.3079386), tolerance = 1e-07) expect_equal(sampleSizeResult7$totalAccrualTime, 4.3079386, tolerance = 1e-07) expect_equal(sampleSizeResult7$eventsFixed, 65.345659, tolerance = 1e-07) expect_equal(sampleSizeResult7$nFixed, 135.32074, tolerance = 1e-07) expect_equal(sampleSizeResult7$nFixed1, 67.660372, tolerance = 1e-07) expect_equal(sampleSizeResult7$nFixed2, 67.660372, tolerance = 1e-07) expect_equal(sampleSizeResult7$analysisTime[1, ], 48.307942, tolerance = 1e-07) expect_equal(sampleSizeResult7$studyDuration, 48.307942, tolerance = 1e-07) expect_equal(sampleSizeResult7$criticalValuesEffectScale[1, ], 0.61574672, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult7), NA))) expect_output(print(sampleSizeResult7)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult7), NA))) expect_output(summary(sampleSizeResult7)$show()) sampleSizeResult7CodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult7, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResult7CodeBased$directionUpper, sampleSizeResult7$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResult7CodeBased$median1, sampleSizeResult7$median1, tolerance = 1e-05) expect_equal(sampleSizeResult7CodeBased$median2, sampleSizeResult7$median2, tolerance = 1e-05) expect_equal(sampleSizeResult7CodeBased$hazardRatio, sampleSizeResult7$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResult7CodeBased$maxNumberOfSubjects, sampleSizeResult7$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResult7CodeBased$maxNumberOfEvents, sampleSizeResult7$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResult7CodeBased$accrualTime, sampleSizeResult7$accrualTime, tolerance = 1e-05) expect_equal(sampleSizeResult7CodeBased$totalAccrualTime, sampleSizeResult7$totalAccrualTime, tolerance = 1e-05) expect_equal(sampleSizeResult7CodeBased$eventsFixed, sampleSizeResult7$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResult7CodeBased$nFixed, sampleSizeResult7$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResult7CodeBased$nFixed1, sampleSizeResult7$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResult7CodeBased$nFixed2, sampleSizeResult7$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResult7CodeBased$analysisTime, sampleSizeResult7$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResult7CodeBased$studyDuration, sampleSizeResult7$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResult7CodeBased$criticalValuesEffectScale, sampleSizeResult7$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult7), "character") df <- as.data.frame(sampleSizeResult7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getSampleSizeSurvival} # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} sampleSizeResult8 <- getSampleSizeSurvival(accrualTime = c(0, 6), accrualIntensity = c(22), lambda2 = 0.02, lambda1 = c(0.01)) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeResult8' with expected results expect_equal(sampleSizeResult8$directionUpper, FALSE) expect_equal(sampleSizeResult8$median1, 69.314718, tolerance = 1e-07) expect_equal(sampleSizeResult8$median2, 34.657359, tolerance = 1e-07) expect_equal(sampleSizeResult8$hazardRatio, 0.5, tolerance = 1e-07) expect_equal(sampleSizeResult8$maxNumberOfSubjects, 132) expect_equal(sampleSizeResult8$maxNumberOfEvents, 65.345659, tolerance = 1e-07) expect_equal(sampleSizeResult8$followUpTime, 44.431065, tolerance = 1e-07) expect_equal(sampleSizeResult8$eventsFixed, 65.345659, tolerance = 1e-07) expect_equal(sampleSizeResult8$nFixed, 132) expect_equal(sampleSizeResult8$nFixed1, 66) expect_equal(sampleSizeResult8$nFixed2, 66) expect_equal(sampleSizeResult8$analysisTime[1, ], 50.431065, tolerance = 1e-07) expect_equal(sampleSizeResult8$studyDuration, 50.431065, tolerance = 1e-07) expect_equal(sampleSizeResult8$criticalValuesEffectScale[1, ], 0.61574672, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult8), NA))) expect_output(print(sampleSizeResult8)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult8), NA))) expect_output(summary(sampleSizeResult8)$show()) sampleSizeResult8CodeBased <- eval(parse(text = getObjectRCode(sampleSizeResult8, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeResult8CodeBased$directionUpper, sampleSizeResult8$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeResult8CodeBased$median1, sampleSizeResult8$median1, tolerance = 1e-05) expect_equal(sampleSizeResult8CodeBased$median2, sampleSizeResult8$median2, tolerance = 1e-05) expect_equal(sampleSizeResult8CodeBased$hazardRatio, sampleSizeResult8$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeResult8CodeBased$maxNumberOfSubjects, sampleSizeResult8$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeResult8CodeBased$maxNumberOfEvents, sampleSizeResult8$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeResult8CodeBased$followUpTime, sampleSizeResult8$followUpTime, tolerance = 1e-05) expect_equal(sampleSizeResult8CodeBased$eventsFixed, sampleSizeResult8$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeResult8CodeBased$nFixed, sampleSizeResult8$nFixed, tolerance = 1e-05) expect_equal(sampleSizeResult8CodeBased$nFixed1, sampleSizeResult8$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeResult8CodeBased$nFixed2, sampleSizeResult8$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeResult8CodeBased$analysisTime, sampleSizeResult8$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeResult8CodeBased$studyDuration, sampleSizeResult8$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeResult8CodeBased$criticalValuesEffectScale, sampleSizeResult8$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeResult8), "character") df <- as.data.frame(sampleSizeResult8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeResult8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': analysis time at last stage equals accrual time + follow-up time", { .skipTestIfDisabled() x1 <- getSampleSizeSurvival(getDesignGroupSequential(typeOfDesign = "P"), accrualTime = 12, maxNumberOfSubjects = 766, pi2 = 0.05, pi1 = 0.1) expect_equal(x1$analysisTime[3], x1$accrualTime + x1$followUpTime) x2 <- getSampleSizeSurvival(getDesignGroupSequential(typeOfDesign = "P"), accrualTime = 12, maxNumberOfSubjects = 766, lambda2 = 0.005, lambda1 = 0.01) expect_equal(x2$analysisTime[3], x2$accrualTime + x2$followUpTime) x3 <- getSampleSizeSurvival(getDesignGroupSequential(typeOfDesign = "WT", deltaWT = 0), accrualTime = c(0, 12, 15), accrualIntensity = c(20, 30), lambda2 = 0.005, lambda1 = 0.01) expect_equal(x3$analysisTime[length(x3$analysisTime)], x3$accrualTime[length(x3$accrualTime)] + x3$followUpTime) x4 <- getSampleSizeSurvival(getDesignGroupSequential(typeOfDesign = "WT", deltaWT = 0), accrualTime = c(0, 12, 15), accrualIntensity = c(40, 60), piecewiseSurvivalTime = c(0, 5), lambda2 = c(0.005, 0.01), hazardRatio = 0.8) expect_equal(x4$analysisTime[length(x4$analysisTime)], x4$accrualTime[length(x4$accrualTime)] + x4$followUpTime) }) test_that("'getSampleSizeSurvival': follow-up time is equal for different argument-target constellations", { designGS1 <- getDesignGroupSequential(informationRates = c(0.2,0.5,1), sided = 1, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) x5 <- getSampleSizeSurvival(designGS1, typeOfComputation = "Schoenfeld", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 1) x6 <- getSampleSizeSurvival(designGS1, typeOfComputation = "Schoenfeld", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 14, accrualTime = 8, maxNumberOfSubjects = x5$maxNumberOfSubjects, accountForObservationTimes = TRUE, allocationRatioPlanned = 1) expect_equal(x5$followUpTime, x6$followUpTime) .skipTestIfDisabled() x7 <- getSampleSizeSurvival(designGS1, typeOfComputation = "Freedman", thetaH0 = 1, median1 = 44, median2 = 66, accrualTime = 43, followUpTime = 22, accountForObservationTimes = TRUE, allocationRatioPlanned = 2) x8 <- getSampleSizeSurvival(designGS1, typeOfComputation = "Freedman", thetaH0 = 1, median1 = 44, median2 = 66, accrualTime = 43, maxNumberOfSubjects = x7$maxNumberOfSubjects, accountForObservationTimes = TRUE, allocationRatioPlanned = 2) expect_equal(x7$followUpTime, x8$followUpTime) x9 <- getSampleSizeSurvival(designGS1, typeOfComputation = "HsiehFreedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 16, accrualTime = 8, followUpTime = 10, accountForObservationTimes = TRUE, allocationRatioPlanned = 0.2) x10 <- getSampleSizeSurvival(designGS1, typeOfComputation = "HsiehFreedman", thetaH0 = 1, pi1 = 0.4, pi2 = 0.2, eventTime = 16, accrualTime = 8, maxNumberOfSubjects = x9$maxNumberOfSubjects, accountForObservationTimes = TRUE, allocationRatioPlanned = 0.2) expect_equal(x9$followUpTime, x10$followUpTime) }) test_that("'getSampleSizeSurvival': testing expected warnings and errors", { expect_error(getSampleSizeSurvival(accrualTime = c(0, 6), accrualIntensity = c(22, 53), lambda2 = 0.02, lambda1 = c(0.01, 0.015), followUpTime = 5), paste0("Illegal argument: the calulation of 'maxNumberOfSubjects' for given 'followUpTime' ", "is only available for a single 'lambda1'; lambda1 = c(0.01, 0.015)"), fixed = TRUE) expect_error(getSampleSizeSurvival(accrualTime = c(0, 6), accrualIntensity = c(22, 53), lambda2 = 0.02, median1 = c(5, 6), followUpTime = 5), paste0("Illegal argument: the calulation of 'maxNumberOfSubjects' for given 'followUpTime' ", "is only available for a single 'lambda1'; lambda1 = c(0.139, 0.116)"), fixed = TRUE) expect_error(getSampleSizeSurvival(accrualTime = c(0, 6), accrualIntensity = c(22, 53), median2 = 4, median1 = c(5, 6), followUpTime = 5), paste0("Illegal argument: the calulation of 'maxNumberOfSubjects' for given 'followUpTime' ", "is only available for a single 'median1'; median1 = c(5, 6)"), fixed = TRUE) expect_error(getSampleSizeSurvival(accrualTime = c(0, 6), accrualIntensity = c(22, 53), pi2 = 0.213, pi1 = c(0.113, 0.165), followUpTime = 5), paste0("Illegal argument: the calulation of 'maxNumberOfSubjects' for given 'followUpTime' ", "is only available for a single 'pi1'; pi1 = c(0.113, 0.165)"), fixed = TRUE) expect_error(getSampleSizeSurvival(accrualTime = c(0), pi1 = c(0.4, 0.5), accrualIntensity = c(22), followUpTime = 6), paste0("Illegal argument: the calulation of 'maxNumberOfSubjects' for given 'followUpTime' ", "is only available for a single 'pi1'; pi1 = c(0.4, 0.5)"), fixed = TRUE) expect_error(getSampleSizeSurvival(lambda2 = -1, hazardRatio = 2), "Argument out of bounds: 'lambda2' (-1) must be >= 0", fixed = TRUE) expect_error(getSampleSizeSurvival(lambda2 = 0, hazardRatio = 2), "Illegal argument: 'lambda2' (0) not allowed: at least one lambda value must be > 0", fixed = TRUE) expect_error(getSampleSizeSurvival(lambda2 = 0.9, hazardRatio = 0.8, kappa = 0), "Argument out of bounds: 'kappa' (0) must be > 0", fixed = TRUE) expect_error(getSampleSizeSurvival(pi1 = getPiByMedian(0.1), pi2 = getPiByMedian(0.2))) expect_warning(getSampleSizeSurvival(median1 = 0.1, median2 = 0.2, eventTime = 0.5), "'eventTime' (0.5) will be ignored", fixed = TRUE) expect_error(getSampleSizeSurvival(lambda2 = 0.2, hazardRatio = c(0.6, 0.7), followUpTime = 8, accrualIntensity = 30, accrualTime = 0)) expect_error(getSampleSizeSurvival(lambda1 = c(0.02, 0.03), lambda2 = 0.2, hazardRatio = 0.6, followUpTime = 8, accrualIntensity = 30, accrualTime = 0)) expect_error(getSampleSizeSurvival(lambda2 = c(0.02, 0.03), piecewiseSurvivalTime = c(0, 12), hazardRatio = c(0.6, 0.8), followUpTime = 8, accrualIntensity = 30, accrualTime = 0)) expect_warning(getSampleSizeSurvival(median1 = 0.1, median2 = 0.2, eventTime = 4), "'eventTime' (4) will be ignored", fixed = TRUE) .skipTestIfDisabled() expect_warning(getSampleSizeSurvival(accrualTime = c(0, 6), accrualIntensity = c(22, 53), lambda2 = 0.02, lambda1 = c(0.01), followUpTime = -1), "Accrual duration longer than maximal study duration (time to maximal number of events); followUpTime = -1", fixed = TRUE) expect_warning(getSampleSizeSurvival(accrualTime = c(0, 6, 30), pi1 = 0.4, accrualIntensity = c(0.22, 0.53), maxNumberOfSubjects = 1000), "Accrual duration longer than maximal study duration (time to maximal number of events); followUpTime = -17.501", fixed = TRUE) ######################################################################################################################## ######################################################################################################################## }) context("Testing Other Functions of the Sample Size Calculator for Survival Designs") test_that("'getEventProbabilities': check expected events over time for overall survival (case 1)", { .skipTestIfDisabled() design <- getDesignGroupSequential( sided = 1, alpha = 0.025, beta = 0.2, informationRates = c(0.33, 0.7, 1), futilityBounds = c(0, 0), bindingFutility = FALSE) piecewiseSurvivalTime <- list( "0 - <6" = 0.025, "6 - <9" = 0.04, "9 - <15" = 0.015, "15 - <21" = 0.01, ">=21" = 0.007) accrualTime <- list( "0 - <12" = 15, "12 - <13" = 21, "13 - <14" = 27, "14 - <15" = 33, "15 - <16" = 39, ">=16" = 45) powerResults <- getPowerSurvival( design = design, typeOfComputation = "Schoenfeld", thetaH0 = 1, directionUpper = FALSE, dropoutRate1 = 0.05, dropoutRate2 = 0.05, dropoutTime = 12, allocationRatioPlanned = 1, accrualTime = accrualTime, piecewiseSurvivalTime = piecewiseSurvivalTime, hazardRatio = seq(0.6, 1, 0.05), maxNumberOfEvents = 404, maxNumberOfSubjects = 1405) piecewiseSurvivalTimeOS <- list( "0 - <14" = 0.015, "14 - <24" = 0.01, "24 - <44" = 0.005, ">=44" = 0.0025 ) timeOS <- c(powerResults$analysisTime[2:3, 4], 17 + 3.5 * 12) eventsOS <- getEventProbabilities( timeOS, accrualTime = accrualTime, piecewiseSurvivalTime = piecewiseSurvivalTimeOS, kappa = 1, allocationRatioPlanned = 1, hazardRatio = 0.8, dropoutRate1 = 0.05, dropoutRate2 = 0.05, dropoutTime = 12, maxNumberOfSubjects = 1405)$overallEventProbabilities eventsOS <- eventsOS * 1405 expect_equal(round(timeOS, 2), c(37.60, 46.72, 59.00)) expect_equal(round(eventsOS, 1), c(194.1, 288.7, 365.1)) }) test_that("'getEventProbabilities': check expected events over time for overall survival (case 2)", { .skipTestIfDisabled() accrualTime <- list( "0 - <12" = 15, "12 - <13" = 21, "13 - <14" = 27, "14 - <15" = 33, "15 - <16" = 39, ">=16" = 45) piecewiseSurvivalTimeOS <- list( "0 - <14" = 0.015, "14 - <24" = 0.01, "24 - <44" = 0.005, ">=44" = 0.0025 ) timeOS <- c(37.59823, 46.71658, 59) eventsOS <- getEventProbabilities( timeOS, accrualTime = accrualTime, piecewiseSurvivalTime = piecewiseSurvivalTimeOS, kappa = 1, allocationRatioPlanned = 1, hazardRatio = 0.8, dropoutRate1 = 0.05, dropoutRate2 = 0.05, dropoutTime = 12, maxNumberOfSubjects = 1405) # @refFS[Formula]{fs:sampleSizeSurvivalExponentialPieceWiseAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalGeneralPieceWiseAccrual} # @refFS[Formula]{fs:pieceWiseExponentialSurvival} # @refFS[Formula]{fs:pieceWiseExponentialSurvivalWithDropOuts} ## Comparison of the results of EventProbabilities object 'eventsOS' with expected results expect_equal(eventsOS$lambda1, c(0.012, 0.008, 0.004, 0.002), tolerance = 1e-07) expect_equal(eventsOS$overallEventProbabilities, c(0.13811859, 0.20546928, 0.2598385), tolerance = 1e-07) expect_equal(eventsOS$eventProbabilities1, c(0.12437783, 0.18544801, 0.23527681), tolerance = 1e-07) expect_equal(eventsOS$eventProbabilities2, c(0.15185935, 0.22549055, 0.28440019), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(eventsOS), NA))) expect_output(print(eventsOS)$show()) invisible(capture.output(expect_error(summary(eventsOS), NA))) expect_output(summary(eventsOS)$show()) eventsOSCodeBased <- eval(parse(text = getObjectRCode(eventsOS, stringWrapParagraphWidth = NULL))) expect_equal(eventsOSCodeBased$lambda1, eventsOS$lambda1, tolerance = 1e-05) expect_equal(eventsOSCodeBased$overallEventProbabilities, eventsOS$overallEventProbabilities, tolerance = 1e-05) expect_equal(eventsOSCodeBased$eventProbabilities1, eventsOS$eventProbabilities1, tolerance = 1e-05) expect_equal(eventsOSCodeBased$eventProbabilities2, eventsOS$eventProbabilities2, tolerance = 1e-05) expect_type(names(eventsOS), "character") df <- as.data.frame(eventsOS) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(eventsOS) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getNumberOfSubjects': check the number of recruited subjects at given time vector", { .skipTestIfDisabled() accrualTime1 <- list( "0 - <12" = 12, "12 - <13" = 21, "13 - <14" = 27, "14 - <15" = 33, "15 - <16" = 39, ">=16" = 45) numberOfSubjects1 <- getNumberOfSubjects(time = 1:3, accrualTime = getAccrualTime(accrualTime1, maxNumberOfSubjects = 1405)) ## Comparison of the results of NumberOfSubjects object 'numberOfSubjects1' with expected results expect_equal(numberOfSubjects1$numberOfSubjects, c(12, 24, 36), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(numberOfSubjects1), NA))) expect_output(print(numberOfSubjects1)$show()) invisible(capture.output(expect_error(summary(numberOfSubjects1), NA))) expect_output(summary(numberOfSubjects1)$show()) numberOfSubjects1CodeBased <- eval(parse(text = getObjectRCode(numberOfSubjects1, stringWrapParagraphWidth = NULL))) expect_equal(numberOfSubjects1CodeBased$numberOfSubjects, numberOfSubjects1$numberOfSubjects, tolerance = 1e-05) expect_type(names(numberOfSubjects1), "character") df <- as.data.frame(numberOfSubjects1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(numberOfSubjects1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } accrualTime2 <- list( "0 - <12" = 12, "12 - <13" = 21, "13 - <14" = 27, "14 - <15" = 33, "15 - <16" = 39) # @refFS[Formula]{fs:sampleSizeSurvivalExponentialPieceWiseAccrual} # @refFS[Formula]{fs:sampleSizeSurvivalGeneralPieceWiseAccrual} numberOfSubjects2 <- getNumberOfSubjects(time = 1:3, accrualTime = getAccrualTime(accrualTime2)) ## Comparison of the results of NumberOfSubjects object 'numberOfSubjects2' with expected results expect_equal(numberOfSubjects2$maxNumberOfSubjects, 264) expect_equal(numberOfSubjects2$numberOfSubjects, c(12, 24, 36)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(numberOfSubjects2), NA))) expect_output(print(numberOfSubjects2)$show()) invisible(capture.output(expect_error(summary(numberOfSubjects2), NA))) expect_output(summary(numberOfSubjects2)$show()) numberOfSubjects2CodeBased <- eval(parse(text = getObjectRCode(numberOfSubjects2, stringWrapParagraphWidth = NULL))) expect_equal(numberOfSubjects2CodeBased$maxNumberOfSubjects, numberOfSubjects2$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(numberOfSubjects2CodeBased$numberOfSubjects, numberOfSubjects2$numberOfSubjects, tolerance = 1e-05) expect_type(names(numberOfSubjects2), "character") df <- as.data.frame(numberOfSubjects2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(numberOfSubjects2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': check the calulation of 'maxNumberOfSubjects' for given 'followUpTime'", { .skipTestIfDisabled() sampleSizeSurvival1 <- getSampleSizeSurvival(lambda2 = c(0.02, 0.03), piecewiseSurvivalTime = c(0, 12), hazardRatio = 0.6, followUpTime = 8, accrualIntensity = 30, accrualTime = 0) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeSurvival1' with expected results expect_equal(sampleSizeSurvival1$directionUpper, FALSE) expect_equal(sampleSizeSurvival1$lambda1, c(0.012, 0.018), tolerance = 1e-07) expect_equal(sampleSizeSurvival1$maxNumberOfSubjects, 484.65038, tolerance = 1e-07) expect_equal(sampleSizeSurvival1$maxNumberOfEvents, 120.3157, tolerance = 1e-07) expect_equal(sampleSizeSurvival1$accrualTime, 16.155013, tolerance = 1e-07) expect_equal(sampleSizeSurvival1$eventsFixed, 120.3157, tolerance = 1e-07) expect_equal(sampleSizeSurvival1$nFixed, 484.65038, tolerance = 1e-07) expect_equal(sampleSizeSurvival1$nFixed1, 242.32519, tolerance = 1e-07) expect_equal(sampleSizeSurvival1$nFixed2, 242.32519, tolerance = 1e-07) expect_equal(sampleSizeSurvival1$analysisTime[1, ], 24.155014, tolerance = 1e-07) expect_equal(sampleSizeSurvival1$studyDuration, 24.155014, tolerance = 1e-07) expect_equal(sampleSizeSurvival1$criticalValuesEffectScale[1, ], 0.6995143, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeSurvival1), NA))) expect_output(print(sampleSizeSurvival1)$show()) invisible(capture.output(expect_error(summary(sampleSizeSurvival1), NA))) expect_output(summary(sampleSizeSurvival1)$show()) sampleSizeSurvival1CodeBased <- eval(parse(text = getObjectRCode(sampleSizeSurvival1, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeSurvival1CodeBased$directionUpper, sampleSizeSurvival1$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$lambda1, sampleSizeSurvival1$lambda1, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$maxNumberOfSubjects, sampleSizeSurvival1$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$maxNumberOfEvents, sampleSizeSurvival1$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$accrualTime, sampleSizeSurvival1$accrualTime, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$eventsFixed, sampleSizeSurvival1$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$nFixed, sampleSizeSurvival1$nFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$nFixed1, sampleSizeSurvival1$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$nFixed2, sampleSizeSurvival1$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$analysisTime, sampleSizeSurvival1$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$studyDuration, sampleSizeSurvival1$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$criticalValuesEffectScale, sampleSizeSurvival1$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeSurvival1), "character") df <- as.data.frame(sampleSizeSurvival1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeSurvival1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } sampleSizeSurvival2 <- getSampleSizeSurvival(piecewiseSurvivalTime = list( "<12" = 0.02, ">=12" = 0.03), hazardRatio = 0.6, followUpTime = 8, accrualIntensity = 30, accrualTime = 0) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeSurvival2' with expected results expect_equal(sampleSizeSurvival2$directionUpper, FALSE) expect_equal(sampleSizeSurvival2$lambda1, c(0.012, 0.018), tolerance = 1e-07) expect_equal(sampleSizeSurvival2$maxNumberOfSubjects, 484.65038, tolerance = 1e-07) expect_equal(sampleSizeSurvival2$maxNumberOfEvents, 120.3157, tolerance = 1e-07) expect_equal(sampleSizeSurvival2$accrualTime, 16.155013, tolerance = 1e-07) expect_equal(sampleSizeSurvival2$eventsFixed, 120.3157, tolerance = 1e-07) expect_equal(sampleSizeSurvival2$nFixed, 484.65038, tolerance = 1e-07) expect_equal(sampleSizeSurvival2$nFixed1, 242.32519, tolerance = 1e-07) expect_equal(sampleSizeSurvival2$nFixed2, 242.32519, tolerance = 1e-07) expect_equal(sampleSizeSurvival2$analysisTime[1, ], 24.155014, tolerance = 1e-07) expect_equal(sampleSizeSurvival2$studyDuration, 24.155014, tolerance = 1e-07) expect_equal(sampleSizeSurvival2$criticalValuesEffectScale[1, ], 0.6995143, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeSurvival2), NA))) expect_output(print(sampleSizeSurvival2)$show()) invisible(capture.output(expect_error(summary(sampleSizeSurvival2), NA))) expect_output(summary(sampleSizeSurvival2)$show()) sampleSizeSurvival2CodeBased <- eval(parse(text = getObjectRCode(sampleSizeSurvival2, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeSurvival2CodeBased$directionUpper, sampleSizeSurvival2$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$lambda1, sampleSizeSurvival2$lambda1, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$maxNumberOfSubjects, sampleSizeSurvival2$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$maxNumberOfEvents, sampleSizeSurvival2$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$accrualTime, sampleSizeSurvival2$accrualTime, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$eventsFixed, sampleSizeSurvival2$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$nFixed, sampleSizeSurvival2$nFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$nFixed1, sampleSizeSurvival2$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$nFixed2, sampleSizeSurvival2$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$analysisTime, sampleSizeSurvival2$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$studyDuration, sampleSizeSurvival2$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$criticalValuesEffectScale, sampleSizeSurvival2$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeSurvival2), "character") df <- as.data.frame(sampleSizeSurvival2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeSurvival2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } sampleSizeSurvival3 <- getSampleSizeSurvival(lambda2 = c(0.02, 0.03), piecewiseSurvivalTime = c(0, 12), hazardRatio = 0.6, followUpTime = 8, accrualIntensity = 30, accrualTime = 0) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeSurvival3' with expected results expect_equal(sampleSizeSurvival3$directionUpper, FALSE) expect_equal(sampleSizeSurvival3$lambda1, c(0.012, 0.018), tolerance = 1e-07) expect_equal(sampleSizeSurvival3$maxNumberOfSubjects, 484.65038, tolerance = 1e-07) expect_equal(sampleSizeSurvival3$maxNumberOfEvents, 120.3157, tolerance = 1e-07) expect_equal(sampleSizeSurvival3$accrualTime, 16.155013, tolerance = 1e-07) expect_equal(sampleSizeSurvival3$eventsFixed, 120.3157, tolerance = 1e-07) expect_equal(sampleSizeSurvival3$nFixed, 484.65038, tolerance = 1e-07) expect_equal(sampleSizeSurvival3$nFixed1, 242.32519, tolerance = 1e-07) expect_equal(sampleSizeSurvival3$nFixed2, 242.32519, tolerance = 1e-07) expect_equal(sampleSizeSurvival3$analysisTime[1, ], 24.155014, tolerance = 1e-07) expect_equal(sampleSizeSurvival3$studyDuration, 24.155014, tolerance = 1e-07) expect_equal(sampleSizeSurvival3$criticalValuesEffectScale[1, ], 0.6995143, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeSurvival3), NA))) expect_output(print(sampleSizeSurvival3)$show()) invisible(capture.output(expect_error(summary(sampleSizeSurvival3), NA))) expect_output(summary(sampleSizeSurvival3)$show()) sampleSizeSurvival3CodeBased <- eval(parse(text = getObjectRCode(sampleSizeSurvival3, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeSurvival3CodeBased$directionUpper, sampleSizeSurvival3$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$lambda1, sampleSizeSurvival3$lambda1, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$maxNumberOfSubjects, sampleSizeSurvival3$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$maxNumberOfEvents, sampleSizeSurvival3$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$accrualTime, sampleSizeSurvival3$accrualTime, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$eventsFixed, sampleSizeSurvival3$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$nFixed, sampleSizeSurvival3$nFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$nFixed1, sampleSizeSurvival3$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$nFixed2, sampleSizeSurvival3$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$analysisTime, sampleSizeSurvival3$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$studyDuration, sampleSizeSurvival3$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$criticalValuesEffectScale, sampleSizeSurvival3$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeSurvival3), "character") df <- as.data.frame(sampleSizeSurvival3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeSurvival3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } sampleSizeSurvival4 <- getSampleSizeSurvival(lambda2 = c(0.02, 0.03), piecewiseSurvivalTime = c(0, 12), hazardRatio = 0.8, followUpTime = 8, accrualIntensity = 30, accrualTime = 0) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeSurvival4' with expected results expect_equal(sampleSizeSurvival4$directionUpper, FALSE) expect_equal(sampleSizeSurvival4$lambda1, c(0.016, 0.024), tolerance = 1e-07) expect_equal(sampleSizeSurvival4$maxNumberOfSubjects, 1325.4661, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$maxNumberOfEvents, 630.52017, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$accrualTime, 44.182203, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$eventsFixed, 630.52017, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$nFixed, 1325.4661, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$nFixed1, 662.73305, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$nFixed2, 662.73305, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$analysisTime[1, ], 52.182201, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$studyDuration, 52.182201, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$criticalValuesEffectScale[1, ], 0.85546574, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeSurvival4), NA))) expect_output(print(sampleSizeSurvival4)$show()) invisible(capture.output(expect_error(summary(sampleSizeSurvival4), NA))) expect_output(summary(sampleSizeSurvival4)$show()) sampleSizeSurvival4CodeBased <- eval(parse(text = getObjectRCode(sampleSizeSurvival4, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeSurvival4CodeBased$directionUpper, sampleSizeSurvival4$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$lambda1, sampleSizeSurvival4$lambda1, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$maxNumberOfSubjects, sampleSizeSurvival4$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$maxNumberOfEvents, sampleSizeSurvival4$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$accrualTime, sampleSizeSurvival4$accrualTime, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$eventsFixed, sampleSizeSurvival4$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$nFixed, sampleSizeSurvival4$nFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$nFixed1, sampleSizeSurvival4$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$nFixed2, sampleSizeSurvival4$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$analysisTime, sampleSizeSurvival4$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$studyDuration, sampleSizeSurvival4$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$criticalValuesEffectScale, sampleSizeSurvival4$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeSurvival4), "character") df <- as.data.frame(sampleSizeSurvival4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeSurvival4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } sampleSizeSurvival5 <- getSampleSizeSurvival(lambda1 = 0.03, lambda2 = 0.02, followUpTime = 8, accrualIntensity = 30, accrualTime = 0) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeSurvival5' with expected results expect_equal(sampleSizeSurvival5$directionUpper, TRUE) expect_equal(sampleSizeSurvival5$median1, 23.104906, tolerance = 1e-07) expect_equal(sampleSizeSurvival5$median2, 34.657359, tolerance = 1e-07) expect_equal(sampleSizeSurvival5$hazardRatio, 1.5, tolerance = 1e-07) expect_equal(sampleSizeSurvival5$maxNumberOfSubjects, 557.38443, tolerance = 1e-07) expect_equal(sampleSizeSurvival5$maxNumberOfEvents, 190.96804, tolerance = 1e-07) expect_equal(sampleSizeSurvival5$accrualTime, 18.579481, tolerance = 1e-07) expect_equal(sampleSizeSurvival5$eventsFixed, 190.96804, tolerance = 1e-07) expect_equal(sampleSizeSurvival5$nFixed, 557.38443, tolerance = 1e-07) expect_equal(sampleSizeSurvival5$nFixed1, 278.69222, tolerance = 1e-07) expect_equal(sampleSizeSurvival5$nFixed2, 278.69222, tolerance = 1e-07) expect_equal(sampleSizeSurvival5$analysisTime[1, ], 26.579477, tolerance = 1e-07) expect_equal(sampleSizeSurvival5$studyDuration, 26.579477, tolerance = 1e-07) expect_equal(sampleSizeSurvival5$criticalValuesEffectScale[1, ], 1.327981, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeSurvival5), NA))) expect_output(print(sampleSizeSurvival5)$show()) invisible(capture.output(expect_error(summary(sampleSizeSurvival5), NA))) expect_output(summary(sampleSizeSurvival5)$show()) sampleSizeSurvival5CodeBased <- eval(parse(text = getObjectRCode(sampleSizeSurvival5, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeSurvival5CodeBased$directionUpper, sampleSizeSurvival5$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeSurvival5CodeBased$median1, sampleSizeSurvival5$median1, tolerance = 1e-05) expect_equal(sampleSizeSurvival5CodeBased$median2, sampleSizeSurvival5$median2, tolerance = 1e-05) expect_equal(sampleSizeSurvival5CodeBased$hazardRatio, sampleSizeSurvival5$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeSurvival5CodeBased$maxNumberOfSubjects, sampleSizeSurvival5$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeSurvival5CodeBased$maxNumberOfEvents, sampleSizeSurvival5$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeSurvival5CodeBased$accrualTime, sampleSizeSurvival5$accrualTime, tolerance = 1e-05) expect_equal(sampleSizeSurvival5CodeBased$eventsFixed, sampleSizeSurvival5$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival5CodeBased$nFixed, sampleSizeSurvival5$nFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival5CodeBased$nFixed1, sampleSizeSurvival5$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeSurvival5CodeBased$nFixed2, sampleSizeSurvival5$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeSurvival5CodeBased$analysisTime, sampleSizeSurvival5$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeSurvival5CodeBased$studyDuration, sampleSizeSurvival5$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeSurvival5CodeBased$criticalValuesEffectScale, sampleSizeSurvival5$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeSurvival5), "character") df <- as.data.frame(sampleSizeSurvival5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeSurvival5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSampleSizeSurvival': check calculations for fixed design with relative accrual intensity", { # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} sampleSizeSurvival1 <- getSampleSizeSurvival(accrualIntensity = 0.1, accrualTime = 10) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeSurvival1' with expected results expect_equal(sampleSizeSurvival1$directionUpper, c(TRUE, TRUE, TRUE)) expect_equal(sampleSizeSurvival1$median1, c(16.282985, 12, 9.0776496), tolerance = 1e-07) expect_equal(sampleSizeSurvival1$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeSurvival1$lambda1, c(0.042568802, 0.057762265, 0.076357561), tolerance = 1e-07) expect_equal(sampleSizeSurvival1$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeSurvival1$hazardRatio, c(2.2892242, 3.1062837, 4.1062837), tolerance = 1e-07) expect_equal(sampleSizeSurvival1$maxNumberOfEvents, c(45.770282, 24.438835, 15.735459), tolerance = 1e-07) expect_equal(sampleSizeSurvival1$accrualIntensity, c(16.554072, 7.5582097, 4.2441939), tolerance = 1e-07) expect_equal(sampleSizeSurvival1$eventsFixed, c(45.770282, 24.438835, 15.735459), tolerance = 1e-07) expect_equal(sampleSizeSurvival1$nFixed, c(165.54072, 75.582097, 42.441939), tolerance = 1e-07) expect_equal(sampleSizeSurvival1$nFixed1, c(82.77036, 37.791048, 21.220969), tolerance = 1e-07) expect_equal(sampleSizeSurvival1$nFixed2, c(82.77036, 37.791048, 21.220969), tolerance = 1e-07) expect_equal(sampleSizeSurvival1$analysisTime[1, ], 16) expect_equal(sampleSizeSurvival1$studyDuration, 16) expect_equal(sampleSizeSurvival1$criticalValuesEffectScale[1, ], c(1.7849857, 2.2098739, 2.686355), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeSurvival1), NA))) expect_output(print(sampleSizeSurvival1)$show()) invisible(capture.output(expect_error(summary(sampleSizeSurvival1), NA))) expect_output(summary(sampleSizeSurvival1)$show()) sampleSizeSurvival1CodeBased <- eval(parse(text = getObjectRCode(sampleSizeSurvival1, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeSurvival1CodeBased$directionUpper, sampleSizeSurvival1$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$median1, sampleSizeSurvival1$median1, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$median2, sampleSizeSurvival1$median2, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$lambda1, sampleSizeSurvival1$lambda1, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$lambda2, sampleSizeSurvival1$lambda2, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$hazardRatio, sampleSizeSurvival1$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$maxNumberOfEvents, sampleSizeSurvival1$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$accrualIntensity, sampleSizeSurvival1$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$eventsFixed, sampleSizeSurvival1$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$nFixed, sampleSizeSurvival1$nFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$nFixed1, sampleSizeSurvival1$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$nFixed2, sampleSizeSurvival1$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$analysisTime, sampleSizeSurvival1$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$studyDuration, sampleSizeSurvival1$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeSurvival1CodeBased$criticalValuesEffectScale, sampleSizeSurvival1$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeSurvival1), "character") df <- as.data.frame(sampleSizeSurvival1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeSurvival1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} sampleSizeSurvival2 <- getSampleSizeSurvival(accrualIntensity = 0.99, accrualTime = c(0, 10)) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeSurvival2' with expected results expect_equal(sampleSizeSurvival2$directionUpper, c(TRUE, TRUE, TRUE)) expect_equal(sampleSizeSurvival2$median1, c(16.282985, 12, 9.0776496), tolerance = 1e-07) expect_equal(sampleSizeSurvival2$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeSurvival2$lambda1, c(0.042568802, 0.057762265, 0.076357561), tolerance = 1e-07) expect_equal(sampleSizeSurvival2$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeSurvival2$hazardRatio, c(2.2892242, 3.1062837, 4.1062837), tolerance = 1e-07) expect_equal(sampleSizeSurvival2$maxNumberOfEvents, c(45.770282, 24.438835, 15.735459), tolerance = 1e-07) expect_equal(sampleSizeSurvival2$accrualIntensity, c(16.554072, 7.5582097, 4.2441939), tolerance = 1e-07) expect_equal(sampleSizeSurvival2$eventsFixed, c(45.770282, 24.438835, 15.735459), tolerance = 1e-07) expect_equal(sampleSizeSurvival2$nFixed, c(165.54072, 75.582097, 42.441939), tolerance = 1e-07) expect_equal(sampleSizeSurvival2$nFixed1, c(82.77036, 37.791048, 21.220969), tolerance = 1e-07) expect_equal(sampleSizeSurvival2$nFixed2, c(82.77036, 37.791048, 21.220969), tolerance = 1e-07) expect_equal(sampleSizeSurvival2$analysisTime[1, ], 16) expect_equal(sampleSizeSurvival2$studyDuration, 16) expect_equal(sampleSizeSurvival2$criticalValuesEffectScale[1, ], c(1.7849857, 2.2098739, 2.686355), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeSurvival2), NA))) expect_output(print(sampleSizeSurvival2)$show()) invisible(capture.output(expect_error(summary(sampleSizeSurvival2), NA))) expect_output(summary(sampleSizeSurvival2)$show()) sampleSizeSurvival2CodeBased <- eval(parse(text = getObjectRCode(sampleSizeSurvival2, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeSurvival2CodeBased$directionUpper, sampleSizeSurvival2$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$median1, sampleSizeSurvival2$median1, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$median2, sampleSizeSurvival2$median2, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$lambda1, sampleSizeSurvival2$lambda1, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$lambda2, sampleSizeSurvival2$lambda2, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$hazardRatio, sampleSizeSurvival2$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$maxNumberOfEvents, sampleSizeSurvival2$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$accrualIntensity, sampleSizeSurvival2$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$eventsFixed, sampleSizeSurvival2$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$nFixed, sampleSizeSurvival2$nFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$nFixed1, sampleSizeSurvival2$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$nFixed2, sampleSizeSurvival2$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$analysisTime, sampleSizeSurvival2$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$studyDuration, sampleSizeSurvival2$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeSurvival2CodeBased$criticalValuesEffectScale, sampleSizeSurvival2$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeSurvival2), "character") df <- as.data.frame(sampleSizeSurvival2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeSurvival2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} sampleSizeSurvival3 <- getSampleSizeSurvival(accrualIntensity = 1e-12, accrualTime = c(0, 10)) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeSurvival3' with expected results expect_equal(sampleSizeSurvival3$directionUpper, c(TRUE, TRUE, TRUE)) expect_equal(sampleSizeSurvival3$median1, c(16.282985, 12, 9.0776496), tolerance = 1e-07) expect_equal(sampleSizeSurvival3$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeSurvival3$lambda1, c(0.042568802, 0.057762265, 0.076357561), tolerance = 1e-07) expect_equal(sampleSizeSurvival3$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeSurvival3$hazardRatio, c(2.2892242, 3.1062837, 4.1062837), tolerance = 1e-07) expect_equal(sampleSizeSurvival3$maxNumberOfEvents, c(45.770282, 24.438835, 15.735459), tolerance = 1e-07) expect_equal(sampleSizeSurvival3$accrualIntensity, c(16.554072, 7.5582097, 4.2441939), tolerance = 1e-07) expect_equal(sampleSizeSurvival3$eventsFixed, c(45.770282, 24.438835, 15.735459), tolerance = 1e-07) expect_equal(sampleSizeSurvival3$nFixed, c(165.54072, 75.582097, 42.441939), tolerance = 1e-07) expect_equal(sampleSizeSurvival3$nFixed1, c(82.77036, 37.791048, 21.220969), tolerance = 1e-07) expect_equal(sampleSizeSurvival3$nFixed2, c(82.77036, 37.791048, 21.220969), tolerance = 1e-07) expect_equal(sampleSizeSurvival3$analysisTime[1, ], 16) expect_equal(sampleSizeSurvival3$studyDuration, 16) expect_equal(sampleSizeSurvival3$criticalValuesEffectScale[1, ], c(1.7849857, 2.2098739, 2.686355), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeSurvival3), NA))) expect_output(print(sampleSizeSurvival3)$show()) invisible(capture.output(expect_error(summary(sampleSizeSurvival3), NA))) expect_output(summary(sampleSizeSurvival3)$show()) sampleSizeSurvival3CodeBased <- eval(parse(text = getObjectRCode(sampleSizeSurvival3, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeSurvival3CodeBased$directionUpper, sampleSizeSurvival3$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$median1, sampleSizeSurvival3$median1, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$median2, sampleSizeSurvival3$median2, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$lambda1, sampleSizeSurvival3$lambda1, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$lambda2, sampleSizeSurvival3$lambda2, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$hazardRatio, sampleSizeSurvival3$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$maxNumberOfEvents, sampleSizeSurvival3$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$accrualIntensity, sampleSizeSurvival3$accrualIntensity, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$eventsFixed, sampleSizeSurvival3$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$nFixed, sampleSizeSurvival3$nFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$nFixed1, sampleSizeSurvival3$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$nFixed2, sampleSizeSurvival3$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$analysisTime, sampleSizeSurvival3$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$studyDuration, sampleSizeSurvival3$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeSurvival3CodeBased$criticalValuesEffectScale, sampleSizeSurvival3$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeSurvival3), "character") df <- as.data.frame(sampleSizeSurvival3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeSurvival3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Formula]{fs:sampleSizeSurvivalDefinitionPieceWiseAccrual} expect_equal(sampleSizeSurvival1$accrualIntensity, sampleSizeSurvival2$accrualIntensity) expect_equal(sampleSizeSurvival1$accrualIntensity, sampleSizeSurvival3$accrualIntensity) sampleSizeSurvival4 <- getSampleSizeSurvival(accrualIntensity = 1, accrualTime = c(0, 50), pi1 = 0.4) ## Comparison of the results of TrialDesignPlanSurvival object 'sampleSizeSurvival4' with expected results expect_equal(sampleSizeSurvival4$directionUpper, TRUE) expect_equal(sampleSizeSurvival4$median1, 16.282985, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$median2, 37.275405, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$lambda1, 0.042568802, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$lambda2, 0.018595296, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$hazardRatio, 2.2892242, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$maxNumberOfSubjects, 50) expect_equal(sampleSizeSurvival4$maxNumberOfEvents, 45.770282, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$followUpTime, 77.550073, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$eventsFixed, 45.770282, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$nFixed, 50) expect_equal(sampleSizeSurvival4$nFixed1, 25) expect_equal(sampleSizeSurvival4$nFixed2, 25) expect_equal(sampleSizeSurvival4$analysisTime[1, ], 127.55007, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$studyDuration, 127.55007, tolerance = 1e-07) expect_equal(sampleSizeSurvival4$criticalValuesEffectScale[1, ], 1.7849857, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeSurvival4), NA))) expect_output(print(sampleSizeSurvival4)$show()) invisible(capture.output(expect_error(summary(sampleSizeSurvival4), NA))) expect_output(summary(sampleSizeSurvival4)$show()) sampleSizeSurvival4CodeBased <- eval(parse(text = getObjectRCode(sampleSizeSurvival4, stringWrapParagraphWidth = NULL))) expect_equal(sampleSizeSurvival4CodeBased$directionUpper, sampleSizeSurvival4$directionUpper, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$median1, sampleSizeSurvival4$median1, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$median2, sampleSizeSurvival4$median2, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$lambda1, sampleSizeSurvival4$lambda1, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$lambda2, sampleSizeSurvival4$lambda2, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$hazardRatio, sampleSizeSurvival4$hazardRatio, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$maxNumberOfSubjects, sampleSizeSurvival4$maxNumberOfSubjects, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$maxNumberOfEvents, sampleSizeSurvival4$maxNumberOfEvents, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$followUpTime, sampleSizeSurvival4$followUpTime, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$eventsFixed, sampleSizeSurvival4$eventsFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$nFixed, sampleSizeSurvival4$nFixed, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$nFixed1, sampleSizeSurvival4$nFixed1, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$nFixed2, sampleSizeSurvival4$nFixed2, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$analysisTime, sampleSizeSurvival4$analysisTime, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$studyDuration, sampleSizeSurvival4$studyDuration, tolerance = 1e-05) expect_equal(sampleSizeSurvival4CodeBased$criticalValuesEffectScale, sampleSizeSurvival4$criticalValuesEffectScale, tolerance = 1e-05) expect_type(names(sampleSizeSurvival4), "character") df <- as.data.frame(sampleSizeSurvival4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(sampleSizeSurvival4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'.getLambdaStepFunctionByTime': return correct lambda for specified time and piecewise exponential bounds", { # @refFS[Formula]{fs:pieceWiseExponentialSurvival} # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} lambda1 <- .getLambdaStepFunctionByTime(time = 1, c(6, 9, 15, 21), c(0.025, 0.04, 0.015, 0.01, 0.007)) ## Comparison of the results of numeric object 'lambda1' with expected results expect_equal(lambda1, 0.025, tolerance = 1e-07) # @refFS[Formula]{fs:pieceWiseExponentialSurvival} # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} lambda2 <- .getLambdaStepFunctionByTime(time = 6, c(6, 9, 15, 21), c(0.025, 0.04, 0.015, 0.01, 0.007)) ## Comparison of the results of numeric object 'lambda2' with expected results expect_equal(lambda2, 0.025, tolerance = 1e-07) # @refFS[Formula]{fs:pieceWiseExponentialSurvival} # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} lambda3 <- .getLambdaStepFunctionByTime(time = 7, c(6, 9, 15, 21), c(0.025, 0.04, 0.015, 0.01, 0.007)) ## Comparison of the results of numeric object 'lambda3' with expected results expect_equal(lambda3, 0.04, tolerance = 1e-07) # @refFS[Formula]{fs:pieceWiseExponentialSurvival} # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} lambda4 <- .getLambdaStepFunctionByTime(time = 9, c(6, 9, 15, 21), c(0.025, 0.04, 0.015, 0.01, 0.007)) ## Comparison of the results of numeric object 'lambda4' with expected results expect_equal(lambda4, 0.04, tolerance = 1e-07) # @refFS[Formula]{fs:pieceWiseExponentialSurvival} # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} lambda5 <- .getLambdaStepFunctionByTime(time = 14, c(6, 9, 15, 21), c(0.025, 0.04, 0.015, 0.01, 0.007)) ## Comparison of the results of numeric object 'lambda5' with expected results expect_equal(lambda5, 0.015, tolerance = 1e-07) # @refFS[Formula]{fs:pieceWiseExponentialSurvival} # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} lambda6 <- .getLambdaStepFunctionByTime(time = 15, c(6, 9, 15, 21), c(0.025, 0.04, 0.015, 0.01, 0.007)) ## Comparison of the results of numeric object 'lambda6' with expected results expect_equal(lambda6, 0.015, tolerance = 1e-07) # @refFS[Formula]{fs:pieceWiseExponentialSurvival} # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} lambda7 <- .getLambdaStepFunctionByTime(time = 16, c(6, 9, 15, 21), c(0.025, 0.04, 0.015, 0.01, 0.007)) ## Comparison of the results of numeric object 'lambda7' with expected results expect_equal(lambda7, 0.01, tolerance = 1e-07) # @refFS[Formula]{fs:pieceWiseExponentialSurvival} # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} lambda8 <- .getLambdaStepFunctionByTime(time = 21, c(6, 9, 15, 21), c(0.025, 0.04, 0.015, 0.01, 0.007)) ## Comparison of the results of numeric object 'lambda8' with expected results expect_equal(lambda8, 0.01, tolerance = 1e-07) # @refFS[Formula]{fs:pieceWiseExponentialSurvival} # @refFS[Formula]{fs:pieceWiseExponentialRandomVariable} lambda9 <- rpact:::.getLambdaStepFunctionByTime(time = 50, c(6, 9, 15, 21), c(0.025, 0.04, 0.015, 0.01, 0.007)) ## Comparison of the results of numeric object 'lambda9' with expected results expect_equal(lambda9, 0.007, tolerance = 1e-07) }) rpact/tests/testthat/test-f_core_assertions.R0000644000175000017500000002577114154142422021341 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_core_assertions.R ## | Creation date: 08 December 2021, 09:08:43 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Assertion Functions") test_that("Testing '.assertIsInClosedInterval'", { invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 0, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 1, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 0.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 0.9999, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) invisible(capture.output(expect_error(.assertIsInClosedInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) invisible(capture.output(expect_error(.assertIsInClosedInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) invisible(capture.output(expect_error(.assertIsInClosedInterval(x = c(1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) invisible(capture.output(expect_error(.assertIsInClosedInterval(x = c(NA_real_, 0, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) expect_error(.assertIsInClosedInterval(x = -0.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) expect_error(.assertIsInClosedInterval(x = -0.0001, xName = "x", lower = 0, upper = NA_real_, naAllowed = FALSE)) expect_error(.assertIsInClosedInterval(x = 1.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) expect_error(.assertIsInClosedInterval(x = c(1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) expect_error(.assertIsInClosedInterval(x = c(-1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE)) expect_error(.assertIsInClosedInterval(x = c(NA_real_, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) expect_error(.assertIsInClosedInterval(x = c(0, -1, 1, 2), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) }) test_that("Testing '.assertIsInOpenInterval'", { invisible(capture.output(expect_error(.assertIsInOpenInterval(x = 0.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) invisible(capture.output(expect_error(.assertIsInOpenInterval(x = 0.9999, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) invisible(capture.output(expect_error(.assertIsInOpenInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) invisible(capture.output(expect_error(.assertIsInOpenInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) invisible(capture.output(expect_error(.assertIsInOpenInterval(x = c(0.9999, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) invisible(capture.output(expect_error(.assertIsInOpenInterval(x = c(NA_real_, 0.0001, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) expect_error(.assertIsInOpenInterval(x = 0, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) expect_error(.assertIsInOpenInterval(x = 0, xName = "x", lower = 0, upper = NA_real_, naAllowed = FALSE)) expect_error(.assertIsInOpenInterval(x = 1, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) expect_error(.assertIsInOpenInterval(x = c(1.0001, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) expect_error(.assertIsInOpenInterval(x = c(-1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE)) expect_error(.assertIsInOpenInterval(x = c(NA_real_, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) expect_error(.assertIsInOpenInterval(x = c(0, -1, 1, 2), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) }) test_that("Testing '.assertDesignParameterExists'", { expect_error(.assertDesignParameterExists(), "Missing argument: 'design' must be defined", fixed = TRUE) expect_error(.assertDesignParameterExists(design = getAssertionTestDesign()), "Missing argument: 'parameterName' must be defined", fixed = TRUE) expect_error(.assertDesignParameterExists(design = getAssertionTestDesign(), parameterName = "kMax"), "Missing argument: 'defaultValue' must be defined", fixed = TRUE) expect_error(.assertDesignParameterExists(design = getAssertionTestDesign(), parameterName = "kMax", defaultValue = C_KMAX_DEFAULT), "Missing argument: parameter 'kMax' must be specified in design", fixed = TRUE) expect_error(.assertDesignParameterExists(design = getAssertionTestDesign(kMax = NA_integer_), parameterName = "kMax", defaultValue = C_KMAX_DEFAULT), "Missing argument: parameter 'kMax' must be specified in design", fixed = TRUE) }) test_that("Testing '.assertIsValidThetaRange' ", { expect_error(.assertIsValidThetaRange(thetaRange = c()), "Illegal argument: 'thetaRange' (NULL) must be a vector with two entries defining minimum and maximum or a sequence of numeric values with length > 2", fixed = TRUE) expect_error(.assertIsValidThetaRange(thetaRange = c(1, -2)), "Illegal argument: 'thetaRange' with length 2 must contain minimum < maximum (1 >= -2)", fixed = TRUE) expect_equal(.assertIsValidThetaRange(thetaRange = c(1, 2, 3)), c(1, 2, 3)) expect_equal(.assertIsValidThetaRange(thetaRange = c(-1, 2)), seq(-1, 2, 3 / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT)) }) test_that("Testing '.assertIsSingleNumber'", { expect_error(.assertIsSingleNumber(NA, "x"), "Illegal argument: 'x' (NA) must be a valid numeric value", fixed = TRUE) expect_error(.assertIsSingleNumber(NULL, "x"), "Missing argument: 'x' must be a valid numeric value", fixed = TRUE) expect_error(.assertIsSingleNumber(c(1, 2), "x"), "Illegal argument: 'x' c(1, 2) must be a single numeric value", fixed = TRUE) expect_error(.assertIsSingleNumber(numeric(0), "x"), "Missing argument: 'x' must be a valid numeric value", fixed = TRUE) }) test_that("Testing '.assertAssociatedArgumentsAreDefined'", { expect_error(.assertAssociatedArgumentsAreDefined(a = NA, b = 1), "Missing argument: 'a' must be defined because 'b' is defined", fixed = TRUE) expect_error(.assertAssociatedArgumentsAreDefined(a = NA, b = 1, c = NA), "Missing argument: 'a', 'c' must be defined because 'b' is defined", fixed = TRUE) expect_error(.assertAssociatedArgumentsAreDefined(a = NA, b = 1, c = 2), "Missing argument: 'a' must be defined because 'b', 'c' are defined", fixed = TRUE) }) test_that("Testing '.associatedArgumentsAreDefined'", { expect_equal(.associatedArgumentsAreDefined(nPlanned = NA_real_, thetaH1 = NA_real_), FALSE) expect_warning(expect_equal(.associatedArgumentsAreDefined(nPlanned = NA_real_, thetaH1 = 1), FALSE), "Incomplete associated arguments: 'nPlanned' should be defined because 'thetaH1' is defined", fixed = TRUE) expect_equal(.associatedArgumentsAreDefined(nPlanned = 1, thetaH1 = 1), TRUE) }) test_that("Testing '.isValidNPlanned'", { expect_equal(.isValidNPlanned(nPlanned = c(1, 2), kMax = 4, stage = 2), TRUE) expect_silent(.isValidNPlanned(nPlanned = NA_real_, kMax = 4, stage = 2)) expect_warning(.isValidNPlanned(nPlanned = c(1), kMax = 4, stage = 2), "'nPlanned' (1) will be ignored: length must be equal to 2 (kMax - stage = 4 - 2)", fixed = TRUE) expect_warning(.isValidNPlanned(nPlanned = c(1, 2, 3), kMax = 4, stage = 2), "'nPlanned' (1, 2, 3) will be ignored: length must be equal to 2 (kMax - stage = 4 - 2)", fixed = TRUE) }) test_that("Testing '.assertIsValidSummaryIntervalFormat'", { .assertIsValidSummaryIntervalFormat("[%s; %s]") .assertIsValidSummaryIntervalFormat("%s - %s") .assertIsValidSummaryIntervalFormat("(%s, %s)") expect_error(.assertIsValidSummaryIntervalFormat("[%s; %s; %s]")) expect_error(.assertIsValidSummaryIntervalFormat("[%s]")) expect_error(.assertIsValidSummaryIntervalFormat("")) expect_error(.assertIsValidSummaryIntervalFormat(1)) }) test_that("Testing '.assertIsSingleInteger'", { expect_error(.assertIsSingleInteger(NA_integer_, "x", naAllowed = FALSE)) expect_error(.assertIsSingleInteger(-1, "x", naAllowed = FALSE)) expect_error(.assertIsSingleInteger(-1, "x", naAllowed = FALSE, validateType = FALSE), NA) expect_error(.assertIsSingleInteger(NA_integer_, "x", naAllowed = TRUE), NA) expect_error(.assertIsSingleInteger(-1, "x", naAllowed = TRUE)) expect_error(.assertIsSingleInteger("1", "x", naAllowed = TRUE)) expect_error(.assertIsSingleInteger(1, "x", naAllowed = TRUE, validateType = TRUE)) expect_error(.assertIsSingleInteger(1, "x", naAllowed = TRUE, validateType = FALSE), NA) }) test_that("Testing '.assertIsSinglePositiveInteger'", { expect_error(.assertIsSinglePositiveInteger(NA_integer_, "x", naAllowed = FALSE)) expect_error(.assertIsSinglePositiveInteger(-1, "x", naAllowed = FALSE)) expect_error(.assertIsSinglePositiveInteger(NA_integer_, "x", naAllowed = TRUE), NA) expect_error(.assertIsSinglePositiveInteger(NA_real_, "x", naAllowed = TRUE)) expect_error(.assertIsSinglePositiveInteger(-1, "x", naAllowed = TRUE)) expect_error(.assertIsSinglePositiveInteger("1", "x", naAllowed = TRUE)) expect_error(.assertIsSinglePositiveInteger(1, "x", naAllowed = TRUE, validateType = TRUE)) expect_error(.assertIsSinglePositiveInteger(1, "x", naAllowed = TRUE, validateType = FALSE), NA) }) test_that("Testing '.assertIsSingleLogical'", { expect_error(.assertIsSingleLogical("TRUE", "x", naAllowed = FALSE)) expect_error(.assertIsSingleLogical("FALSE", "x", naAllowed = FALSE)) expect_error(.assertIsSingleLogical(TRUE, "x", naAllowed = FALSE), NA) expect_error(.assertIsSingleLogical(FALSE, "x", naAllowed = FALSE), NA) expect_error(.assertIsSingleLogical(NA, "x", naAllowed = TRUE), NA) expect_error(.assertIsSingleLogical(NA, "x", naAllowed = FALSE)) }) test_that("Testing '.assertIsValidMatrix'", { expect_error(.assertIsValidMatrix(c(), "x", naAllowed = FALSE)) expect_error(.assertIsValidMatrix(NULL, "x", naAllowed = FALSE)) expect_error(.assertIsValidMatrix(1:3, "x", naAllowed = FALSE)) expect_error(.assertIsValidMatrix(1:3, "x", naAllowed = TRUE)) expect_error(.assertIsValidMatrix("a", "x", naAllowed = FALSE)) expect_error(.assertIsValidMatrix("a", "x", naAllowed = TRUE)) expect_error(.assertIsValidMatrix(NA, "x", naAllowed = FALSE)) expect_error(.assertIsValidMatrix(NA, "x", naAllowed = TRUE)) }) rpact/tests/testthat/test-f_core_utilities.R0000644000175000017500000023643114154142422021157 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_core_utilities.R ## | Creation date: 08 December 2021, 09:08:44 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Result Object Print Output") test_that("The output does not contain any issues", { expect_equal(sum(grepl("ISSUES", capture.output(getDesignGroupSequential()$show()))), 0) expect_equal(sum(grepl("ISSUES", capture.output(getDesignInverseNormal(kMax = 4)$show()))), 0) expect_equal(sum(grepl("ISSUES", capture.output(getDesignFisher()$show()))), 0) expect_equal(sum(grepl("ISSUES", capture.output(getSampleSizeMeans(getDesignGroupSequential())$show()))), 0) expect_equal(sum(grepl("ISSUES", capture.output(getSampleSizeRates()$show()))), 0) expect_equal(sum(grepl("ISSUES", capture.output(getSampleSizeSurvival(getDesignInverseNormal(kMax = 2))$show()))), 0) }) context("Testing Core Utility Functions") test_that("'getValidatedInformationRates': 'informationRates' must be generated correctly based on specified 'kMax'", { .skipTestIfDisabled() design1 <- getTestDesign(kMax = 1L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design1), 1, tolerance = 1e-08) design2 <- getTestDesign(kMax = 2L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design2), c(0.5, 1), tolerance = 1e-08) design3 <- getTestDesign(kMax = 3L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design3), c(0.33333333, 0.66666667, 1), tolerance = 1e-08) design4 <- getTestDesign(kMax = 4L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design4), c(0.25, 0.5, 0.75, 1), tolerance = 1e-08) design5 <- getTestDesign(kMax = 5L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design5), c(0.2, 0.4, 0.6, 0.8, 1), tolerance = 1e-08) design6 <- getTestDesign(kMax = 6L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design6), c(0.16666667, 0.33333333, 0.5, 0.66666667, 0.83333333, 1), tolerance = 1e-08) design7 <- getTestDesign(kMax = 1L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design7), 1, tolerance = 1e-08) design8 <- getTestDesign(kMax = 2L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design8), c(0.5, 1), tolerance = 1e-08) design9 <- getTestDesign(kMax = 3L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design9), c(0.33333333, 0.66666667, 1), tolerance = 1e-08) design10 <- getTestDesign(kMax = 4L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design10), c(0.25, 0.5, 0.75, 1), tolerance = 1e-08) design11 <- getTestDesign(kMax = 5L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design11), c(0.2, 0.4, 0.6, 0.8, 1), tolerance = 1e-08) design12 <- getTestDesign(kMax = 6L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design12), c(0.16666667, 0.33333333, 0.5, 0.66666667, 0.83333333, 1), tolerance = 1e-08) design13 <- getTestDesign(kMax = 1L, designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design13), 1, tolerance = 1e-08) design14 <- getTestDesign(kMax = 2L, designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design14), c(0.5, 1), tolerance = 1e-08) design15 <- getTestDesign(kMax = 3L, designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design15), c(0.33333333, 0.66666667, 1), tolerance = 1e-08) design16 <- getTestDesign(kMax = 4L, designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design16), c(0.25, 0.5, 0.75, 1), tolerance = 1e-08) design17 <- getTestDesign(kMax = 5L, designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design17), c(0.2, 0.4, 0.6, 0.8, 1), tolerance = 1e-08) design18 <- getTestDesign(kMax = 6L, designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design18), c(0.16666667, 0.33333333, 0.5, 0.66666667, 0.83333333, 1), tolerance = 1e-08) }) test_that("'getValidatedInformationRates': 'informationRates' must be set correctly based on specified 'informationRates'", { .skipTestIfDisabled() design19 <- getTestDesign(informationRates = 1, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design19), 1, tolerance = 1e-07) design20 <- getTestDesign(informationRates = c(0.4, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design20), c(0.4, 1), tolerance = 1e-07) design21 <- getTestDesign(informationRates = c(0.26666667, 0.53333333, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design21), c(0.26666667, 0.53333333, 1), tolerance = 1e-07) design22 <- getTestDesign(informationRates = c(0.2, 0.4, 0.6, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design22), c(0.2, 0.4, 0.6, 1), tolerance = 1e-07) design23 <- getTestDesign(informationRates = c(0.16, 0.32, 0.48, 0.64, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design23), c(0.16, 0.32, 0.48, 0.64, 1), tolerance = 1e-07) design24 <- getTestDesign(informationRates = c(0.13333333, 0.26666667, 0.4, 0.53333333, 0.66666667, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design24), c(0.13333333, 0.26666667, 0.4, 0.53333333, 0.66666667, 1), tolerance = 1e-07) design25 <- getTestDesign(informationRates = 1, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design25), 1, tolerance = 1e-07) design26 <- getTestDesign(informationRates = c(0.4, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design26), c(0.4, 1), tolerance = 1e-07) design27 <- getTestDesign(informationRates = c(0.26666667, 0.53333333, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design27), c(0.26666667, 0.53333333, 1), tolerance = 1e-07) design28 <- getTestDesign(informationRates = c(0.2, 0.4, 0.6, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design28), c(0.2, 0.4, 0.6, 1), tolerance = 1e-07) design29 <- getTestDesign(informationRates = c(0.16, 0.32, 0.48, 0.64, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design29), c(0.16, 0.32, 0.48, 0.64, 1), tolerance = 1e-07) design30 <- getTestDesign(informationRates = c(0.13333333, 0.26666667, 0.4, 0.53333333, 0.66666667, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design30), c(0.13333333, 0.26666667, 0.4, 0.53333333, 0.66666667, 1), tolerance = 1e-07) design31 <- getTestDesign(informationRates = 1, designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design31), 1, tolerance = 1e-07) design32 <- getTestDesign(informationRates = c(0.4, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design32), c(0.4, 1), tolerance = 1e-07) design33 <- getTestDesign(informationRates = c(0.26666667, 0.53333333, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design33), c(0.26666667, 0.53333333, 1), tolerance = 1e-07) design34 <- getTestDesign(informationRates = c(0.2, 0.4, 0.6, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design34), c(0.2, 0.4, 0.6, 1), tolerance = 1e-07) design35 <- getTestDesign(informationRates = c(0.16, 0.32, 0.48, 0.64, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design35), c(0.16, 0.32, 0.48, 0.64, 1), tolerance = 1e-07) design36 <- getTestDesign(informationRates = c(0.13333333, 0.26666667, 0.4, 0.53333333, 0.66666667, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design36), c(0.13333333, 0.26666667, 0.4, 0.53333333, 0.66666667, 1), tolerance = 1e-07) design37 <- getTestDesign(futilityBounds = 2, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design37), c(0.5, 1), tolerance = 1e-07) design38 <- getTestDesign(futilityBounds = c(1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design38), c(0.33333333, 0.66666667, 1), tolerance = 1e-07) design39 <- getTestDesign(futilityBounds = c(0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design39), c(0.25, 0.5, 0.75, 1), tolerance = 1e-07) design40 <- getTestDesign(futilityBounds = c(0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design40), c(0.2, 0.4, 0.6, 0.8, 1), tolerance = 1e-07) design41 <- getTestDesign(futilityBounds = c(0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedInformationRates(design41), c(0.16666667, 0.33333333, 0.5, 0.66666667, 0.83333333, 1), tolerance = 1e-07) design42 <- getTestDesign(futilityBounds = 2, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design42), c(0.5, 1), tolerance = 1e-07) design43 <- getTestDesign(futilityBounds = c(1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design43), c(0.33333333, 0.66666667, 1), tolerance = 1e-07) design44 <- getTestDesign(futilityBounds = c(0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design44), c(0.25, 0.5, 0.75, 1), tolerance = 1e-07) design45 <- getTestDesign(futilityBounds = c(0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design45), c(0.2, 0.4, 0.6, 0.8, 1), tolerance = 1e-07) design46 <- getTestDesign(futilityBounds = c(0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedInformationRates(design46), c(0.16666667, 0.33333333, 0.5, 0.66666667, 0.83333333, 1), tolerance = 1e-07) design47 <- getTestDesign(futilityBounds = 0.5, designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design47), c(0.5, 1), tolerance = 1e-07) design48 <- getTestDesign(futilityBounds = c(0.5, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design48), c(0.33333333, 0.66666667, 1), tolerance = 1e-07) design49 <- getTestDesign(futilityBounds = c(0.01, 0.5, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design49), c(0.25, 0.5, 0.75, 1), tolerance = 1e-07) design50 <- getTestDesign(futilityBounds = c(0.01, 0.01, 0.5, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design50), c(0.2, 0.4, 0.6, 0.8, 1), tolerance = 1e-07) design51 <- getTestDesign(futilityBounds = c(0.01, 0.01, 0.01, 0.5, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedInformationRates(design51), c(0.16666667, 0.33333333, 0.5, 0.66666667, 0.83333333, 1), tolerance = 1e-07) }) test_that("'getValidatedInformationRates': 'kMax' must be set correctly based on specified 'informationRates'", { .skipTestIfDisabled() design52 <- getTestDesign(informationRates = 1, designClass = "TrialDesignGroupSequential") expect_equal(design52$kMax, 1, tolerance = 1e-07) design53 <- getTestDesign(informationRates = c(0.4, 1), designClass = "TrialDesignGroupSequential") expect_equal(design53$kMax, 2, tolerance = 1e-07) design54 <- getTestDesign(informationRates = c(0.26666667, 0.53333333, 1), designClass = "TrialDesignGroupSequential") expect_equal(design54$kMax, 3, tolerance = 1e-07) design55 <- getTestDesign(informationRates = c(0.2, 0.4, 0.6, 1), designClass = "TrialDesignGroupSequential") expect_equal(design55$kMax, 4, tolerance = 1e-07) design56 <- getTestDesign(informationRates = c(0.16, 0.32, 0.48, 0.64, 1), designClass = "TrialDesignGroupSequential") expect_equal(design56$kMax, 5, tolerance = 1e-07) design57 <- getTestDesign(informationRates = c(0.13333333, 0.26666667, 0.4, 0.53333333, 0.66666667, 1), designClass = "TrialDesignGroupSequential") expect_equal(design57$kMax, 6, tolerance = 1e-07) design58 <- getTestDesign(informationRates = 1, designClass = "TrialDesignInverseNormal") expect_equal(design58$kMax, 1, tolerance = 1e-07) design59 <- getTestDesign(informationRates = c(0.4, 1), designClass = "TrialDesignInverseNormal") expect_equal(design59$kMax, 2, tolerance = 1e-07) design60 <- getTestDesign(informationRates = c(0.26666667, 0.53333333, 1), designClass = "TrialDesignInverseNormal") expect_equal(design60$kMax, 3, tolerance = 1e-07) design61 <- getTestDesign(informationRates = c(0.2, 0.4, 0.6, 1), designClass = "TrialDesignInverseNormal") expect_equal(design61$kMax, 4, tolerance = 1e-07) design62 <- getTestDesign(informationRates = c(0.16, 0.32, 0.48, 0.64, 1), designClass = "TrialDesignInverseNormal") expect_equal(design62$kMax, 5, tolerance = 1e-07) design63 <- getTestDesign(informationRates = c(0.13333333, 0.26666667, 0.4, 0.53333333, 0.66666667, 1), designClass = "TrialDesignInverseNormal") expect_equal(design63$kMax, 6, tolerance = 1e-07) design64 <- getTestDesign(informationRates = 1, designClass = "TrialDesignFisher") expect_equal(design64$kMax, 1, tolerance = 1e-07) design65 <- getTestDesign(informationRates = c(0.4, 1), designClass = "TrialDesignFisher") expect_equal(design65$kMax, 2, tolerance = 1e-07) design66 <- getTestDesign(informationRates = c(0.26666667, 0.53333333, 1), designClass = "TrialDesignFisher") expect_equal(design66$kMax, 3, tolerance = 1e-07) design67 <- getTestDesign(informationRates = c(0.2, 0.4, 0.6, 1), designClass = "TrialDesignFisher") expect_equal(design67$kMax, 4, tolerance = 1e-07) design68 <- getTestDesign(informationRates = c(0.16, 0.32, 0.48, 0.64, 1), designClass = "TrialDesignFisher") expect_equal(design68$kMax, 5, tolerance = 1e-07) design69 <- getTestDesign(informationRates = c(0.13333333, 0.26666667, 0.4, 0.53333333, 0.66666667, 1), designClass = "TrialDesignFisher") expect_equal(design69$kMax, 6, tolerance = 1e-07) design70 <- getTestDesign(futilityBounds = 2, designClass = "TrialDesignGroupSequential") expect_equal(design70$kMax, 2, tolerance = 1e-07) design71 <- getTestDesign(futilityBounds = c(1, 2), designClass = "TrialDesignGroupSequential") expect_equal(design71$kMax, 3, tolerance = 1e-07) design72 <- getTestDesign(futilityBounds = c(0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(design72$kMax, 4, tolerance = 1e-07) design73 <- getTestDesign(futilityBounds = c(0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(design73$kMax, 5, tolerance = 1e-07) design74 <- getTestDesign(futilityBounds = c(0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(design74$kMax, 6, tolerance = 1e-07) design75 <- getTestDesign(futilityBounds = 2, designClass = "TrialDesignInverseNormal") expect_equal(design75$kMax, 2, tolerance = 1e-07) design76 <- getTestDesign(futilityBounds = c(1, 2), designClass = "TrialDesignInverseNormal") expect_equal(design76$kMax, 3, tolerance = 1e-07) design77 <- getTestDesign(futilityBounds = c(0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(design77$kMax, 4, tolerance = 1e-07) design78 <- getTestDesign(futilityBounds = c(0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(design78$kMax, 5, tolerance = 1e-07) design79 <- getTestDesign(futilityBounds = c(0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(design79$kMax, 6, tolerance = 1e-07) design80 <- getTestDesign(futilityBounds = 0.5, designClass = "TrialDesignFisher") expect_equal(design80$kMax, 2, tolerance = 1e-07) design81 <- getTestDesign(futilityBounds = c(0.5, 1), designClass = "TrialDesignFisher") expect_equal(design81$kMax, 3, tolerance = 1e-07) design82 <- getTestDesign(futilityBounds = c(0.01, 0.5, 1), designClass = "TrialDesignFisher") expect_equal(design82$kMax, 4, tolerance = 1e-07) design83 <- getTestDesign(futilityBounds = c(0.01, 0.01, 0.5, 1), designClass = "TrialDesignFisher") expect_equal(design83$kMax, 5, tolerance = 1e-07) design84 <- getTestDesign(futilityBounds = c(0.01, 0.01, 0.01, 0.5, 1), designClass = "TrialDesignFisher") expect_equal(design84$kMax, 6, tolerance = 1e-07) }) test_that("'getValidatedInformationRates': 'futilityBounds' must be generated correctly based on specified 'kMax'", { .skipTestIfDisabled() design85 <- getTestDesign(kMax = 1L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design85), numeric(0), tolerance = 1e-08) design86 <- getTestDesign(kMax = 2L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design86), -6, tolerance = 1e-08) design87 <- getTestDesign(kMax = 3L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design87), c(-6, -6), tolerance = 1e-08) design88 <- getTestDesign(kMax = 4L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design88), c(-6, -6, -6), tolerance = 1e-08) design89 <- getTestDesign(kMax = 5L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design89), c(-6, -6, -6, -6), tolerance = 1e-08) design90 <- getTestDesign(kMax = 6L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design90), c(-6, -6, -6, -6, -6), tolerance = 1e-08) design91 <- getTestDesign(kMax = 7L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design91), c(-6, -6, -6, -6, -6, -6), tolerance = 1e-08) design92 <- getTestDesign(kMax = 8L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design92), c(-6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design93 <- getTestDesign(kMax = 9L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design93), c(-6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design94 <- getTestDesign(kMax = 10L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design94), c(-6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design95 <- getTestDesign(kMax = 11L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design95), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design96 <- getTestDesign(kMax = 12L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design96), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design97 <- getTestDesign(kMax = 13L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design97), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design98 <- getTestDesign(kMax = 14L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design98), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design99 <- getTestDesign(kMax = 15L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design99), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design100 <- getTestDesign(kMax = 16L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design100), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design101 <- getTestDesign(kMax = 17L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design101), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design102 <- getTestDesign(kMax = 18L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design102), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design103 <- getTestDesign(kMax = 19L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design103), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design104 <- getTestDesign(kMax = 20L, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design104), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design105 <- getTestDesign(kMax = 1L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design105), numeric(0), tolerance = 1e-08) design106 <- getTestDesign(kMax = 2L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design106), -6, tolerance = 1e-08) design107 <- getTestDesign(kMax = 3L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design107), c(-6, -6), tolerance = 1e-08) design108 <- getTestDesign(kMax = 4L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design108), c(-6, -6, -6), tolerance = 1e-08) design109 <- getTestDesign(kMax = 5L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design109), c(-6, -6, -6, -6), tolerance = 1e-08) design110 <- getTestDesign(kMax = 6L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design110), c(-6, -6, -6, -6, -6), tolerance = 1e-08) design111 <- getTestDesign(kMax = 7L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design111), c(-6, -6, -6, -6, -6, -6), tolerance = 1e-08) design112 <- getTestDesign(kMax = 8L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design112), c(-6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design113 <- getTestDesign(kMax = 9L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design113), c(-6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design114 <- getTestDesign(kMax = 10L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design114), c(-6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design115 <- getTestDesign(kMax = 11L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design115), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design116 <- getTestDesign(kMax = 12L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design116), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design117 <- getTestDesign(kMax = 13L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design117), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design118 <- getTestDesign(kMax = 14L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design118), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design119 <- getTestDesign(kMax = 15L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design119), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design120 <- getTestDesign(kMax = 16L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design120), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design121 <- getTestDesign(kMax = 17L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design121), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design122 <- getTestDesign(kMax = 18L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design122), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design123 <- getTestDesign(kMax = 19L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design123), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design124 <- getTestDesign(kMax = 20L, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design124), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-08) design125 <- getTestDesign(kMax = 1L, designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design125), numeric(0), tolerance = 1e-08) design126 <- getTestDesign(kMax = 2L, designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design126), 1, tolerance = 1e-08) design127 <- getTestDesign(kMax = 3L, designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design127), c(1, 1), tolerance = 1e-08) design128 <- getTestDesign(kMax = 4L, designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design128), c(1, 1, 1), tolerance = 1e-08) design129 <- getTestDesign(kMax = 5L, designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design129), c(1, 1, 1, 1), tolerance = 1e-08) design130 <- getTestDesign(kMax = 6L, designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design130), c(1, 1, 1, 1, 1), tolerance = 1e-08) }) test_that("'getValidatedInformationRates': 'futilityBounds' must be set correctly based on specified 'futilityBounds'", { .skipTestIfDisabled() design131 <- getTestDesign(futilityBounds = 2, designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design131), 2, tolerance = 1e-07) design132 <- getTestDesign(futilityBounds = c(1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design132), c(1, 2), tolerance = 1e-07) design133 <- getTestDesign(futilityBounds = c(0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design133), c(0, 1, 2), tolerance = 1e-07) design134 <- getTestDesign(futilityBounds = c(0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design134), c(0, 0, 1, 2), tolerance = 1e-07) design135 <- getTestDesign(futilityBounds = c(0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design135), c(0, 0, 0, 1, 2), tolerance = 1e-07) design136 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design136), c(0, 0, 0, 0, 1, 2), tolerance = 1e-07) design137 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design137), c(0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design138 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design138), c(0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design139 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design139), c(0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design140 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design140), c(0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design141 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design141), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design142 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design142), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design143 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design143), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design144 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design144), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design145 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design145), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design146 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design146), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design147 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design147), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design148 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design148), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design149 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design149), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design150 <- getTestDesign(futilityBounds = 2, designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design150), 2, tolerance = 1e-07) design151 <- getTestDesign(futilityBounds = c(1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design151), c(1, 2), tolerance = 1e-07) design152 <- getTestDesign(futilityBounds = c(0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design152), c(0, 1, 2), tolerance = 1e-07) design153 <- getTestDesign(futilityBounds = c(0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design153), c(0, 0, 1, 2), tolerance = 1e-07) design154 <- getTestDesign(futilityBounds = c(0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design154), c(0, 0, 0, 1, 2), tolerance = 1e-07) design155 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design155), c(0, 0, 0, 0, 1, 2), tolerance = 1e-07) design156 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design156), c(0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design157 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design157), c(0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design158 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design158), c(0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design159 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design159), c(0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design160 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design160), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design161 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design161), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design162 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design162), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design163 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design163), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design164 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design164), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design165 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design165), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design166 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design166), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design167 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design167), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design168 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design168), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), tolerance = 1e-07) design169 <- getTestDesign(futilityBounds = 0.5, designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design169), 0.5, tolerance = 1e-07) design170 <- getTestDesign(futilityBounds = c(0.5, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design170), c(0.5, 1), tolerance = 1e-07) design171 <- getTestDesign(futilityBounds = c(0.01, 0.5, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design171), c(0.01, 0.5, 1), tolerance = 1e-07) design172 <- getTestDesign(futilityBounds = c(0.01, 0.01, 0.5, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design172), c(0.01, 0.01, 0.5, 1), tolerance = 1e-07) design173 <- getTestDesign(futilityBounds = c(0.01, 0.01, 0.01, 0.5, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design173), c(0.01, 0.01, 0.01, 0.5, 1), tolerance = 1e-07) design174 <- getTestDesign(informationRates = c(0.4, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design174), -6, tolerance = 1e-07) design175 <- getTestDesign(informationRates = c(0.26666667, 0.53333333, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design175), c(-6, -6), tolerance = 1e-07) design176 <- getTestDesign(informationRates = c(0.2, 0.4, 0.6, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design176), c(-6, -6, -6), tolerance = 1e-07) design177 <- getTestDesign(informationRates = c(0.16, 0.32, 0.48, 0.64, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design177), c(-6, -6, -6, -6), tolerance = 1e-07) design178 <- getTestDesign(informationRates = c(0.13333333, 0.26666667, 0.4, 0.53333333, 0.66666667, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design178), c(-6, -6, -6, -6, -6), tolerance = 1e-07) design179 <- getTestDesign(informationRates = c(0.11428571, 0.22857143, 0.34285714, 0.45714286, 0.57142857, 0.68571429, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design179), c(-6, -6, -6, -6, -6, -6), tolerance = 1e-07) design180 <- getTestDesign(informationRates = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design180), c(-6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design181 <- getTestDesign(informationRates = c(0.088888889, 0.17777778, 0.26666667, 0.35555556, 0.44444444, 0.53333333, 0.62222222, 0.71111111, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design181), c(-6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design182 <- getTestDesign(informationRates = c(0.08, 0.16, 0.24, 0.32, 0.4, 0.48, 0.56, 0.64, 0.72, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design182), c(-6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design183 <- getTestDesign(informationRates = c(0.072727273, 0.14545455, 0.21818182, 0.29090909, 0.36363636, 0.43636364, 0.50909091, 0.58181818, 0.65454545, 0.72727273, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design183), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design184 <- getTestDesign(informationRates = c(0.066666667, 0.13333333, 0.2, 0.26666667, 0.33333333, 0.4, 0.46666667, 0.53333333, 0.6, 0.66666667, 0.73333333, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design184), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design185 <- getTestDesign(informationRates = c(0.061538462, 0.12307692, 0.18461538, 0.24615385, 0.30769231, 0.36923077, 0.43076923, 0.49230769, 0.55384615, 0.61538462, 0.67692308, 0.73846154, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design185), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design186 <- getTestDesign(informationRates = c(0.057142857, 0.11428571, 0.17142857, 0.22857143, 0.28571429, 0.34285714, 0.4, 0.45714286, 0.51428571, 0.57142857, 0.62857143, 0.68571429, 0.74285714, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design186), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design187 <- getTestDesign(informationRates = c(0.053333333, 0.10666667, 0.16, 0.21333333, 0.26666667, 0.32, 0.37333333, 0.42666667, 0.48, 0.53333333, 0.58666667, 0.64, 0.69333333, 0.74666667, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design187), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design188 <- getTestDesign(informationRates = c(0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design188), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design189 <- getTestDesign(informationRates = c(0.047058824, 0.094117647, 0.14117647, 0.18823529, 0.23529412, 0.28235294, 0.32941176, 0.37647059, 0.42352941, 0.47058824, 0.51764706, 0.56470588, 0.61176471, 0.65882353, 0.70588235, 0.75294118, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design189), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design190 <- getTestDesign(informationRates = c(0.044444444, 0.088888889, 0.13333333, 0.17777778, 0.22222222, 0.26666667, 0.31111111, 0.35555556, 0.4, 0.44444444, 0.48888889, 0.53333333, 0.57777778, 0.62222222, 0.66666667, 0.71111111, 0.75555556, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design190), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design191 <- getTestDesign(informationRates = c(0.042105263, 0.084210526, 0.12631579, 0.16842105, 0.21052632, 0.25263158, 0.29473684, 0.33684211, 0.37894737, 0.42105263, 0.46315789, 0.50526316, 0.54736842, 0.58947368, 0.63157895, 0.67368421, 0.71578947, 0.75789474, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design191), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design192 <- getTestDesign(informationRates = c(0.04, 0.08, 0.12, 0.16, 0.2, 0.24, 0.28, 0.32, 0.36, 0.4, 0.44, 0.48, 0.52, 0.56, 0.6, 0.64, 0.68, 0.72, 0.76, 1), designClass = "TrialDesignGroupSequential") expect_equal(.getValidatedFutilityBounds(design192), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design193 <- getTestDesign(informationRates = c(0.4, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design193), -6, tolerance = 1e-07) design194 <- getTestDesign(informationRates = c(0.26666667, 0.53333333, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design194), c(-6, -6), tolerance = 1e-07) design195 <- getTestDesign(informationRates = c(0.2, 0.4, 0.6, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design195), c(-6, -6, -6), tolerance = 1e-07) design196 <- getTestDesign(informationRates = c(0.16, 0.32, 0.48, 0.64, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design196), c(-6, -6, -6, -6), tolerance = 1e-07) design197 <- getTestDesign(informationRates = c(0.13333333, 0.26666667, 0.4, 0.53333333, 0.66666667, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design197), c(-6, -6, -6, -6, -6), tolerance = 1e-07) design198 <- getTestDesign(informationRates = c(0.11428571, 0.22857143, 0.34285714, 0.45714286, 0.57142857, 0.68571429, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design198), c(-6, -6, -6, -6, -6, -6), tolerance = 1e-07) design199 <- getTestDesign(informationRates = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design199), c(-6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design200 <- getTestDesign(informationRates = c(0.088888889, 0.17777778, 0.26666667, 0.35555556, 0.44444444, 0.53333333, 0.62222222, 0.71111111, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design200), c(-6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design201 <- getTestDesign(informationRates = c(0.08, 0.16, 0.24, 0.32, 0.4, 0.48, 0.56, 0.64, 0.72, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design201), c(-6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design202 <- getTestDesign(informationRates = c(0.072727273, 0.14545455, 0.21818182, 0.29090909, 0.36363636, 0.43636364, 0.50909091, 0.58181818, 0.65454545, 0.72727273, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design202), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design203 <- getTestDesign(informationRates = c(0.066666667, 0.13333333, 0.2, 0.26666667, 0.33333333, 0.4, 0.46666667, 0.53333333, 0.6, 0.66666667, 0.73333333, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design203), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design204 <- getTestDesign(informationRates = c(0.061538462, 0.12307692, 0.18461538, 0.24615385, 0.30769231, 0.36923077, 0.43076923, 0.49230769, 0.55384615, 0.61538462, 0.67692308, 0.73846154, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design204), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design205 <- getTestDesign(informationRates = c(0.057142857, 0.11428571, 0.17142857, 0.22857143, 0.28571429, 0.34285714, 0.4, 0.45714286, 0.51428571, 0.57142857, 0.62857143, 0.68571429, 0.74285714, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design205), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design206 <- getTestDesign(informationRates = c(0.053333333, 0.10666667, 0.16, 0.21333333, 0.26666667, 0.32, 0.37333333, 0.42666667, 0.48, 0.53333333, 0.58666667, 0.64, 0.69333333, 0.74666667, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design206), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design207 <- getTestDesign(informationRates = c(0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design207), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design208 <- getTestDesign(informationRates = c(0.047058824, 0.094117647, 0.14117647, 0.18823529, 0.23529412, 0.28235294, 0.32941176, 0.37647059, 0.42352941, 0.47058824, 0.51764706, 0.56470588, 0.61176471, 0.65882353, 0.70588235, 0.75294118, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design208), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design209 <- getTestDesign(informationRates = c(0.044444444, 0.088888889, 0.13333333, 0.17777778, 0.22222222, 0.26666667, 0.31111111, 0.35555556, 0.4, 0.44444444, 0.48888889, 0.53333333, 0.57777778, 0.62222222, 0.66666667, 0.71111111, 0.75555556, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design209), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design210 <- getTestDesign(informationRates = c(0.042105263, 0.084210526, 0.12631579, 0.16842105, 0.21052632, 0.25263158, 0.29473684, 0.33684211, 0.37894737, 0.42105263, 0.46315789, 0.50526316, 0.54736842, 0.58947368, 0.63157895, 0.67368421, 0.71578947, 0.75789474, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design210), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design211 <- getTestDesign(informationRates = c(0.04, 0.08, 0.12, 0.16, 0.2, 0.24, 0.28, 0.32, 0.36, 0.4, 0.44, 0.48, 0.52, 0.56, 0.6, 0.64, 0.68, 0.72, 0.76, 1), designClass = "TrialDesignInverseNormal") expect_equal(.getValidatedFutilityBounds(design211), c(-6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6, -6), tolerance = 1e-07) design212 <- getTestDesign(informationRates = c(0.4, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design212), 1, tolerance = 1e-07) design213 <- getTestDesign(informationRates = c(0.26666667, 0.53333333, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design213), c(1, 1), tolerance = 1e-07) design214 <- getTestDesign(informationRates = c(0.2, 0.4, 0.6, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design214), c(1, 1, 1), tolerance = 1e-07) design215 <- getTestDesign(informationRates = c(0.16, 0.32, 0.48, 0.64, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design215), c(1, 1, 1, 1), tolerance = 1e-07) design216 <- getTestDesign(informationRates = c(0.13333333, 0.26666667, 0.4, 0.53333333, 0.66666667, 1), designClass = "TrialDesignFisher") expect_equal(.getValidatedAlpha0Vec(design216), c(1, 1, 1, 1, 1), tolerance = 1e-07) }) test_that("'getValidatedInformationRates': 'kMax' must be set correctly based on specified 'futilityBounds'", { .skipTestIfDisabled() design217 <- getTestDesign(futilityBounds = 2, designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design217) expect_equal(design217$kMax, 2, tolerance = 1e-07) design218 <- getTestDesign(futilityBounds = c(1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design218) expect_equal(design218$kMax, 3, tolerance = 1e-07) design219 <- getTestDesign(futilityBounds = c(0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design219) expect_equal(design219$kMax, 4, tolerance = 1e-07) design220 <- getTestDesign(futilityBounds = c(0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design220) expect_equal(design220$kMax, 5, tolerance = 1e-07) design221 <- getTestDesign(futilityBounds = c(0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design221) expect_equal(design221$kMax, 6, tolerance = 1e-07) design222 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design222) expect_equal(design222$kMax, 7, tolerance = 1e-07) design223 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design223) expect_equal(design223$kMax, 8, tolerance = 1e-07) design224 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design224) expect_equal(design224$kMax, 9, tolerance = 1e-07) design225 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design225) expect_equal(design225$kMax, 10, tolerance = 1e-07) design226 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design226) expect_equal(design226$kMax, 11, tolerance = 1e-07) design227 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design227) expect_equal(design227$kMax, 12, tolerance = 1e-07) design228 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design228) expect_equal(design228$kMax, 13, tolerance = 1e-07) design229 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design229) expect_equal(design229$kMax, 14, tolerance = 1e-07) design230 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design230) expect_equal(design230$kMax, 15, tolerance = 1e-07) design231 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design231) expect_equal(design231$kMax, 16, tolerance = 1e-07) design232 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design232) expect_equal(design232$kMax, 17, tolerance = 1e-07) design233 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design233) expect_equal(design233$kMax, 18, tolerance = 1e-07) design234 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design234) expect_equal(design234$kMax, 19, tolerance = 1e-07) design235 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design235) expect_equal(design235$kMax, 20, tolerance = 1e-07) design236 <- getTestDesign(futilityBounds = 2, designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design236) expect_equal(design236$kMax, 2, tolerance = 1e-07) design237 <- getTestDesign(futilityBounds = c(1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design237) expect_equal(design237$kMax, 3, tolerance = 1e-07) design238 <- getTestDesign(futilityBounds = c(0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design238) expect_equal(design238$kMax, 4, tolerance = 1e-07) design239 <- getTestDesign(futilityBounds = c(0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design239) expect_equal(design239$kMax, 5, tolerance = 1e-07) design240 <- getTestDesign(futilityBounds = c(0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design240) expect_equal(design240$kMax, 6, tolerance = 1e-07) design241 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design241) expect_equal(design241$kMax, 7, tolerance = 1e-07) design242 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design242) expect_equal(design242$kMax, 8, tolerance = 1e-07) design243 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design243) expect_equal(design243$kMax, 9, tolerance = 1e-07) design244 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design244) expect_equal(design244$kMax, 10, tolerance = 1e-07) design245 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design245) expect_equal(design245$kMax, 11, tolerance = 1e-07) design246 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design246) expect_equal(design246$kMax, 12, tolerance = 1e-07) design247 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design247) expect_equal(design247$kMax, 13, tolerance = 1e-07) design248 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design248) expect_equal(design248$kMax, 14, tolerance = 1e-07) design249 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design249) expect_equal(design249$kMax, 15, tolerance = 1e-07) design250 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design250) expect_equal(design250$kMax, 16, tolerance = 1e-07) design251 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design251) expect_equal(design251$kMax, 17, tolerance = 1e-07) design252 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design252) expect_equal(design252$kMax, 18, tolerance = 1e-07) design253 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design253) expect_equal(design253$kMax, 19, tolerance = 1e-07) design254 <- getTestDesign(futilityBounds = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design254) expect_equal(design254$kMax, 20, tolerance = 1e-07) design255 <- getTestDesign(futilityBounds = 0.5, designClass = "TrialDesignFisher") .getValidatedAlpha0Vec(design255) expect_equal(design255$kMax, 2, tolerance = 1e-07) design256 <- getTestDesign(futilityBounds = c(0.5, 1), designClass = "TrialDesignFisher") .getValidatedAlpha0Vec(design256) expect_equal(design256$kMax, 3, tolerance = 1e-07) design257 <- getTestDesign(futilityBounds = c(0.01, 0.5, 1), designClass = "TrialDesignFisher") .getValidatedAlpha0Vec(design257) expect_equal(design257$kMax, 4, tolerance = 1e-07) design258 <- getTestDesign(futilityBounds = c(0.01, 0.01, 0.5, 1), designClass = "TrialDesignFisher") .getValidatedAlpha0Vec(design258) expect_equal(design258$kMax, 5, tolerance = 1e-07) design259 <- getTestDesign(futilityBounds = c(0.01, 0.01, 0.01, 0.5, 1), designClass = "TrialDesignFisher") .getValidatedAlpha0Vec(design259) expect_equal(design259$kMax, 6, tolerance = 1e-07) design260 <- getTestDesign(informationRates = c(0.4, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design260) expect_equal(design260$kMax, 2, tolerance = 1e-07) design261 <- getTestDesign(informationRates = c(0.26666667, 0.53333333, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design261) expect_equal(design261$kMax, 3, tolerance = 1e-07) design262 <- getTestDesign(informationRates = c(0.2, 0.4, 0.6, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design262) expect_equal(design262$kMax, 4, tolerance = 1e-07) design263 <- getTestDesign(informationRates = c(0.16, 0.32, 0.48, 0.64, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design263) expect_equal(design263$kMax, 5, tolerance = 1e-07) design264 <- getTestDesign(informationRates = c(0.13333333, 0.26666667, 0.4, 0.53333333, 0.66666667, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design264) expect_equal(design264$kMax, 6, tolerance = 1e-07) design265 <- getTestDesign(informationRates = c(0.11428571, 0.22857143, 0.34285714, 0.45714286, 0.57142857, 0.68571429, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design265) expect_equal(design265$kMax, 7, tolerance = 1e-07) design266 <- getTestDesign(informationRates = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design266) expect_equal(design266$kMax, 8, tolerance = 1e-07) design267 <- getTestDesign(informationRates = c(0.088888889, 0.17777778, 0.26666667, 0.35555556, 0.44444444, 0.53333333, 0.62222222, 0.71111111, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design267) expect_equal(design267$kMax, 9, tolerance = 1e-07) design268 <- getTestDesign(informationRates = c(0.08, 0.16, 0.24, 0.32, 0.4, 0.48, 0.56, 0.64, 0.72, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design268) expect_equal(design268$kMax, 10, tolerance = 1e-07) design269 <- getTestDesign(informationRates = c(0.072727273, 0.14545455, 0.21818182, 0.29090909, 0.36363636, 0.43636364, 0.50909091, 0.58181818, 0.65454545, 0.72727273, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design269) expect_equal(design269$kMax, 11, tolerance = 1e-07) design270 <- getTestDesign(informationRates = c(0.066666667, 0.13333333, 0.2, 0.26666667, 0.33333333, 0.4, 0.46666667, 0.53333333, 0.6, 0.66666667, 0.73333333, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design270) expect_equal(design270$kMax, 12, tolerance = 1e-07) design271 <- getTestDesign(informationRates = c(0.061538462, 0.12307692, 0.18461538, 0.24615385, 0.30769231, 0.36923077, 0.43076923, 0.49230769, 0.55384615, 0.61538462, 0.67692308, 0.73846154, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design271) expect_equal(design271$kMax, 13, tolerance = 1e-07) design272 <- getTestDesign(informationRates = c(0.057142857, 0.11428571, 0.17142857, 0.22857143, 0.28571429, 0.34285714, 0.4, 0.45714286, 0.51428571, 0.57142857, 0.62857143, 0.68571429, 0.74285714, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design272) expect_equal(design272$kMax, 14, tolerance = 1e-07) design273 <- getTestDesign(informationRates = c(0.053333333, 0.10666667, 0.16, 0.21333333, 0.26666667, 0.32, 0.37333333, 0.42666667, 0.48, 0.53333333, 0.58666667, 0.64, 0.69333333, 0.74666667, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design273) expect_equal(design273$kMax, 15, tolerance = 1e-07) design274 <- getTestDesign(informationRates = c(0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design274) expect_equal(design274$kMax, 16, tolerance = 1e-07) design275 <- getTestDesign(informationRates = c(0.047058824, 0.094117647, 0.14117647, 0.18823529, 0.23529412, 0.28235294, 0.32941176, 0.37647059, 0.42352941, 0.47058824, 0.51764706, 0.56470588, 0.61176471, 0.65882353, 0.70588235, 0.75294118, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design275) expect_equal(design275$kMax, 17, tolerance = 1e-07) design276 <- getTestDesign(informationRates = c(0.044444444, 0.088888889, 0.13333333, 0.17777778, 0.22222222, 0.26666667, 0.31111111, 0.35555556, 0.4, 0.44444444, 0.48888889, 0.53333333, 0.57777778, 0.62222222, 0.66666667, 0.71111111, 0.75555556, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design276) expect_equal(design276$kMax, 18, tolerance = 1e-07) design277 <- getTestDesign(informationRates = c(0.042105263, 0.084210526, 0.12631579, 0.16842105, 0.21052632, 0.25263158, 0.29473684, 0.33684211, 0.37894737, 0.42105263, 0.46315789, 0.50526316, 0.54736842, 0.58947368, 0.63157895, 0.67368421, 0.71578947, 0.75789474, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design277) expect_equal(design277$kMax, 19, tolerance = 1e-07) design278 <- getTestDesign(informationRates = c(0.04, 0.08, 0.12, 0.16, 0.2, 0.24, 0.28, 0.32, 0.36, 0.4, 0.44, 0.48, 0.52, 0.56, 0.6, 0.64, 0.68, 0.72, 0.76, 1), designClass = "TrialDesignGroupSequential") .getValidatedFutilityBounds(design278) expect_equal(design278$kMax, 20, tolerance = 1e-07) design279 <- getTestDesign(informationRates = c(0.4, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design279) expect_equal(design279$kMax, 2, tolerance = 1e-07) design280 <- getTestDesign(informationRates = c(0.26666667, 0.53333333, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design280) expect_equal(design280$kMax, 3, tolerance = 1e-07) design281 <- getTestDesign(informationRates = c(0.2, 0.4, 0.6, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design281) expect_equal(design281$kMax, 4, tolerance = 1e-07) design282 <- getTestDesign(informationRates = c(0.16, 0.32, 0.48, 0.64, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design282) expect_equal(design282$kMax, 5, tolerance = 1e-07) design283 <- getTestDesign(informationRates = c(0.13333333, 0.26666667, 0.4, 0.53333333, 0.66666667, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design283) expect_equal(design283$kMax, 6, tolerance = 1e-07) design284 <- getTestDesign(informationRates = c(0.11428571, 0.22857143, 0.34285714, 0.45714286, 0.57142857, 0.68571429, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design284) expect_equal(design284$kMax, 7, tolerance = 1e-07) design285 <- getTestDesign(informationRates = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design285) expect_equal(design285$kMax, 8, tolerance = 1e-07) design286 <- getTestDesign(informationRates = c(0.088888889, 0.17777778, 0.26666667, 0.35555556, 0.44444444, 0.53333333, 0.62222222, 0.71111111, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design286) expect_equal(design286$kMax, 9, tolerance = 1e-07) design287 <- getTestDesign(informationRates = c(0.08, 0.16, 0.24, 0.32, 0.4, 0.48, 0.56, 0.64, 0.72, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design287) expect_equal(design287$kMax, 10, tolerance = 1e-07) design288 <- getTestDesign(informationRates = c(0.072727273, 0.14545455, 0.21818182, 0.29090909, 0.36363636, 0.43636364, 0.50909091, 0.58181818, 0.65454545, 0.72727273, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design288) expect_equal(design288$kMax, 11, tolerance = 1e-07) design289 <- getTestDesign(informationRates = c(0.066666667, 0.13333333, 0.2, 0.26666667, 0.33333333, 0.4, 0.46666667, 0.53333333, 0.6, 0.66666667, 0.73333333, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design289) expect_equal(design289$kMax, 12, tolerance = 1e-07) design290 <- getTestDesign(informationRates = c(0.061538462, 0.12307692, 0.18461538, 0.24615385, 0.30769231, 0.36923077, 0.43076923, 0.49230769, 0.55384615, 0.61538462, 0.67692308, 0.73846154, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design290) expect_equal(design290$kMax, 13, tolerance = 1e-07) design291 <- getTestDesign(informationRates = c(0.057142857, 0.11428571, 0.17142857, 0.22857143, 0.28571429, 0.34285714, 0.4, 0.45714286, 0.51428571, 0.57142857, 0.62857143, 0.68571429, 0.74285714, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design291) expect_equal(design291$kMax, 14, tolerance = 1e-07) design292 <- getTestDesign(informationRates = c(0.053333333, 0.10666667, 0.16, 0.21333333, 0.26666667, 0.32, 0.37333333, 0.42666667, 0.48, 0.53333333, 0.58666667, 0.64, 0.69333333, 0.74666667, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design292) expect_equal(design292$kMax, 15, tolerance = 1e-07) design293 <- getTestDesign(informationRates = c(0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design293) expect_equal(design293$kMax, 16, tolerance = 1e-07) design294 <- getTestDesign(informationRates = c(0.047058824, 0.094117647, 0.14117647, 0.18823529, 0.23529412, 0.28235294, 0.32941176, 0.37647059, 0.42352941, 0.47058824, 0.51764706, 0.56470588, 0.61176471, 0.65882353, 0.70588235, 0.75294118, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design294) expect_equal(design294$kMax, 17, tolerance = 1e-07) design295 <- getTestDesign(informationRates = c(0.044444444, 0.088888889, 0.13333333, 0.17777778, 0.22222222, 0.26666667, 0.31111111, 0.35555556, 0.4, 0.44444444, 0.48888889, 0.53333333, 0.57777778, 0.62222222, 0.66666667, 0.71111111, 0.75555556, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design295) expect_equal(design295$kMax, 18, tolerance = 1e-07) design296 <- getTestDesign(informationRates = c(0.042105263, 0.084210526, 0.12631579, 0.16842105, 0.21052632, 0.25263158, 0.29473684, 0.33684211, 0.37894737, 0.42105263, 0.46315789, 0.50526316, 0.54736842, 0.58947368, 0.63157895, 0.67368421, 0.71578947, 0.75789474, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design296) expect_equal(design296$kMax, 19, tolerance = 1e-07) design297 <- getTestDesign(informationRates = c(0.04, 0.08, 0.12, 0.16, 0.2, 0.24, 0.28, 0.32, 0.36, 0.4, 0.44, 0.48, 0.52, 0.56, 0.6, 0.64, 0.68, 0.72, 0.76, 1), designClass = "TrialDesignInverseNormal") .getValidatedFutilityBounds(design297) expect_equal(design297$kMax, 20, tolerance = 1e-07) design298 <- getTestDesign(informationRates = c(0.4, 1), designClass = "TrialDesignFisher") .getValidatedAlpha0Vec(design298) expect_equal(design298$kMax, 2, tolerance = 1e-07) design299 <- getTestDesign(informationRates = c(0.26666667, 0.53333333, 1), designClass = "TrialDesignFisher") .getValidatedAlpha0Vec(design299) expect_equal(design299$kMax, 3, tolerance = 1e-07) design300 <- getTestDesign(informationRates = c(0.2, 0.4, 0.6, 1), designClass = "TrialDesignFisher") .getValidatedAlpha0Vec(design300) expect_equal(design300$kMax, 4, tolerance = 1e-07) design301 <- getTestDesign(informationRates = c(0.16, 0.32, 0.48, 0.64, 1), designClass = "TrialDesignFisher") .getValidatedAlpha0Vec(design301) expect_equal(design301$kMax, 5, tolerance = 1e-07) design302 <- getTestDesign(informationRates = c(0.13333333, 0.26666667, 0.4, 0.53333333, 0.66666667, 1), designClass = "TrialDesignFisher") .getValidatedAlpha0Vec(design302) expect_equal(design302$kMax, 6, tolerance = 1e-07) }) context("Testing Utilities") test_that("Testing '.toCapitalized'", { expect_equal(.toCapitalized("zip code"), "Zip Code") expect_equal(.toCapitalized("state of the art"), "State of the Art") expect_equal(.toCapitalized("final and count"), "Final and Count") }) test_that("Testing '.equalsRegexpIgnoreCase' ", { expect_equal(.equalsRegexpIgnoreCase("stage2", "^stages?$"), FALSE) expect_equal(.equalsRegexpIgnoreCase("stage", "^stages?$"), TRUE) expect_equal(.equalsRegexpIgnoreCase("stages", "^stages?$"), TRUE) expect_equal(.equalsRegexpIgnoreCase("Stage", "^stages?$"), TRUE) expect_equal(.equalsRegexpIgnoreCase("STAGES", "^stages?$"), TRUE) expect_equal(.equalsRegexpIgnoreCase("stages2", "^stages?$"), FALSE) expect_equal(.equalsRegexpIgnoreCase(" stages", "^stages?$"), FALSE) expect_equal(.equalsRegexpIgnoreCase("stages2", "stages?"), TRUE) expect_equal(.equalsRegexpIgnoreCase("1stage2", "stages?"), TRUE) }) test_that("Testing 'isUndefinedArgument' and 'isValidArgument'", { expect_equal(.isUndefinedArgument(NULL), TRUE) expect_equal(.isUndefinedArgument(numeric(0)), TRUE) expect_equal(.isUndefinedArgument(NA), TRUE) expect_equal(.isUndefinedArgument(NA_integer_), TRUE) expect_equal(.isUndefinedArgument(NA_real_), TRUE) expect_equal(.isUndefinedArgument(NA_complex_), TRUE) expect_equal(.isUndefinedArgument(NA_character_), TRUE) expect_equal(.isUndefinedArgument(c(NA, NA)), FALSE) expect_equal(.isUndefinedArgument(c(1, NA, NA)), FALSE) expect_equal(.isUndefinedArgument(c(NA, NA, 1)), FALSE) expect_equal(.isUndefinedArgument(1), FALSE) expect_equal(.isDefinedArgument(NULL), FALSE) expect_equal(.isDefinedArgument(numeric(0)), FALSE) expect_equal(.isDefinedArgument(NA), FALSE) expect_equal(.isDefinedArgument(NA_integer_), FALSE) expect_equal(.isDefinedArgument(NA_real_), FALSE) expect_equal(.isDefinedArgument(NA_complex_), FALSE) expect_equal(.isDefinedArgument(NA_character_), FALSE) expect_equal(.isDefinedArgument(c(NA, NA)), TRUE) expect_equal(.isDefinedArgument(c(1, NA, NA)), TRUE) expect_equal(.isDefinedArgument(c(NA, NA, 1)), TRUE) expect_equal(.isDefinedArgument(1), TRUE) expect_error(.isDefinedArgument(notExistingTestVariable, argumentExistsValidationEnabled = FALSE)) expect_error(.isDefinedArgument(notExistingTestVariable)) #skip_if_translated() #expect_error(.isDefinedArgument(notExistingTestVariable), # paste0("Missing argument: the object 'notExistingTestVariable' has not been defined anywhere. ", # "Please define it first, e.g., run 'notExistingTestVariable <- 1'"), fixed = TRUE) }) test_that("Result of 'setSeed(seed)' is working for different arguments, incl. NULL and NA", { # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} expect_false(is.null(.setSeed())) expect_false(is.na(.setSeed())) expect_true(is.numeric(.setSeed())) expect_false(is.null(.setSeed(NULL))) expect_false(is.na(.setSeed(NULL))) expect_true(is.numeric(.setSeed(NULL))) expect_false(is.null(.setSeed(NA))) expect_false(is.na(.setSeed(NA))) expect_true(is.numeric(.setSeed(NA))) expect_true(.setSeed() != .setSeed()) expect_equal(.setSeed(123), 123) expect_equal(.setSeed(0), 0) expect_equal(.setSeed(5e-5), 5e-5) }) test_that("Testing '.getInputForZeroOutputInsideTolerance''", { input <- 99 tolerance <- 1e-05 epsilon <- 1e-08 expect_equal(.getInputForZeroOutputInsideTolerance(input, tolerance, tolerance), input) expect_equal(.getInputForZeroOutputInsideTolerance(input, tolerance + epsilon, tolerance), NA_real_) expect_equal(.getInputForZeroOutputInsideTolerance(input, tolerance - epsilon, tolerance), input) }) test_that("Testing '.arrayToString'", { expect_equal(.arrayToString(NA, vectorLookAndFeelEnabled = TRUE), "NA") expect_equal(.arrayToString(NULL, vectorLookAndFeelEnabled = TRUE), "NULL") expect_equal(.arrayToString(c(1, 2, 3), vectorLookAndFeelEnabled = TRUE), "c(1, 2, 3)") expect_equal(.arrayToString(c(NA, 2, 3), vectorLookAndFeelEnabled = TRUE), "c(NA, 2, 3)") expect_equal(.arrayToString(c(1, 2, NA), vectorLookAndFeelEnabled = TRUE), "c(1, 2, NA)") expect_equal(.arrayToString(c(NA, NA, NA), vectorLookAndFeelEnabled = TRUE), "c(NA, NA, NA)") expect_equal(.arrayToString(c(1, NULL, 3), vectorLookAndFeelEnabled = TRUE), "c(1, 3)") }) test_that("Testing '.getInputProducingZeroOutput'", { tolerance <- 1e-05 epsilon <- 1e-08 expect_equal(.getInputProducingZeroOutput(1, 0, 2, 99, tolerance), 1) expect_equal(.getInputProducingZeroOutput(1, 99, 2, 0, tolerance), 2) expect_equal(.getInputProducingZeroOutput(1, 0, NA, 0, tolerance), 1) expect_equal(.getInputProducingZeroOutput(NA, 0, 2, 0, tolerance), 2) expect_equal(.getInputProducingZeroOutput(1, 0, NA, NA, tolerance), 1) expect_equal(.getInputProducingZeroOutput(NA, NA, 2, 0, tolerance), 2) expect_equal(.getInputProducingZeroOutput(1, 0, 2, NA, tolerance), 1) expect_equal(.getInputProducingZeroOutput(1, NA, 2, 0, tolerance), 2) expect_equal(.getInputProducingZeroOutput(1, tolerance, 2, 99, tolerance), 1) expect_equal(.getInputProducingZeroOutput(1, 99, 2, tolerance, tolerance), 2) expect_equal(.getInputProducingZeroOutput(1, tolerance, 2, tolerance + epsilon, tolerance), 1) expect_equal(.getInputProducingZeroOutput(1, tolerance + epsilon, 2, tolerance, tolerance), 2) expect_equal(.getInputProducingZeroOutput(1, tolerance, 2, tolerance - epsilon, tolerance), 2) expect_equal(.getInputProducingZeroOutput(1, tolerance - epsilon, 2, tolerance, tolerance), 1) expect_equal(.getInputProducingZeroOutput(1, tolerance - epsilon, 2, tolerance, tolerance), 1) expect_equal(.getInputProducingZeroOutput(1, tolerance, 2, tolerance - epsilon, tolerance), 2) }) test_that("Testing '.getOneDimensionalRoot'", { .skipTestIfDisabled() tolerance <- 1e-08 expect_equal(.getOneDimensionalRoot(f = function(x) {x - 2}, lower = -1, upper = 1, tolerance = tolerance), NA_real_) expect_equal(.getOneDimensionalRoot(f = function(x) {x + 2}, lower = -1, upper = 1, tolerance = tolerance), NA_real_) expect_equal(.getOneDimensionalRoot(f = function(x) {x - 1 - tolerance}, lower = -1, upper = 1, tolerance = tolerance), 1) expect_equal(.getOneDimensionalRoot(f = function(x) {x + 1 + tolerance}, lower = -1, upper = 1, tolerance = tolerance), -1) expect_equal(.getOneDimensionalRoot(f = function(x) {x - 1}, lower = -1, upper = 1, tolerance = tolerance), 1) expect_equal(.getOneDimensionalRoot(f = function(x) {x + 1}, lower = -1, upper = 1, tolerance = tolerance), -1) expect_equal(.getOneDimensionalRoot(f = function(x) {x - 1}, lower = 0, upper = 1, tolerance = tolerance), 1) expect_equal(.getOneDimensionalRoot(f = function(x) {x - 1}, lower = tolerance, upper = 1, tolerance = tolerance), 1) expect_equal(.getOneDimensionalRoot(f = function(x) {x + 1}, lower = -1, upper = 0, tolerance = tolerance), -1) expect_equal(.getOneDimensionalRoot(f = function(x) {x + 1}, lower = -1, upper = 1- tolerance, tolerance = tolerance), -1) expect_equal(.getOneDimensionalRoot(f = function(x) {x - 3}, lower = 1, upper = 5, tolerance = tolerance), 3) expect_equal(.getOneDimensionalRoot(f = function(x) {x + 3}, lower = -5, upper = -1, tolerance = tolerance), -3) expect_equal(.getOneDimensionalRoot(f = function(x) {3 * x - 700}, lower = 100, upper = 1000, tolerance = tolerance), 233.33333333) expect_equal(.getOneDimensionalRoot(f = function(x) {3 * x + 700}, lower = -1000, upper = -100, tolerance = tolerance), -233.33333333) expect_equal(.getOneDimensionalRoot(f = function(x) {x - 4}, lower = -10, upper = 10), 4, tolerance = tolerance) expect_equal(.getOneDimensionalRoot(f = function(x) {x + 4}, lower = -10, upper = 10), -4, tolerance = tolerance) dataExample1 <- getDataset( overallEvents = c(33, 55, 129), overallAllocationRatios = c(1, 1, 4), overallLogRanks = c(1.02, 1.38, 2.2) ) design1 <- getDesignGroupSequential(kMax = 3, alpha = 0.025, typeOfDesign = "WT", deltaWT = 0.25) result1 <- getRepeatedConfidenceIntervals(design1, dataExample1, stage = 3) ## Comparison of the results of matrixarray object 'result1' with expected results expect_equal(result1[1, ], c(0.54923831, 0.77922365, 1.0261298), tolerance = 1e-07) expect_equal(result1[2, ], c(3.7041718, 2.7014099, 2.5669073), tolerance = 1e-07) design2 <- getDesignGroupSequential(kMax = 3, alpha = 0.025, informationRates = c(0.4, 0.7, 1), typeOfDesign = "WT", deltaWT = 0.35) dataExample2 <- getDataset( overallN2 = c(30,80,100), overallN1 = c(30,80,100), overallEvents2 = c(10,25,36), overallEvents1 = c(14,35,53)) result2 <- getRepeatedConfidenceIntervals(design = design2, dataInput = dataExample2, stage = 3, normalApproximation = TRUE, directionUpper = TRUE) ## Comparison of the results of matrixarray object 'result2' with expected results expect_equal(result2[1, ], c(-0.17491854, -0.048575312, 0.01895796), tolerance = 1e-07) expect_equal(result2[2, ], c(0.41834402, 0.29168781, 0.31353692), tolerance = 1e-07) design3 <- getDesignInverseNormal(kMax = 2, alpha = 0.025, informationRates = c(0.5, 1), typeOfDesign = "WT", deltaWT = 0.25) dataExample3 <- getDataset( events1 = c(7,57), events2 = c(7,57), n1 = c(30,300), n2 = c(30,300) ) result3 <- getRepeatedConfidenceIntervals(design3, dataExample3) ## Comparison of the results of matrixarray object 'result3' with expected results expect_equal(result3[1, ], c(-0.26729325, -0.071745936), tolerance = 1e-07) expect_equal(result3[2, ], c(0.26729325, 0.071745764), tolerance = 1e-07) design4 <- getDesignInverseNormal(kMax = 2, alpha = 0.025, informationRates = c(0.5, 1), typeOfDesign = "WT", deltaWT = 0.25) dataExample4 <- getDataset( events1 = c(4,55), events2 = c(4,46), n1 = c(30,300), n2 = c(30,300)) result4 <- getRepeatedConfidenceIntervals(design4, dataExample4) ## Comparison of the results of matrixarray object 'result4' with expected results expect_equal(result4[1, ], c(-0.23589449, -0.043528443), tolerance = 1e-07) expect_equal(result4[2, ], c(0.23589449, 0.088472144), tolerance = 1e-07) }) rpact/tests/testthat/test-f_simulation_multiarm_rates.R0000644000175000017500000036147514154142422023437 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_simulation_multiarm_rates.R ## | Creation date: 08 December 2021, 09:09:56 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Simulation Multi-Arm Rates Function") test_that("'getSimulationMultiArmRates': several configurations", { .skipTestIfNotX64() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmRates} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmRatesGenerate} # @refFS[Formula]{fs:SimulationMultiArmRatesTestStatistics} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} # @refFS[Formula]{fs:adjustedPValueSubsetSidak} # @refFS[Formula]{fs:adjustedPValueSubsetSimes} x1 <- getSimulationMultiArmRates(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), typeOfShape = "linear", activeArms = 4, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x1' with expected results expect_equal(x1$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x1$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x1$iterations[3, ], c(10, 10, 9, 7)) expect_equal(x1$rejectAtLeastOne, c(0, 0.1, 0.6, 0.8), tolerance = 1e-07) expect_equal(unlist(as.list(x1$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0, 0, 0, 0, 0, 0, 0.3, 0, 0.1, 0.1, 0, 0, 0, 0, 0, 0.1, 0, 0.1, 0.2, 0, 0.2, 0.2), tolerance = 1e-07) expect_equal(x1$futilityStop, c(0, 0, 0, 0)) expect_equal(x1$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x1$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x1$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x1$earlyStop[2, ], c(0, 0, 0.1, 0.3), tolerance = 1e-07) expect_equal(x1$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x1$successPerStage[2, ], c(0, 0, 0.1, 0.3), tolerance = 1e-07) expect_equal(x1$successPerStage[3, ], c(0, 0.1, 0.5, 0.5), tolerance = 1e-07) expect_equal(unlist(as.list(x1$selectedArms)), c(1, 0.2, 0.2, 1, 0.1, 0.1, 1, 0.2, 0.2, 1, 0, 0, 1, 0.1, 0.1, 1, 0.2, 0.2, 1, 0, 0, 1, 0.2, 0.2, 1, 0.3, 0.3, 1, 0.4, 0.4, 1, 0.4, 0.4, 1, 0.3, 0.2, 1, 0.4, 0.4, 1, 0.3, 0.3, 1, 0.4, 0.3, 1, 0.5, 0.3, 1, 1, 1, 1, 1, 1, 1, 1, 0.9, 1, 1, 0.7), tolerance = 1e-07) expect_equal(x1$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x1$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x1$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x1$expectedNumberOfSubjects, c(334.8, 445, 331.8, 179.8), tolerance = 1e-07) expect_equal(unlist(as.list(x1$sampleSizes)), c(10, 8, 10.4, 10, 10, 10, 10, 11.3, 15.333333, 10, 0, 0, 10, 10, 10, 10, 17.5, 20, 10, 0, 0, 10, 13, 19.142857, 10, 22.4, 22.5, 10, 40, 40, 10, 37.5, 36.555556, 10, 4.4, 8.5714286, 10, 20.4, 38.7, 10, 30, 30, 10, 28.2, 19.111111, 10, 17.1, 15.714286, 10, 60.8, 81.6, 10, 97.5, 100, 10, 77, 71, 10, 34.5, 43.428571), tolerance = 1e-07) expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x1$conditionalPowerAchieved[2, ], c(0.032197948, 0.00019444487, 0.052129075, 0.12394528), tolerance = 1e-07) expect_equal(x1$conditionalPowerAchieved[3, ], c(0.33607045, 0.04525892, 0.4023749, 0.68738904), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-05) expect_equal(x1CodeBased$rejectAtLeastOne, x1$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x1CodeBased$rejectedArmsPerStage, x1$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$futilityStop, x1$futilityStop, tolerance = 1e-05) expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-05) expect_equal(x1CodeBased$successPerStage, x1$successPerStage, tolerance = 1e-05) expect_equal(x1CodeBased$selectedArms, x1$selectedArms, tolerance = 1e-05) expect_equal(x1CodeBased$numberOfActiveArms, x1$numberOfActiveArms, tolerance = 1e-05) expect_equal(x1CodeBased$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x1CodeBased$sampleSizes, x1$sampleSizes, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x2 <- getSimulationMultiArmRates(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), typeOfShape = "userDefined", activeArms = 4, plannedSubjects = c(10, 30, 50), piControl = 0.3, adaptations = rep(TRUE, 2), effectMatrix = matrix(c(0.1,0.2,0.3,0.4,0.2,0.3,0.4,0.5), ncol = 4), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x2' with expected results expect_equal(x2$iterations[1, ], c(10, 10)) expect_equal(x2$iterations[2, ], c(10, 10)) expect_equal(x2$iterations[3, ], c(10, 8)) expect_equal(x2$rejectAtLeastOne, c(0.2, 0.7), tolerance = 1e-07) expect_equal(unlist(as.list(x2$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0.2, 0.5), tolerance = 1e-07) expect_equal(x2$futilityStop, c(0, 0)) expect_equal(x2$futilityPerStage[1, ], c(0, 0)) expect_equal(x2$futilityPerStage[2, ], c(0, 0)) expect_equal(x2$earlyStop[1, ], c(0, 0)) expect_equal(x2$earlyStop[2, ], c(0, 0.2), tolerance = 1e-07) expect_equal(x2$successPerStage[1, ], c(0, 0)) expect_equal(x2$successPerStage[2, ], c(0, 0.2), tolerance = 1e-07) expect_equal(x2$successPerStage[3, ], c(0.2, 0.5), tolerance = 1e-07) expect_equal(unlist(as.list(x2$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0.3, 0.3, 1, 0.3, 0.3, 1, 0.2, 0.2, 1, 0, 0, 1, 0.5, 0.5, 1, 0.7, 0.5, 1, 1, 1, 1, 1, 0.8), tolerance = 1e-07) expect_equal(x2$numberOfActiveArms[1, ], c(4, 4)) expect_equal(x2$numberOfActiveArms[2, ], c(1, 1)) expect_equal(x2$numberOfActiveArms[3, ], c(1, 1)) expect_equal(x2$expectedNumberOfSubjects, c(397.2, 312.8), tolerance = 1e-07) expect_equal(unlist(as.list(x2$sampleSizes)), c(10, 0, 0, 10, 0, 0, 10, 30, 30, 10, 22.4, 37.5, 10, 13, 20, 10, 0, 0, 10, 38.8, 41.8, 10, 52.8, 32.75, 10, 81.8, 91.8, 10, 75.2, 70.25), tolerance = 1e-07) expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_)) expect_equal(x2$conditionalPowerAchieved[2, ], c(0.0097327907, 0.021741893), tolerance = 1e-07) expect_equal(x2$conditionalPowerAchieved[3, ], c(0.14656813, 0.35197865), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-05) expect_equal(x2CodeBased$rejectAtLeastOne, x2$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x2CodeBased$rejectedArmsPerStage, x2$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$futilityStop, x2$futilityStop, tolerance = 1e-05) expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-05) expect_equal(x2CodeBased$successPerStage, x2$successPerStage, tolerance = 1e-05) expect_equal(x2CodeBased$selectedArms, x2$selectedArms, tolerance = 1e-05) expect_equal(x2CodeBased$numberOfActiveArms, x2$numberOfActiveArms, tolerance = 1e-05) expect_equal(x2CodeBased$expectedNumberOfSubjects, x2$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() x3 <- getSimulationMultiArmRates(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), typeOfShape = "sigmoidEmax", gED50 = 2, slope = 0.5, activeArms = 4, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x3' with expected results expect_equal(x3$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x3$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x3$iterations[3, ], c(10, 10, 10, 10)) expect_equal(x3$rejectAtLeastOne, c(0, 0, 0, 0)) expect_equal(unlist(as.list(x3$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x3$futilityStop, c(0, 0, 0, 0)) expect_equal(x3$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x3$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x3$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x3$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x3$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x3$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x3$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x3$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0.2, 0.2, 1, 0.1, 0.1, 1, 0.3, 0.3, 1, 0.2, 0.2, 1, 0.4, 0.4, 1, 0.2, 0.2, 1, 0.3, 0.3, 1, 0.4, 0.4, 1, 0.3, 0.3, 1, 0.4, 0.4, 1, 0.4, 0.4, 1, 0.4, 0.4, 1, 0.1, 0.1, 1, 0.3, 0.3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1), tolerance = 1e-07) expect_equal(x3$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x3$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x3$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x3$expectedNumberOfSubjects, c(434.8, 402, 440, 425), tolerance = 1e-07) expect_equal(unlist(as.list(x3$sampleSizes)), c(10, 0, 0, 10, 0, 0, 10, 15, 20, 10, 10, 10, 10, 30, 30, 10, 12.7, 20, 10, 40, 40, 10, 20, 20, 10, 30, 30, 10, 29.1, 34.2, 10, 30, 30, 10, 33.4, 40, 10, 32.4, 40, 10, 40, 40, 10, 10, 10, 10, 26.7, 27.4, 10, 92.4, 100, 10, 81.8, 94.2, 10, 95, 100, 10, 90.1, 97.4), tolerance = 1e-07) expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x3$conditionalPowerAchieved[2, ], c(0.0098526063, 0.0022619481, 0.010226943, 0.0071111057), tolerance = 1e-07) expect_equal(x3$conditionalPowerAchieved[3, ], c(0.00025317548, 0.089328639, 4.5501958e-05, 0.12015791), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-05) expect_equal(x3CodeBased$rejectAtLeastOne, x3$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x3CodeBased$rejectedArmsPerStage, x3$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$futilityStop, x3$futilityStop, tolerance = 1e-05) expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-05) expect_equal(x3CodeBased$successPerStage, x3$successPerStage, tolerance = 1e-05) expect_equal(x3CodeBased$selectedArms, x3$selectedArms, tolerance = 1e-05) expect_equal(x3CodeBased$numberOfActiveArms, x3$numberOfActiveArms, tolerance = 1e-05) expect_equal(x3CodeBased$expectedNumberOfSubjects, x3$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x3CodeBased$sampleSizes, x3$sampleSizes, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x4 <- getSimulationMultiArmRates(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "all", plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x4' with expected results expect_equal(x4$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x4$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x4$iterations[3, ], c(10, 10, 10, 10)) expect_equal(x4$rejectAtLeastOne, c(0, 0.3, 0.7, 1), tolerance = 1e-07) expect_equal(unlist(as.list(x4$rejectedArmsPerStage)), c(0, 0, 0, 0, 0.1, 0, 0, 0, 0.1, 0, 0, 0.1, 0, 0, 0, 0, 0, 0.1, 0, 0.1, 0.3, 0, 0.3, 0.4, 0, 0, 0, 0, 0, 0.1, 0, 0.1, 0.3, 0, 0.6, 0.2, 0, 0, 0, 0, 0, 0.2, 0, 0.4, 0.3, 0, 0.8, 0.2), tolerance = 1e-07) expect_equal(x4$futilityStop, c(0, 0, 0, 0)) expect_equal(x4$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x4$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x4$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x4$earlyStop[2, ], c(0, 0, 0, 0)) expect_equal(x4$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x4$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x4$successPerStage[3, ], c(0, 0, 0.1, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x4$selectedArms)), c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)) expect_equal(x4$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x4$numberOfActiveArms[2, ], c(4, 4, 4, 4)) expect_equal(x4$numberOfActiveArms[3, ], c(4, 4, 4, 4)) expect_equal(x4$expectedNumberOfSubjects, c(1026, 1002, 924.5, 714.5), tolerance = 1e-07) expect_equal(unlist(as.list(x4$sampleSizes)), c(10, 95.2, 100, 10, 100, 90.4, 10, 91.8, 83.1, 10, 100, 32.9, 10, 95.2, 100, 10, 100, 90.4, 10, 91.8, 83.1, 10, 100, 32.9, 10, 95.2, 100, 10, 100, 90.4, 10, 91.8, 83.1, 10, 100, 32.9, 10, 95.2, 100, 10, 100, 90.4, 10, 91.8, 83.1, 10, 100, 32.9, 10, 95.2, 100, 10, 100, 90.4, 10, 91.8, 83.1, 10, 100, 32.9), tolerance = 1e-07) expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x4$conditionalPowerAchieved[2, ], c(0.16336896, 3.7379108e-06, 0.18421481, 0.069788183), tolerance = 1e-07) expect_equal(x4$conditionalPowerAchieved[3, ], c(0.00052547754, 0.089531131, 0.32040425, 0.67566016), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-05) expect_equal(x4CodeBased$rejectAtLeastOne, x4$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x4CodeBased$rejectedArmsPerStage, x4$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$futilityStop, x4$futilityStop, tolerance = 1e-05) expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-05) expect_equal(x4CodeBased$successPerStage, x4$successPerStage, tolerance = 1e-05) expect_equal(x4CodeBased$selectedArms, x4$selectedArms, tolerance = 1e-05) expect_equal(x4CodeBased$numberOfActiveArms, x4$numberOfActiveArms, tolerance = 1e-05) expect_equal(x4CodeBased$expectedNumberOfSubjects, x4$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x4CodeBased$sampleSizes, x4$sampleSizes, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x5 <- getSimulationMultiArmRates(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "rBest", rValue = 2, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x5' with expected results expect_equal(x5$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x5$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x5$iterations[3, ], c(10, 10, 8, 6)) expect_equal(x5$rejectAtLeastOne, c(0, 0.3, 0.9, 1), tolerance = 1e-07) expect_equal(unlist(as.list(x5$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0.1, 0, 0.2, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.2, 0.2, 0, 0.3, 0.1, 0, 0, 0, 0, 0, 0.2, 0, 0.3, 0.4, 0, 0.8, 0.1), tolerance = 1e-07) expect_equal(x5$futilityStop, c(0, 0, 0, 0)) expect_equal(x5$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x5$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x5$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x5$earlyStop[2, ], c(0, 0, 0.2, 0.4), tolerance = 1e-07) expect_equal(x5$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x5$successPerStage[2, ], c(0, 0, 0.2, 0.4), tolerance = 1e-07) expect_equal(x5$successPerStage[3, ], c(0, 0, 0.3, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x5$selectedArms)), c(1, 0.8, 0.8, 1, 0.3, 0.3, 1, 0.2, 0.2, 1, 0.2, 0.2, 1, 0.1, 0.1, 1, 0.4, 0.4, 1, 0.4, 0.2, 1, 0.3, 0.1, 1, 0.6, 0.6, 1, 0.5, 0.5, 1, 0.6, 0.5, 1, 0.6, 0.3, 1, 0.5, 0.5, 1, 0.8, 0.8, 1, 0.8, 0.7, 1, 0.9, 0.6, 1, 1, 1, 1, 1, 1, 1, 1, 0.8, 1, 1, 0.6), tolerance = 1e-07) expect_equal(x5$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x5$numberOfActiveArms[2, ], c(2, 2, 2, 2)) expect_equal(x5$numberOfActiveArms[3, ], c(2, 2, 2, 2)) expect_equal(x5$expectedNumberOfSubjects, c(642.8, 566.9, 399.8, 265.1), tolerance = 1e-07) expect_equal(unlist(as.list(x5$sampleSizes)), c(10, 77.6, 80, 10, 23.9, 30, 10, 20, 1, 10, 12.3, 1.3333333, 10, 10, 10, 10, 30.2, 28.6, 10, 28.6, 25, 10, 20, 3.1666667, 10, 60, 60, 10, 49.7, 41.1, 10, 37.4, 28.25, 10, 40.8, 9.8333333, 10, 47.6, 50, 10, 63.8, 77.3, 10, 61.2, 53.25, 10, 53.1, 14.333333, 10, 97.6, 100, 10, 83.8, 88.5, 10, 73.6, 53.75, 10, 63.1, 14.333333), tolerance = 1e-07) expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x5$conditionalPowerAchieved[2, ], c(0.080486965, 0.12759682, 0.10458054, 0.065420449), tolerance = 1e-07) expect_equal(x5$conditionalPowerAchieved[3, ], c(0.022470074, 0.31122739, 0.58569198, 0.85520318), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x5), NA))) expect_output(print(x5)$show()) invisible(capture.output(expect_error(summary(x5), NA))) expect_output(summary(x5)$show()) x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-05) expect_equal(x5CodeBased$rejectAtLeastOne, x5$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x5CodeBased$rejectedArmsPerStage, x5$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$futilityStop, x5$futilityStop, tolerance = 1e-05) expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-05) expect_equal(x5CodeBased$successPerStage, x5$successPerStage, tolerance = 1e-05) expect_equal(x5CodeBased$selectedArms, x5$selectedArms, tolerance = 1e-05) expect_equal(x5CodeBased$numberOfActiveArms, x5$numberOfActiveArms, tolerance = 1e-05) expect_equal(x5CodeBased$expectedNumberOfSubjects, x5$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x5CodeBased$sampleSizes, x5$sampleSizes, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x5), "character") df <- as.data.frame(x5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x6 <- getSimulationMultiArmRates(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "epsilon", epsilonValue = 0.1, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x6' with expected results expect_equal(x6$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x6$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x6$iterations[3, ], c(10, 10, 8, 7)) expect_equal(x6$rejectAtLeastOne, c(0, 0.4, 0.8, 1), tolerance = 1e-07) expect_equal(unlist(as.list(x6$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0.1, 0.2, 0, 0.3, 0.4, 0, 0, 0, 0, 0, 0.4, 0, 0.2, 0.5, 0, 0.4, 0.5), tolerance = 1e-07) expect_equal(x6$futilityStop, c(0, 0, 0, 0)) expect_equal(x6$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x6$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x6$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x6$earlyStop[2, ], c(0, 0, 0.2, 0.3), tolerance = 1e-07) expect_equal(x6$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x6$successPerStage[2, ], c(0, 0, 0.2, 0.3), tolerance = 1e-07) expect_equal(x6$successPerStage[3, ], c(0, 0.4, 0.6, 0.6), tolerance = 1e-07) expect_equal(unlist(as.list(x6$selectedArms)), c(1, 0.2, 0.2, 1, 0.4, 0.1, 1, 0.3, 0.1, 1, 0.1, 0.1, 1, 0.4, 0.4, 1, 0.1, 0, 1, 0.2, 0.1, 1, 0.2, 0, 1, 0.4, 0.4, 1, 0.4, 0.4, 1, 0.3, 0.2, 1, 0.9, 0.4, 1, 0.3, 0.3, 1, 0.7, 0.7, 1, 0.9, 0.7, 1, 0.9, 0.6, 1, 1, 1, 1, 1, 1, 1, 1, 0.8, 1, 1, 0.7), tolerance = 1e-07) expect_equal(x6$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x6$numberOfActiveArms[2, ], c(1.3, 1.6, 1.7, 2.1), tolerance = 1e-07) expect_equal(x6$numberOfActiveArms[3, ], c(1.3, 1.2, 1.375, 1.5714286), tolerance = 1e-07) expect_equal(x6$expectedNumberOfSubjects, c(436.4, 438.6, 346.7, 372.5), tolerance = 1e-07) expect_equal(unlist(as.list(x6$sampleSizes)), c(10, 16.7, 20, 10, 27.9, 10, 10, 9.1, 12.5, 10, 1.2, 14.285714, 10, 37.5, 40, 10, 1.2, 0, 10, 12.3, 11.625, 10, 7.9, 0, 10, 32.4, 32.5, 10, 31.2, 40, 10, 21.5, 13.375, 10, 63.2, 50.142857, 10, 15.4, 28.7, 10, 56.2, 59, 10, 60.4, 63, 10, 58, 51.714286, 10, 72, 91.2, 10, 74.1, 89, 10, 61.9, 63.875, 10, 64.7, 66), tolerance = 1e-07) expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x6$conditionalPowerAchieved[2, ], c(0.031688257, 0.035836944, 0.12967885, 0.10427074), tolerance = 1e-07) expect_equal(x6$conditionalPowerAchieved[3, ], c(0.2491354, 0.21222327, 0.47711159, 0.3978836), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x6), NA))) expect_output(print(x6)$show()) invisible(capture.output(expect_error(summary(x6), NA))) expect_output(summary(x6)$show()) x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-05) expect_equal(x6CodeBased$rejectAtLeastOne, x6$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x6CodeBased$rejectedArmsPerStage, x6$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$futilityStop, x6$futilityStop, tolerance = 1e-05) expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-05) expect_equal(x6CodeBased$successPerStage, x6$successPerStage, tolerance = 1e-05) expect_equal(x6CodeBased$selectedArms, x6$selectedArms, tolerance = 1e-05) expect_equal(x6CodeBased$numberOfActiveArms, x6$numberOfActiveArms, tolerance = 1e-05) expect_equal(x6CodeBased$expectedNumberOfSubjects, x6$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x6CodeBased$sampleSizes, x6$sampleSizes, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x6), "character") df <- as.data.frame(x6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x7 <- getSimulationMultiArmRates(seed = 1234, getDesignInverseNormal(informationRates = c(0.2, 0.6, 1)), activeArms = 4, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x7' with expected results expect_equal(x7$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x7$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x7$iterations[3, ], c(10, 9, 8, 5)) expect_equal(x7$rejectAtLeastOne, c(0, 0.4, 0.5, 1), tolerance = 1e-07) expect_equal(unlist(as.list(x7$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.2, 0, 0.1, 0.2, 0, 0, 0, 0, 0.1, 0.2, 0, 0.2, 0, 0, 0.4, 0.3), tolerance = 1e-07) expect_equal(x7$futilityStop, c(0, 0, 0, 0)) expect_equal(x7$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x7$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x7$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x7$earlyStop[2, ], c(0, 0.1, 0.2, 0.5), tolerance = 1e-07) expect_equal(x7$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x7$successPerStage[2, ], c(0, 0.1, 0.2, 0.5), tolerance = 1e-07) expect_equal(x7$successPerStage[3, ], c(0, 0.3, 0.3, 0.5), tolerance = 1e-07) expect_equal(unlist(as.list(x7$selectedArms)), c(1, 0.2, 0.2, 1, 0, 0, 1, 0.2, 0.2, 1, 0, 0, 1, 0.3, 0.3, 1, 0, 0, 1, 0.2, 0.2, 1, 0, 0, 1, 0.2, 0.2, 1, 0.4, 0.4, 1, 0.2, 0.2, 1, 0.3, 0.2, 1, 0.3, 0.3, 1, 0.6, 0.5, 1, 0.4, 0.2, 1, 0.7, 0.3, 1, 1, 1, 1, 1, 0.9, 1, 1, 0.8, 1, 1, 0.5), tolerance = 1e-07) expect_equal(x7$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x7$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x7$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x7$expectedNumberOfSubjects, c(355.2, 334, 233, 193.4), tolerance = 1e-07) expect_equal(unlist(as.list(x7$sampleSizes)), c(10, 20, 20, 10, 0, 0, 10, 20, 25, 10, 0, 0, 10, 30, 30, 10, 0, 0, 10, 3, 3.75, 10, 0, 0, 10, 12.4, 12.4, 10, 20.7, 22.777778, 10, 15, 18.75, 10, 16.2, 26.4, 10, 13.9, 13.9, 10, 54.2, 51.777778, 10, 13.1, 3, 10, 30.3, 24, 10, 76.3, 76.3, 10, 74.9, 74.555556, 10, 51.1, 50.5, 10, 46.5, 50.4), tolerance = 1e-07) expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x7$conditionalPowerAchieved[2, ], c(0.035427106, 0.012436575, 0.08338715, 0.046283385), tolerance = 1e-07) expect_equal(x7$conditionalPowerAchieved[3, ], c(0.076058567, 0.27636533, 0.46741694, 0.70493817), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x7), NA))) expect_output(print(x7)$show()) invisible(capture.output(expect_error(summary(x7), NA))) expect_output(summary(x7)$show()) x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-05) expect_equal(x7CodeBased$rejectAtLeastOne, x7$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x7CodeBased$rejectedArmsPerStage, x7$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$futilityStop, x7$futilityStop, tolerance = 1e-05) expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-05) expect_equal(x7CodeBased$successPerStage, x7$successPerStage, tolerance = 1e-05) expect_equal(x7CodeBased$selectedArms, x7$selectedArms, tolerance = 1e-05) expect_equal(x7CodeBased$numberOfActiveArms, x7$numberOfActiveArms, tolerance = 1e-05) expect_equal(x7CodeBased$expectedNumberOfSubjects, x7$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x7CodeBased$sampleSizes, x7$sampleSizes, tolerance = 1e-05) expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x7), "character") df <- as.data.frame(x7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x8 <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "all", plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x8' with expected results expect_equal(x8$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x8$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x8$iterations[3, ], c(10, 10, 9, 8)) expect_equal(x8$rejectAtLeastOne, c(0, 0.2, 0.9, 1), tolerance = 1e-07) expect_equal(unlist(as.list(x8$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0.2, 0, 0, 0, 0, 0, 0, 0.2, 0, 0.1, 0.3, 0, 0.2, 0.4, 0, 0, 0, 0, 0, 0.1, 0, 0.3, 0.3, 0.1, 0.4, 0.5, 0, 0, 0, 0, 0, 0.1, 0, 0.4, 0.5, 0.1, 0.8, 0.1), tolerance = 1e-07) expect_equal(x8$futilityStop, c(0, 0, 0, 0)) expect_equal(x8$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x8$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x8$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x8$earlyStop[2, ], c(0, 0, 0.1, 0.2), tolerance = 1e-07) expect_equal(x8$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x8$successPerStage[2, ], c(0, 0, 0.1, 0.2), tolerance = 1e-07) expect_equal(x8$successPerStage[3, ], c(0, 0, 0.1, 0), tolerance = 1e-07) expect_equal(unlist(as.list(x8$selectedArms)), c(1, 1, 1, 1, 1, 1, 1, 1, 0.9, 1, 1, 0.8, 1, 1, 1, 1, 1, 1, 1, 1, 0.9, 1, 1, 0.8, 1, 1, 1, 1, 1, 1, 1, 1, 0.9, 1, 1, 0.8, 1, 1, 1, 1, 1, 1, 1, 1, 0.9, 1, 1, 0.8, 1, 1, 1, 1, 1, 1, 1, 1, 0.9, 1, 1, 0.8), tolerance = 1e-07) expect_equal(x8$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x8$numberOfActiveArms[2, ], c(4, 4, 4, 4)) expect_equal(x8$numberOfActiveArms[3, ], c(4, 4, 4, 4)) expect_equal(x8$expectedNumberOfSubjects, c(952, 1050, 909.5, 860), tolerance = 1e-07) expect_equal(unlist(as.list(x8$sampleSizes)), c(10, 90.2, 90.2, 10, 100, 100, 10, 91, 89.888889, 10, 91, 88.75, 10, 90.2, 90.2, 10, 100, 100, 10, 91, 89.888889, 10, 91, 88.75, 10, 90.2, 90.2, 10, 100, 100, 10, 91, 89.888889, 10, 91, 88.75, 10, 90.2, 90.2, 10, 100, 100, 10, 91, 89.888889, 10, 91, 88.75, 10, 90.2, 90.2, 10, 100, 100, 10, 91, 89.888889, 10, 91, 88.75), tolerance = 1e-07) expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x8$conditionalPowerAchieved[2, ], c(0.16068828, 0.022112719, 0.21849189, 0.19646842), tolerance = 1e-07) expect_equal(x8$conditionalPowerAchieved[3, ], c(0.0018216452, 0.044801331, 0.47086458, 0.69046124), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x8), NA))) expect_output(print(x8)$show()) invisible(capture.output(expect_error(summary(x8), NA))) expect_output(summary(x8)$show()) x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-05) expect_equal(x8CodeBased$rejectAtLeastOne, x8$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x8CodeBased$rejectedArmsPerStage, x8$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$futilityStop, x8$futilityStop, tolerance = 1e-05) expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-05) expect_equal(x8CodeBased$successPerStage, x8$successPerStage, tolerance = 1e-05) expect_equal(x8CodeBased$selectedArms, x8$selectedArms, tolerance = 1e-05) expect_equal(x8CodeBased$numberOfActiveArms, x8$numberOfActiveArms, tolerance = 1e-05) expect_equal(x8CodeBased$expectedNumberOfSubjects, x8$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x8CodeBased$sampleSizes, x8$sampleSizes, tolerance = 1e-05) expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x8), "character") df <- as.data.frame(x8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x9 <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "rBest", rValue = 2, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x9' with expected results expect_equal(x9$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x9$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x9$iterations[3, ], c(10, 10, 10, 5)) expect_equal(x9$rejectAtLeastOne, c(0, 0.2, 0.7, 1), tolerance = 1e-07) expect_equal(unlist(as.list(x9$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.1, 0.1, 0.1, 0.1, 0, 0, 0, 0, 0, 0.1, 0.1, 0, 0.2, 0, 0.4, 0.2, 0, 0, 0, 0, 0, 0.1, 0, 0.1, 0.3, 0.1, 0.6, 0.1), tolerance = 1e-07) expect_equal(x9$futilityStop, c(0, 0, 0, 0)) expect_equal(x9$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x9$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x9$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x9$earlyStop[2, ], c(0, 0, 0, 0.5), tolerance = 1e-07) expect_equal(x9$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x9$successPerStage[2, ], c(0, 0, 0, 0.5), tolerance = 1e-07) expect_equal(x9$successPerStage[3, ], c(0, 0.1, 0.1, 0.3), tolerance = 1e-07) expect_equal(unlist(as.list(x9$selectedArms)), c(1, 0.6, 0.6, 1, 0.4, 0.4, 1, 0.3, 0.3, 1, 0.2, 0.1, 1, 0.7, 0.7, 1, 0.2, 0.2, 1, 0.5, 0.5, 1, 0.3, 0.2, 1, 0.5, 0.5, 1, 0.7, 0.7, 1, 0.6, 0.6, 1, 0.6, 0.3, 1, 0.2, 0.2, 1, 0.7, 0.7, 1, 0.6, 0.6, 1, 0.9, 0.4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0.5), tolerance = 1e-07) expect_equal(x9$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x9$numberOfActiveArms[2, ], c(2, 2, 2, 2)) expect_equal(x9$numberOfActiveArms[3, ], c(2, 2, 2, 2)) expect_equal(x9$expectedNumberOfSubjects, c(603.2, 605.9, 453.2, 361.7), tolerance = 1e-07) expect_equal(unlist(as.list(x9$sampleSizes)), c(10, 52.2, 52.2, 10, 33.6, 33.5, 10, 21.2, 21.2, 10, 9.2, 17.6, 10, 70, 70, 10, 20, 20, 10, 35.6, 35.3, 10, 19.7, 21.4, 10, 45.3, 45.3, 10, 62.7, 62.6, 10, 36.2, 35.8, 10, 52.8, 45.4, 10, 16.9, 16.9, 10, 69.1, 69.1, 10, 41.8, 41.7, 10, 61.7, 44.4, 10, 92.2, 92.2, 10, 92.7, 92.6, 10, 67.4, 67, 10, 71.7, 64.4), tolerance = 1e-07) expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x9$conditionalPowerAchieved[2, ], c(0.083443128, 0.076003514, 0.14647721, 0.085145955), tolerance = 1e-07) expect_equal(x9$conditionalPowerAchieved[3, ], c(0.043093175, 0.13127607, 0.3479275, 0.64693149), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x9), NA))) expect_output(print(x9)$show()) invisible(capture.output(expect_error(summary(x9), NA))) expect_output(summary(x9)$show()) x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-05) expect_equal(x9CodeBased$rejectAtLeastOne, x9$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x9CodeBased$rejectedArmsPerStage, x9$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$futilityStop, x9$futilityStop, tolerance = 1e-05) expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-05) expect_equal(x9CodeBased$successPerStage, x9$successPerStage, tolerance = 1e-05) expect_equal(x9CodeBased$selectedArms, x9$selectedArms, tolerance = 1e-05) expect_equal(x9CodeBased$numberOfActiveArms, x9$numberOfActiveArms, tolerance = 1e-05) expect_equal(x9CodeBased$expectedNumberOfSubjects, x9$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x9CodeBased$sampleSizes, x9$sampleSizes, tolerance = 1e-05) expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x9), "character") df <- as.data.frame(x9) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x9) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x10 <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, typeOfSelection = "epsilon", epsilonValue = 0.1, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x10' with expected results expect_equal(x10$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x10$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x10$iterations[3, ], c(10, 9, 7, 6)) expect_equal(x10$rejectAtLeastOne, c(0, 0.2, 0.6, 0.6), tolerance = 1e-07) expect_equal(unlist(as.list(x10$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.1, 0.1, 0, 0.1, 0.1, 0, 0, 0, 0, 0.1, 0, 0, 0.2, 0.1, 0, 0.3, 0, 0, 0, 0, 0, 0.1, 0, 0, 0.3, 0, 0, 0.3, 0.1), tolerance = 1e-07) expect_equal(x10$futilityStop, c(0, 0, 0, 0)) expect_equal(x10$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x10$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x10$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x10$earlyStop[2, ], c(0, 0.1, 0.3, 0.4), tolerance = 1e-07) expect_equal(x10$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x10$successPerStage[2, ], c(0, 0.1, 0.3, 0.4), tolerance = 1e-07) expect_equal(x10$successPerStage[3, ], c(0, 0, 0.2, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x10$selectedArms)), c(1, 0.2, 0.2, 1, 0.4, 0.4, 1, 0.2, 0.2, 1, 0.1, 0.1, 1, 0.3, 0.3, 1, 0.3, 0.2, 1, 0.3, 0.2, 1, 0.5, 0.4, 1, 0.3, 0.3, 1, 0.4, 0.4, 1, 0.5, 0.5, 1, 0.5, 0.3, 1, 0.4, 0.4, 1, 0.7, 0.6, 1, 0.5, 0.3, 1, 0.5, 0.3, 1, 1, 1, 1, 1, 0.9, 1, 1, 0.7, 1, 1, 0.6), tolerance = 1e-07) expect_equal(x10$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x10$numberOfActiveArms[2, ], c(1.2, 1.8, 1.5, 1.6), tolerance = 1e-07) expect_equal(x10$numberOfActiveArms[3, ], c(1.2, 1.7777778, 1.7142857, 1.8333333), tolerance = 1e-07) expect_equal(x10$expectedNumberOfSubjects, c(313.2, 474, 363.7, 263.7), tolerance = 1e-07) expect_equal(unlist(as.list(x10$sampleSizes)), c(10, 15.9, 15.8, 10, 35.9, 39.777778, 10, 12.7, 18, 10, 2.8, 4.6666667, 10, 22.2, 22.2, 10, 30, 22.222222, 10, 22.7, 28.571429, 10, 27.4, 43.166667, 10, 18.1, 18, 10, 32.8, 36.444444, 10, 38.6, 54.857143, 10, 26.7, 26.5, 10, 15.8, 15.8, 10, 54.9, 49.777778, 10, 37.3, 24.571429, 10, 24.9, 23.666667, 10, 59.8, 59.6, 10, 73.6, 70.444444, 10, 68.6, 65.142857, 10, 43, 50.166667), tolerance = 1e-07) expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x10$conditionalPowerAchieved[2, ], c(0.067103341, 0.011749166, 0.024807536, 0.13720867), tolerance = 1e-07) expect_equal(x10$conditionalPowerAchieved[3, ], c(0.10265269, 0.46661697, 0.4198773, 0.2422132), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x10), NA))) expect_output(print(x10)$show()) invisible(capture.output(expect_error(summary(x10), NA))) expect_output(summary(x10)$show()) x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-05) expect_equal(x10CodeBased$rejectAtLeastOne, x10$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x10CodeBased$rejectedArmsPerStage, x10$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$futilityStop, x10$futilityStop, tolerance = 1e-05) expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-05) expect_equal(x10CodeBased$successPerStage, x10$successPerStage, tolerance = 1e-05) expect_equal(x10CodeBased$selectedArms, x10$selectedArms, tolerance = 1e-05) expect_equal(x10CodeBased$numberOfActiveArms, x10$numberOfActiveArms, tolerance = 1e-05) expect_equal(x10CodeBased$expectedNumberOfSubjects, x10$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x10CodeBased$sampleSizes, x10$sampleSizes, tolerance = 1e-05) expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x10), "character") df <- as.data.frame(x10) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x10) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x11 <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.1, 0.3, 0.1), intersectionTest = "Bonferroni", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), directionUpper = FALSE, maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x11' with expected results expect_equal(x11$iterations[1, ], c(10, 10, 10)) expect_equal(x11$iterations[2, ], c(8, 5, 9)) expect_equal(x11$iterations[3, ], c(4, 4, 6)) expect_equal(x11$rejectAtLeastOne, c(0.4, 0, 0), tolerance = 1e-07) expect_equal(unlist(as.list(x11$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0.3, 0, 0, 0, 0, 0, 0, 0), tolerance = 1e-07) expect_equal(x11$futilityStop, c(0.2, 0.6, 0.4), tolerance = 1e-07) expect_equal(x11$futilityPerStage[1, ], c(0.2, 0.5, 0.1), tolerance = 1e-07) expect_equal(x11$futilityPerStage[2, ], c(0, 0.1, 0.3), tolerance = 1e-07) expect_equal(x11$earlyStop[1, ], c(0.2, 0.5, 0.1), tolerance = 1e-07) expect_equal(x11$earlyStop[2, ], c(0.4, 0.1, 0.3), tolerance = 1e-07) expect_equal(x11$successPerStage[1, ], c(0, 0, 0)) expect_equal(x11$successPerStage[2, ], c(0.4, 0, 0), tolerance = 1e-07) expect_equal(x11$successPerStage[3, ], c(0, 0, 0)) expect_equal(unlist(as.list(x11$selectedArms)), c(1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.3, 0.1, 1, 0.2, 0.2, 1, 0.3, 0.2, 1, 0.1, 0.1, 1, 0.2, 0.1, 1, 0, 0, 1, 0.2, 0.2, 1, 0.3, 0, 1, 0.1, 0.1, 1, 0.3, 0.2, 1, 0.8, 0.4, 1, 0.5, 0.4, 1, 0.9, 0.6), tolerance = 1e-07) expect_equal(x11$numberOfActiveArms[1, ], c(4, 4, 4)) expect_equal(x11$numberOfActiveArms[2, ], c(1, 1, 1)) expect_equal(x11$numberOfActiveArms[3, ], c(1, 1, 1)) expect_equal(x11$expectedNumberOfSubjects, c(200.6, 150, 279), tolerance = 1e-07) expect_equal(unlist(as.list(x11$sampleSizes)), c(10, 1, 3.25, 10, 2.8, 25, 10, 17.333333, 15.666667, 10, 6.25, 50, 10, 23.2, 32, 10, 11.111111, 16.666667, 10, 14.5, 21, 10, 0, 0, 10, 15.777778, 33.333333, 10, 35.25, 0, 10, 8.4, 25, 10, 17, 33.333333, 10, 57, 74.25, 10, 34.4, 82, 10, 61.222222, 99), tolerance = 1e-07) expect_equal(x11$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x11$conditionalPowerAchieved[2, ], c(0.10402635, 0.15240707, 0.070533409), tolerance = 1e-07) expect_equal(x11$conditionalPowerAchieved[3, ], c(0.68219789, 0.38677479, 0.34246832), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x11), NA))) expect_output(print(x11)$show()) invisible(capture.output(expect_error(summary(x11), NA))) expect_output(summary(x11)$show()) x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) expect_equal(x11CodeBased$iterations, x11$iterations, tolerance = 1e-05) expect_equal(x11CodeBased$rejectAtLeastOne, x11$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x11CodeBased$rejectedArmsPerStage, x11$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$futilityStop, x11$futilityStop, tolerance = 1e-05) expect_equal(x11CodeBased$futilityPerStage, x11$futilityPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$earlyStop, x11$earlyStop, tolerance = 1e-05) expect_equal(x11CodeBased$successPerStage, x11$successPerStage, tolerance = 1e-05) expect_equal(x11CodeBased$selectedArms, x11$selectedArms, tolerance = 1e-05) expect_equal(x11CodeBased$numberOfActiveArms, x11$numberOfActiveArms, tolerance = 1e-05) expect_equal(x11CodeBased$expectedNumberOfSubjects, x11$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x11CodeBased$sampleSizes, x11$sampleSizes, tolerance = 1e-05) expect_equal(x11CodeBased$conditionalPowerAchieved, x11$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x11), "character") df <- as.data.frame(x11) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x11) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x12 <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), typeOfShape = "linear", activeArms = 4, threshold = 0, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), intersectionTest = "Bonferroni", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x12' with expected results expect_equal(x12$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x12$iterations[2, ], c(6, 6, 7, 9)) expect_equal(x12$iterations[3, ], c(3, 4, 5, 4)) expect_equal(x12$rejectAtLeastOne, c(0, 0, 0.5, 0.8), tolerance = 1e-07) expect_equal(unlist(as.list(x12$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0.3, 0.1, 0, 0, 0, 0, 0, 0, 0, 0.2, 0.2, 0, 0.2, 0.2), tolerance = 1e-07) expect_equal(x12$futilityStop, c(0.7, 0.6, 0.3, 0.1), tolerance = 1e-07) expect_equal(x12$futilityPerStage[1, ], c(0.4, 0.4, 0.3, 0.1), tolerance = 1e-07) expect_equal(x12$futilityPerStage[2, ], c(0.3, 0.2, 0, 0), tolerance = 1e-07) expect_equal(x12$earlyStop[1, ], c(0.4, 0.4, 0.3, 0.1), tolerance = 1e-07) expect_equal(x12$earlyStop[2, ], c(0.3, 0.2, 0.2, 0.5), tolerance = 1e-07) expect_equal(x12$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x12$successPerStage[2, ], c(0, 0, 0.2, 0.5), tolerance = 1e-07) expect_equal(x12$successPerStage[3, ], c(0, 0, 0.3, 0.3), tolerance = 1e-07) expect_equal(unlist(as.list(x12$selectedArms)), c(1, 0.1, 0.1, 1, 0.2, 0.2, 1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.2, 0, 1, 0.2, 0.1, 1, 0.1, 0.1, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0.1, 0.1, 1, 0.4, 0.1, 1, 0.3, 0.2, 1, 0.2, 0.1, 1, 0.4, 0.2, 1, 0.4, 0.2, 1, 0.6, 0.3, 1, 0.6, 0.4, 1, 0.7, 0.5, 1, 0.9, 0.4), tolerance = 1e-07) expect_equal(x12$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x12$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x12$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x12$expectedNumberOfSubjects, c(188, 175, 176, 185)) expect_equal(unlist(as.list(x12$sampleSizes)), c(10, 9.8333333, 32, 10, 10.833333, 27.5, 10, 14.285714, 20, 10, 5.8888889, 25, 10, 18.833333, 0, 10, 33.333333, 25, 10, 2, 20, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 2, 2, 10, 13.333333, 22.75, 10, 37, 66.666667, 10, 8.3333333, 25, 10, 20.857143, 29.2, 10, 18.444444, 36.25, 10, 65.666667, 98.666667, 10, 52.5, 77.5, 10, 39.142857, 71.2, 10, 37.666667, 84), tolerance = 1e-07) expect_equal(x12$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x12$conditionalPowerAchieved[2, ], c(0.1067614, 0.028335233, 0.15675994, 0.029094411), tolerance = 1e-07) expect_equal(x12$conditionalPowerAchieved[3, ], c(0.43970154, 0.38730712, 0.69132205, 0.60200615), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x12), NA))) expect_output(print(x12)$show()) invisible(capture.output(expect_error(summary(x12), NA))) expect_output(summary(x12)$show()) x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) expect_equal(x12CodeBased$iterations, x12$iterations, tolerance = 1e-05) expect_equal(x12CodeBased$rejectAtLeastOne, x12$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x12CodeBased$rejectedArmsPerStage, x12$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$futilityStop, x12$futilityStop, tolerance = 1e-05) expect_equal(x12CodeBased$futilityPerStage, x12$futilityPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$earlyStop, x12$earlyStop, tolerance = 1e-05) expect_equal(x12CodeBased$successPerStage, x12$successPerStage, tolerance = 1e-05) expect_equal(x12CodeBased$selectedArms, x12$selectedArms, tolerance = 1e-05) expect_equal(x12CodeBased$numberOfActiveArms, x12$numberOfActiveArms, tolerance = 1e-05) expect_equal(x12CodeBased$expectedNumberOfSubjects, x12$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x12CodeBased$sampleSizes, x12$sampleSizes, tolerance = 1e-05) expect_equal(x12CodeBased$conditionalPowerAchieved, x12$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x12), "character") df <- as.data.frame(x12) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x12) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x13 <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), typeOfShape = "userDefined", activeArms = 4, threshold = 0, plannedSubjects = c(10, 30, 50), piControl = 0.3, adaptations = rep(TRUE, 2), effectMatrix = matrix(c(0.1,0.2,0.3,0.4,0.2,0.3,0.4,0.5), ncol = 4), intersectionTest = "Bonferroni", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x13' with expected results expect_equal(x13$iterations[1, ], c(10, 10)) expect_equal(x13$iterations[2, ], c(6, 5)) expect_equal(x13$iterations[3, ], c(6, 3)) expect_equal(x13$rejectAtLeastOne, c(0.2, 0.4), tolerance = 1e-07) expect_equal(unlist(as.list(x13$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0.2, 0.2), tolerance = 1e-07) expect_equal(x13$futilityStop, c(0.4, 0.5), tolerance = 1e-07) expect_equal(x13$futilityPerStage[1, ], c(0.4, 0.5), tolerance = 1e-07) expect_equal(x13$futilityPerStage[2, ], c(0, 0)) expect_equal(x13$earlyStop[1, ], c(0.4, 0.5), tolerance = 1e-07) expect_equal(x13$earlyStop[2, ], c(0, 0.2), tolerance = 1e-07) expect_equal(x13$successPerStage[1, ], c(0, 0)) expect_equal(x13$successPerStage[2, ], c(0, 0.2), tolerance = 1e-07) expect_equal(x13$successPerStage[3, ], c(0.2, 0.2), tolerance = 1e-07) expect_equal(unlist(as.list(x13$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0, 0, 1, 0, 0, 1, 0.5, 0.5, 1, 0.4, 0.2, 1, 0.6, 0.6, 1, 0.5, 0.3), tolerance = 1e-07) expect_equal(x13$numberOfActiveArms[1, ], c(4, 4)) expect_equal(x13$numberOfActiveArms[2, ], c(1, 1)) expect_equal(x13$numberOfActiveArms[3, ], c(1, 1)) expect_equal(x13$expectedNumberOfSubjects, c(203, 169.6), tolerance = 1e-07) expect_equal(unlist(as.list(x13$sampleSizes)), c(10, 0, 0, 10, 0, 0, 10, 9.8333333, 16.666667, 10, 11.8, 10.666667, 10, 0, 0, 10, 0, 0, 10, 34.5, 66.5, 10, 63.6, 63, 10, 44.333333, 83.166667, 10, 75.4, 73.666667), tolerance = 1e-07) expect_equal(x13$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_)) expect_equal(x13$conditionalPowerAchieved[2, ], c(0.045209815, 0.0014148507), tolerance = 1e-07) expect_equal(x13$conditionalPowerAchieved[3, ], c(0.60681086, 0.72002567), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x13), NA))) expect_output(print(x13)$show()) invisible(capture.output(expect_error(summary(x13), NA))) expect_output(summary(x13)$show()) x13CodeBased <- eval(parse(text = getObjectRCode(x13, stringWrapParagraphWidth = NULL))) expect_equal(x13CodeBased$iterations, x13$iterations, tolerance = 1e-05) expect_equal(x13CodeBased$rejectAtLeastOne, x13$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x13CodeBased$rejectedArmsPerStage, x13$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x13CodeBased$futilityStop, x13$futilityStop, tolerance = 1e-05) expect_equal(x13CodeBased$futilityPerStage, x13$futilityPerStage, tolerance = 1e-05) expect_equal(x13CodeBased$earlyStop, x13$earlyStop, tolerance = 1e-05) expect_equal(x13CodeBased$successPerStage, x13$successPerStage, tolerance = 1e-05) expect_equal(x13CodeBased$selectedArms, x13$selectedArms, tolerance = 1e-05) expect_equal(x13CodeBased$numberOfActiveArms, x13$numberOfActiveArms, tolerance = 1e-05) expect_equal(x13CodeBased$expectedNumberOfSubjects, x13$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x13CodeBased$sampleSizes, x13$sampleSizes, tolerance = 1e-05) expect_equal(x13CodeBased$conditionalPowerAchieved, x13$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x13), "character") df <- as.data.frame(x13) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x13) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x14 <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), typeOfShape = "sigmoidEmax", gED50 = 2, slope = 0.5, activeArms = 4, threshold = 0, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), intersectionTest = "Sidak", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x14' with expected results expect_equal(x14$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x14$iterations[2, ], c(5, 6, 9, 9)) expect_equal(x14$iterations[3, ], c(0, 1, 5, 9)) expect_equal(x14$rejectAtLeastOne, c(0, 0, 0, 0)) expect_equal(unlist(as.list(x14$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x14$futilityStop, c(1, 0.9, 0.5, 0.1), tolerance = 1e-07) expect_equal(x14$futilityPerStage[1, ], c(0.5, 0.4, 0.1, 0.1), tolerance = 1e-07) expect_equal(x14$futilityPerStage[2, ], c(0.5, 0.5, 0.4, 0), tolerance = 1e-07) expect_equal(x14$earlyStop[1, ], c(0.5, 0.4, 0.1, 0.1), tolerance = 1e-07) expect_equal(x14$earlyStop[2, ], c(0.5, 0.5, 0.4, 0), tolerance = 1e-07) expect_equal(x14$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x14$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x14$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x14$selectedArms)), c(1, 0.1, 0, 1, 0.1, 0, 1, 0.2, 0, 1, 0.1, 0.1, 1, 0.2, 0, 1, 0, 0, 1, 0.2, 0.1, 1, 0.1, 0.1, 1, 0, 0, 1, 0.4, 0.1, 1, 0.2, 0.1, 1, 0.3, 0.3, 1, 0.2, 0, 1, 0.1, 0, 1, 0.3, 0.3, 1, 0.4, 0.4, 1, 0.5, 0, 1, 0.6, 0.1, 1, 0.9, 0.5, 1, 0.9, 0.9), tolerance = 1e-07) expect_equal(x14$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x14$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x14$numberOfActiveArms[3, ], c(NaN, 1, 1, 1)) expect_equal(x14$expectedNumberOfSubjects, c(NaN, 171.2, 271.2, 368.4), tolerance = 1e-07) expect_equal(unlist(as.list(x14$sampleSizes)), c(10, 20, 0, 10, 8.8333333, 0, 10, 17, 0, 10, 5.8888889, 11.111111, 10, 40, 0, 10, 0, 0, 10, 8.8888889, 20, 10, 3, 11.111111, 10, 0, 0, 10, 58.833333, 100, 10, 8.1111111, 20, 10, 28.111111, 33.333333, 10, 38.2, 0, 10, 16.666667, 0, 10, 33.333333, 60, 10, 39.888889, 44.444444, 10, 98.2, 0, 10, 84.333333, 100, 10, 67.333333, 100, 10, 76.888889, 100), tolerance = 1e-07) expect_equal(x14$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x14$conditionalPowerAchieved[2, ], c(0.0010701396, 1.0749986e-05, 0.015009054, 0.019936014), tolerance = 1e-07) expect_equal(x14$conditionalPowerAchieved[3, ], c(NaN, 0.062530095, 0.19373785, 0.13543053), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x14), NA))) expect_output(print(x14)$show()) invisible(capture.output(expect_error(summary(x14), NA))) expect_output(summary(x14)$show()) x14CodeBased <- eval(parse(text = getObjectRCode(x14, stringWrapParagraphWidth = NULL))) expect_equal(x14CodeBased$iterations, x14$iterations, tolerance = 1e-05) expect_equal(x14CodeBased$rejectAtLeastOne, x14$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x14CodeBased$rejectedArmsPerStage, x14$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x14CodeBased$futilityStop, x14$futilityStop, tolerance = 1e-05) expect_equal(x14CodeBased$futilityPerStage, x14$futilityPerStage, tolerance = 1e-05) expect_equal(x14CodeBased$earlyStop, x14$earlyStop, tolerance = 1e-05) expect_equal(x14CodeBased$successPerStage, x14$successPerStage, tolerance = 1e-05) expect_equal(x14CodeBased$selectedArms, x14$selectedArms, tolerance = 1e-05) expect_equal(x14CodeBased$numberOfActiveArms, x14$numberOfActiveArms, tolerance = 1e-05) expect_equal(x14CodeBased$expectedNumberOfSubjects, x14$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x14CodeBased$sampleSizes, x14$sampleSizes, tolerance = 1e-05) expect_equal(x14CodeBased$conditionalPowerAchieved, x14$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x14), "character") df <- as.data.frame(x14) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x14) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x15 <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, typeOfSelection = "all", plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), intersectionTest = "Sidak", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x15' with expected results expect_equal(x15$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x15$iterations[2, ], c(8, 9, 10, 9)) expect_equal(x15$iterations[3, ], c(4, 9, 8, 5)) expect_equal(x15$rejectAtLeastOne, c(0, 0.2, 0.7, 0.9), tolerance = 1e-07) expect_equal(unlist(as.list(x15$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.3, 0.1, 0, 0, 0, 0, 0.2, 0, 0, 0.3, 0, 0, 0.4, 0.1, 0, 0, 0, 0, 0, 0, 0, 0.4, 0.3, 0, 0.6, 0.1), tolerance = 1e-07) expect_equal(x15$futilityStop, c(0.6, 0.1, 0, 0.1), tolerance = 1e-07) expect_equal(x15$futilityPerStage[1, ], c(0.2, 0.1, 0, 0.1), tolerance = 1e-07) expect_equal(x15$futilityPerStage[2, ], c(0.4, 0, 0, 0), tolerance = 1e-07) expect_equal(x15$earlyStop[1, ], c(0.2, 0.1, 0, 0.1), tolerance = 1e-07) expect_equal(x15$earlyStop[2, ], c(0.4, 0, 0.2, 0.4), tolerance = 1e-07) expect_equal(x15$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x15$successPerStage[2, ], c(0, 0, 0.2, 0.4), tolerance = 1e-07) expect_equal(x15$successPerStage[3, ], c(0, 0, 0.2, 0.1), tolerance = 1e-07) expect_equal(unlist(as.list(x15$selectedArms)), c(1, 0.7, 0.2, 1, 0.5, 0.2, 1, 0.7, 0.5, 1, 0.2, 0.2, 1, 0.5, 0.3, 1, 0.5, 0.4, 1, 0.3, 0.3, 1, 0.7, 0.4, 1, 0.6, 0.1, 1, 0.5, 0.4, 1, 0.7, 0.6, 1, 0.8, 0.4, 1, 0.4, 0.4, 1, 0.8, 0.8, 1, 0.8, 0.6, 1, 0.7, 0.5, 1, 0.8, 0.4, 1, 0.9, 0.9, 1, 1, 0.8, 1, 0.9, 0.5), tolerance = 1e-07) expect_equal(x15$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x15$numberOfActiveArms[2, ], c(2.75, 2.5555556, 2.5, 2.6666667), tolerance = 1e-07) expect_equal(x15$numberOfActiveArms[3, ], c(2.5, 2, 2.5, 3), tolerance = 1e-07) expect_equal(x15$expectedNumberOfSubjects, c(460, 640, 571.4, 381.6), tolerance = 1e-07) expect_equal(unlist(as.list(x15$sampleSizes)), c(10, 80, 50, 10, 55.555556, 22.222222, 10, 66.8, 38.5, 10, 22.222222, 1.6, 10, 55, 75, 10, 55.555556, 44.444444, 10, 27.8, 25.5, 10, 69.777778, 14.4, 10, 67.5, 25, 10, 55.555556, 44.444444, 10, 66.8, 48, 10, 80.888889, 14.4, 10, 42.5, 100, 10, 88.888889, 88.888889, 10, 76.8, 48, 10, 69.777778, 15.2, 10, 92.5, 100, 10, 100, 100, 10, 96.8, 73, 10, 92, 15.2), tolerance = 1e-07) expect_equal(x15$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x15$conditionalPowerAchieved[2, ], c(0.26433659, 0.055206819, 0.10369686, 0.046653519), tolerance = 1e-07) expect_equal(x15$conditionalPowerAchieved[3, ], c(0.023182671, 0.15953762, 0.43788092, 0.96046919), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x15), NA))) expect_output(print(x15)$show()) invisible(capture.output(expect_error(summary(x15), NA))) expect_output(summary(x15)$show()) x15CodeBased <- eval(parse(text = getObjectRCode(x15, stringWrapParagraphWidth = NULL))) expect_equal(x15CodeBased$iterations, x15$iterations, tolerance = 1e-05) expect_equal(x15CodeBased$rejectAtLeastOne, x15$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x15CodeBased$rejectedArmsPerStage, x15$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x15CodeBased$futilityStop, x15$futilityStop, tolerance = 1e-05) expect_equal(x15CodeBased$futilityPerStage, x15$futilityPerStage, tolerance = 1e-05) expect_equal(x15CodeBased$earlyStop, x15$earlyStop, tolerance = 1e-05) expect_equal(x15CodeBased$successPerStage, x15$successPerStage, tolerance = 1e-05) expect_equal(x15CodeBased$selectedArms, x15$selectedArms, tolerance = 1e-05) expect_equal(x15CodeBased$numberOfActiveArms, x15$numberOfActiveArms, tolerance = 1e-05) expect_equal(x15CodeBased$expectedNumberOfSubjects, x15$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x15CodeBased$sampleSizes, x15$sampleSizes, tolerance = 1e-05) expect_equal(x15CodeBased$conditionalPowerAchieved, x15$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x15), "character") df <- as.data.frame(x15) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x15) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x16 <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, typeOfSelection = "rBest", rValue = 2, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), intersectionTest = "Sidak", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x16' with expected results expect_equal(x16$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x16$iterations[2, ], c(9, 9, 10, 10)) expect_equal(x16$iterations[3, ], c(7, 9, 10, 8)) expect_equal(x16$rejectAtLeastOne, c(0, 0.2, 0.6, 1), tolerance = 1e-07) expect_equal(unlist(as.list(x16$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0.2, 0, 0.2, 0.4, 0, 0, 0, 0, 0.1, 0.1, 0, 0.1, 0.1, 0, 0.7, 0.1), tolerance = 1e-07) expect_equal(x16$futilityStop, c(0.3, 0.1, 0, 0), tolerance = 1e-07) expect_equal(x16$futilityPerStage[1, ], c(0.1, 0.1, 0, 0), tolerance = 1e-07) expect_equal(x16$futilityPerStage[2, ], c(0.2, 0, 0, 0), tolerance = 1e-07) expect_equal(x16$earlyStop[1, ], c(0.1, 0.1, 0, 0), tolerance = 1e-07) expect_equal(x16$earlyStop[2, ], c(0.2, 0, 0, 0.2), tolerance = 1e-07) expect_equal(x16$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x16$successPerStage[2, ], c(0, 0, 0, 0.2), tolerance = 1e-07) expect_equal(x16$successPerStage[3, ], c(0, 0.1, 0.1, 0.3), tolerance = 1e-07) expect_equal(unlist(as.list(x16$selectedArms)), c(1, 0.3, 0.3, 1, 0.2, 0.2, 1, 0.3, 0.3, 1, 0.1, 0.1, 1, 0.6, 0.4, 1, 0.5, 0.5, 1, 0.2, 0.2, 1, 0.2, 0.1, 1, 0.4, 0.2, 1, 0.2, 0.2, 1, 0.6, 0.6, 1, 0.8, 0.6, 1, 0.4, 0.3, 1, 0.8, 0.8, 1, 0.8, 0.8, 1, 0.9, 0.8, 1, 0.9, 0.7, 1, 0.9, 0.9, 1, 1, 1, 1, 1, 0.8), tolerance = 1e-07) expect_equal(x16$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x16$numberOfActiveArms[2, ], c(1.8888889, 1.8888889, 1.9, 2), tolerance = 1e-07) expect_equal(x16$numberOfActiveArms[3, ], c(1.7142857, 1.8888889, 1.9, 2), tolerance = 1e-07) expect_equal(x16$expectedNumberOfSubjects, c(465.5, 426.3, 413.1, 244.1), tolerance = 1e-07) expect_equal(unlist(as.list(x16$sampleSizes)), c(10, 20.555556, 42.857143, 10, 6.5555556, 22.222222, 10, 30, 1.2, 10, 2.2, 0.5, 10, 66.666667, 57.142857, 10, 42.111111, 55.555556, 10, 4.9, 13.9, 10, 14.1, 5, 10, 35.111111, 28.571429, 10, 11.777778, 1.5555556, 10, 44.7, 33.8, 10, 36.6, 21.75, 10, 41, 42.857143, 10, 63.333333, 68.222222, 10, 49.6, 57.3, 10, 32.9, 27.25, 10, 87.222222, 100, 10, 67.444444, 79.333333, 10, 69.6, 58.1, 10, 42.9, 27.25), tolerance = 1e-07) expect_equal(x16$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x16$conditionalPowerAchieved[2, ], c(0.096913955, 0.09039929, 0.11243241, 0.1746525), tolerance = 1e-07) expect_equal(x16$conditionalPowerAchieved[3, ], c(0.093425176, 0.41153932, 0.67843506, 0.87119979), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x16), NA))) expect_output(print(x16)$show()) invisible(capture.output(expect_error(summary(x16), NA))) expect_output(summary(x16)$show()) x16CodeBased <- eval(parse(text = getObjectRCode(x16, stringWrapParagraphWidth = NULL))) expect_equal(x16CodeBased$iterations, x16$iterations, tolerance = 1e-05) expect_equal(x16CodeBased$rejectAtLeastOne, x16$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x16CodeBased$rejectedArmsPerStage, x16$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x16CodeBased$futilityStop, x16$futilityStop, tolerance = 1e-05) expect_equal(x16CodeBased$futilityPerStage, x16$futilityPerStage, tolerance = 1e-05) expect_equal(x16CodeBased$earlyStop, x16$earlyStop, tolerance = 1e-05) expect_equal(x16CodeBased$successPerStage, x16$successPerStage, tolerance = 1e-05) expect_equal(x16CodeBased$selectedArms, x16$selectedArms, tolerance = 1e-05) expect_equal(x16CodeBased$numberOfActiveArms, x16$numberOfActiveArms, tolerance = 1e-05) expect_equal(x16CodeBased$expectedNumberOfSubjects, x16$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x16CodeBased$sampleSizes, x16$sampleSizes, tolerance = 1e-05) expect_equal(x16CodeBased$conditionalPowerAchieved, x16$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x16), "character") df <- as.data.frame(x16) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x16) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x17 <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, typeOfSelection = "epsilon", epsilonValue = 0.1, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), intersectionTest = "Simes", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x17' with expected results expect_equal(x17$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x17$iterations[2, ], c(9, 9, 8, 10)) expect_equal(x17$iterations[3, ], c(7, 8, 6, 5)) expect_equal(x17$rejectAtLeastOne, c(0, 0.3, 0.4, 0.8), tolerance = 1e-07) expect_equal(unlist(as.list(x17$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0.1, 0, 0.1, 0, 0, 0, 0, 0.1, 0, 0.1, 0.1, 0, 0.1, 0.4, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.3, 0, 0.1, 0.3, 0.2), tolerance = 1e-07) expect_equal(x17$futilityStop, c(0.3, 0.1, 0.2, 0), tolerance = 1e-07) expect_equal(x17$futilityPerStage[1, ], c(0.1, 0.1, 0.2, 0), tolerance = 1e-07) expect_equal(x17$futilityPerStage[2, ], c(0.2, 0, 0, 0), tolerance = 1e-07) expect_equal(x17$earlyStop[1, ], c(0.1, 0.1, 0.2, 0), tolerance = 1e-07) expect_equal(x17$earlyStop[2, ], c(0.2, 0.1, 0.2, 0.5), tolerance = 1e-07) expect_equal(x17$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x17$successPerStage[2, ], c(0, 0.1, 0.2, 0.5), tolerance = 1e-07) expect_equal(x17$successPerStage[3, ], c(0, 0.1, 0.2, 0.3), tolerance = 1e-07) expect_equal(unlist(as.list(x17$selectedArms)), c(1, 0.3, 0.1, 1, 0.2, 0.1, 1, 0.1, 0, 1, 0.1, 0.1, 1, 0.2, 0.1, 1, 0.6, 0.4, 1, 0.3, 0.1, 1, 0.3, 0.1, 1, 0.3, 0.2, 1, 0.4, 0.4, 1, 0.4, 0.2, 1, 0.7, 0.3, 1, 0.4, 0.4, 1, 0.1, 0.1, 1, 0.7, 0.5, 1, 0.6, 0.2, 1, 0.9, 0.7, 1, 0.9, 0.8, 1, 0.8, 0.6, 1, 1, 0.5), tolerance = 1e-07) expect_equal(x17$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x17$numberOfActiveArms[2, ], c(1.3333333, 1.4444444, 1.875, 1.7), tolerance = 1e-07) expect_equal(x17$numberOfActiveArms[3, ], c(1.1428571, 1.25, 1.3333333, 1.4), tolerance = 1e-07) expect_equal(x17$expectedNumberOfSubjects, c(339.9, 359.2, 222.7, 176), tolerance = 1e-07) expect_equal(unlist(as.list(x17$sampleSizes)), c(10, 31.333333, 14.285714, 10, 17.666667, 8.125, 10, 12.5, 0, 10, 1.2, 7.4, 10, 21.222222, 14.285714, 10, 35.888889, 50, 10, 25.625, 16.666667, 10, 13.6, 7.4, 10, 24.666667, 21.142857, 10, 33.222222, 50, 10, 31.5, 17.333333, 10, 26.2, 9.8, 10, 22.444444, 57.142857, 10, 5.1111111, 12.5, 10, 33, 19.833333, 10, 21.2, 12.2, 10, 67.333333, 92.571429, 10, 59.444444, 95.625, 10, 45.5, 36.5, 10, 34.4, 22), tolerance = 1e-07) expect_equal(x17$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x17$conditionalPowerAchieved[2, ], c(0.039329058, 0.14668797, 0.16576057, 0.14296603), tolerance = 1e-07) expect_equal(x17$conditionalPowerAchieved[3, ], c(0.28763166, 0.40839298, 0.6012117, 0.84313531), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x17), NA))) expect_output(print(x17)$show()) invisible(capture.output(expect_error(summary(x17), NA))) expect_output(summary(x17)$show()) x17CodeBased <- eval(parse(text = getObjectRCode(x17, stringWrapParagraphWidth = NULL))) expect_equal(x17CodeBased$iterations, x17$iterations, tolerance = 1e-05) expect_equal(x17CodeBased$rejectAtLeastOne, x17$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x17CodeBased$rejectedArmsPerStage, x17$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x17CodeBased$futilityStop, x17$futilityStop, tolerance = 1e-05) expect_equal(x17CodeBased$futilityPerStage, x17$futilityPerStage, tolerance = 1e-05) expect_equal(x17CodeBased$earlyStop, x17$earlyStop, tolerance = 1e-05) expect_equal(x17CodeBased$successPerStage, x17$successPerStage, tolerance = 1e-05) expect_equal(x17CodeBased$selectedArms, x17$selectedArms, tolerance = 1e-05) expect_equal(x17CodeBased$numberOfActiveArms, x17$numberOfActiveArms, tolerance = 1e-05) expect_equal(x17CodeBased$expectedNumberOfSubjects, x17$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x17CodeBased$sampleSizes, x17$sampleSizes, tolerance = 1e-05) expect_equal(x17CodeBased$conditionalPowerAchieved, x17$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x17), "character") df <- as.data.frame(x17) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x17) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x18 <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), intersectionTest = "Simes", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x18' with expected results expect_equal(x18$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x18$iterations[2, ], c(7, 8, 8, 10)) expect_equal(x18$iterations[3, ], c(7, 8, 7, 5)) expect_equal(x18$rejectAtLeastOne, c(0.1, 0.1, 0.3, 0.7), tolerance = 1e-07) expect_equal(unlist(as.list(x18$rejectedArmsPerStage)), c(0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0.2, 0, 0, 0, 0, 0, 0, 0.1, 0, 0.1, 0.1, 0, 0.1, 0.1), tolerance = 1e-07) expect_equal(x18$futilityStop, c(0.3, 0.2, 0.2, 0), tolerance = 1e-07) expect_equal(x18$futilityPerStage[1, ], c(0.3, 0.2, 0.2, 0), tolerance = 1e-07) expect_equal(x18$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x18$earlyStop[1, ], c(0.3, 0.2, 0.2, 0), tolerance = 1e-07) expect_equal(x18$earlyStop[2, ], c(0, 0, 0.1, 0.5), tolerance = 1e-07) expect_equal(x18$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x18$successPerStage[2, ], c(0, 0, 0.1, 0.5), tolerance = 1e-07) expect_equal(x18$successPerStage[3, ], c(0.1, 0.1, 0.2, 0.2), tolerance = 1e-07) expect_equal(unlist(as.list(x18$selectedArms)), c(1, 0.2, 0.2, 1, 0.2, 0.2, 1, 0, 0, 1, 0.2, 0.1, 1, 0.2, 0.2, 1, 0.2, 0.2, 1, 0.2, 0.2, 1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.1, 0.1, 1, 0.4, 0.4, 1, 0.4, 0.1, 1, 0.2, 0.2, 1, 0.3, 0.3, 1, 0.2, 0.1, 1, 0.3, 0.2, 1, 0.7, 0.7, 1, 0.8, 0.8, 1, 0.8, 0.7, 1, 1, 0.5), tolerance = 1e-07) expect_equal(x18$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x18$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x18$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x18$expectedNumberOfSubjects, c(241.6, 306.8, 235.2, 156), tolerance = 1e-07) expect_equal(unlist(as.list(x18$sampleSizes)), c(10, 27.285714, 27.285714, 10, 25, 25, 10, 0, 0, 10, 2.6, 4.4, 10, 16.142857, 16.142857, 10, 16, 16, 10, 3.5, 4, 10, 1.4, 2.8, 10, 14.285714, 14.285714, 10, 12.5, 12.5, 10, 40.875, 46.571429, 10, 15.8, 5.2, 10, 10.714286, 10.714286, 10, 26.75, 26.75, 10, 19.875, 8.2857143, 10, 18.6, 16.8, 10, 68.428571, 68.428571, 10, 80.25, 80.25, 10, 64.25, 58.857143, 10, 38.4, 29.2), tolerance = 1e-07) expect_equal(x18$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x18$conditionalPowerAchieved[2, ], c(0.064400041, 0.012818439, 0.075196936, 0.13824332), tolerance = 1e-07) expect_equal(x18$conditionalPowerAchieved[3, ], c(0.066989319, 0.23112098, 0.45267281, 0.52012057), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x18), NA))) expect_output(print(x18)$show()) invisible(capture.output(expect_error(summary(x18), NA))) expect_output(summary(x18)$show()) x18CodeBased <- eval(parse(text = getObjectRCode(x18, stringWrapParagraphWidth = NULL))) expect_equal(x18CodeBased$iterations, x18$iterations, tolerance = 1e-05) expect_equal(x18CodeBased$rejectAtLeastOne, x18$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x18CodeBased$rejectedArmsPerStage, x18$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x18CodeBased$futilityStop, x18$futilityStop, tolerance = 1e-05) expect_equal(x18CodeBased$futilityPerStage, x18$futilityPerStage, tolerance = 1e-05) expect_equal(x18CodeBased$earlyStop, x18$earlyStop, tolerance = 1e-05) expect_equal(x18CodeBased$successPerStage, x18$successPerStage, tolerance = 1e-05) expect_equal(x18CodeBased$selectedArms, x18$selectedArms, tolerance = 1e-05) expect_equal(x18CodeBased$numberOfActiveArms, x18$numberOfActiveArms, tolerance = 1e-05) expect_equal(x18CodeBased$expectedNumberOfSubjects, x18$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x18CodeBased$sampleSizes, x18$sampleSizes, tolerance = 1e-05) expect_equal(x18CodeBased$conditionalPowerAchieved, x18$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x18), "character") df <- as.data.frame(x18) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x18) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x19 <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, typeOfSelection = "all", plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), intersectionTest = "Simes", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x19' with expected results expect_equal(x19$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x19$iterations[2, ], c(8, 8, 10, 10)) expect_equal(x19$iterations[3, ], c(8, 8, 9, 9)) expect_equal(x19$rejectAtLeastOne, c(0, 0, 0.9, 1), tolerance = 1e-07) expect_equal(unlist(as.list(x19$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.2, 0, 0.4, 0.2, 0, 0, 0, 0, 0, 0, 0, 0.5, 0.1, 0, 0.6, 0.2, 0, 0, 0, 0, 0, 0, 0, 0.8, 0.1, 0, 0.7, 0), tolerance = 1e-07) expect_equal(x19$futilityStop, c(0.2, 0.2, 0, 0), tolerance = 1e-07) expect_equal(x19$futilityPerStage[1, ], c(0.2, 0.2, 0, 0), tolerance = 1e-07) expect_equal(x19$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x19$earlyStop[1, ], c(0.2, 0.2, 0, 0), tolerance = 1e-07) expect_equal(x19$earlyStop[2, ], c(0, 0, 0.1, 0.1), tolerance = 1e-07) expect_equal(x19$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x19$successPerStage[2, ], c(0, 0, 0.1, 0.1), tolerance = 1e-07) expect_equal(x19$successPerStage[3, ], c(0, 0, 0.1, 0.2), tolerance = 1e-07) expect_equal(unlist(as.list(x19$selectedArms)), c(1, 0.3, 0.3, 1, 0.3, 0.3, 1, 0.8, 0.8, 1, 0.6, 0.6, 1, 0.5, 0.5, 1, 0.6, 0.6, 1, 0.7, 0.6, 1, 0.9, 0.8, 1, 0.5, 0.5, 1, 0.5, 0.5, 1, 0.9, 0.8, 1, 0.8, 0.7, 1, 0.6, 0.6, 1, 0.5, 0.5, 1, 0.9, 0.8, 1, 0.8, 0.7, 1, 0.8, 0.8, 1, 0.8, 0.8, 1, 1, 0.9, 1, 1, 0.9), tolerance = 1e-07) expect_equal(x19$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x19$numberOfActiveArms[2, ], c(2.375, 2.375, 3.3, 3.1), tolerance = 1e-07) expect_equal(x19$numberOfActiveArms[3, ], c(2.375, 2.375, 3.3333333, 3.1111111), tolerance = 1e-07) expect_equal(x19$expectedNumberOfSubjects, c(523.8, 590, 818.4, 765.4), tolerance = 1e-07) expect_equal(unlist(as.list(x19$sampleSizes)), c(10, 28.125, 28.125, 10, 37.5, 37.5, 10, 73.6, 81.666667, 10, 55.2, 61.333333, 10, 58.625, 58.625, 10, 75, 75, 10, 70, 66.666667, 10, 85.2, 83.555556, 10, 53.125, 53.125, 10, 62.5, 62.5, 10, 83.6, 81.666667, 10, 71.1, 67.777778, 10, 65.625, 65.625, 10, 62.5, 62.5, 10, 83.6, 81.666667, 10, 75.2, 72.444444, 10, 90.625, 90.625, 10, 100, 100, 10, 93.6, 92.777778, 10, 91.1, 90), tolerance = 1e-07) expect_equal(x19$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x19$conditionalPowerAchieved[2, ], c(0.10081958, 0.049714416, 0.18629752, 0.24626925), tolerance = 1e-07) expect_equal(x19$conditionalPowerAchieved[3, ], c(0.088506618, 0.13049081, 0.60815392, 0.85577973), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x19), NA))) expect_output(print(x19)$show()) invisible(capture.output(expect_error(summary(x19), NA))) expect_output(summary(x19)$show()) x19CodeBased <- eval(parse(text = getObjectRCode(x19, stringWrapParagraphWidth = NULL))) expect_equal(x19CodeBased$iterations, x19$iterations, tolerance = 1e-05) expect_equal(x19CodeBased$rejectAtLeastOne, x19$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x19CodeBased$rejectedArmsPerStage, x19$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x19CodeBased$futilityStop, x19$futilityStop, tolerance = 1e-05) expect_equal(x19CodeBased$futilityPerStage, x19$futilityPerStage, tolerance = 1e-05) expect_equal(x19CodeBased$earlyStop, x19$earlyStop, tolerance = 1e-05) expect_equal(x19CodeBased$successPerStage, x19$successPerStage, tolerance = 1e-05) expect_equal(x19CodeBased$selectedArms, x19$selectedArms, tolerance = 1e-05) expect_equal(x19CodeBased$numberOfActiveArms, x19$numberOfActiveArms, tolerance = 1e-05) expect_equal(x19CodeBased$expectedNumberOfSubjects, x19$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x19CodeBased$sampleSizes, x19$sampleSizes, tolerance = 1e-05) expect_equal(x19CodeBased$conditionalPowerAchieved, x19$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x19), "character") df <- as.data.frame(x19) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x19) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x20 <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, typeOfSelection = "rBest", rValue = 2, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), intersectionTest = "Hierarchical", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x20' with expected results expect_equal(x20$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x20$iterations[2, ], c(7, 7, 9, 10)) expect_equal(x20$iterations[3, ], c(2, 5, 3, 1)) expect_equal(x20$rejectAtLeastOne, c(0, 0, 0.2, 0), tolerance = 1e-07) expect_equal(unlist(as.list(x20$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), tolerance = 1e-07) expect_equal(x20$futilityStop, c(0.8, 0.5, 0.6, 0.9), tolerance = 1e-07) expect_equal(x20$futilityPerStage[1, ], c(0.3, 0.3, 0.1, 0), tolerance = 1e-07) expect_equal(x20$futilityPerStage[2, ], c(0.5, 0.2, 0.5, 0.9), tolerance = 1e-07) expect_equal(x20$earlyStop[1, ], c(0.3, 0.3, 0.1, 0), tolerance = 1e-07) expect_equal(x20$earlyStop[2, ], c(0.5, 0.2, 0.6, 0.9), tolerance = 1e-07) expect_equal(x20$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x20$successPerStage[2, ], c(0, 0, 0.1, 0), tolerance = 1e-07) expect_equal(x20$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x20$selectedArms)), c(1, 0.2, 0.2, 1, 0.5, 0.5, 1, 0.4, 0.3, 1, 0.1, 0.1, 1, 0.3, 0.1, 1, 0.2, 0, 1, 0.1, 0, 1, 0.4, 0, 1, 0.2, 0, 1, 0.3, 0.3, 1, 0.5, 0.1, 1, 0.8, 0, 1, 0.5, 0.1, 1, 0.4, 0.2, 1, 0.6, 0.2, 1, 0.7, 0.1, 1, 0.7, 0.2, 1, 0.7, 0.5, 1, 0.9, 0.3, 1, 1, 0.1), tolerance = 1e-07) expect_equal(x20$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x20$numberOfActiveArms[2, ], c(1.7142857, 2, 1.7777778, 2), tolerance = 1e-07) expect_equal(x20$numberOfActiveArms[3, ], c(2, 2, 2, 2)) expect_equal(x20$expectedNumberOfSubjects, c(267.3, 301.1, 325.2, 315.5), tolerance = 1e-07) expect_equal(unlist(as.list(x20$sampleSizes)), c(10, 24.142857, 84.5, 10, 51.714286, 72.2, 10, 39, 83.333333, 10, 8.8, 88, 10, 36.142857, 50, 10, 16.285714, 0, 10, 4.1111111, 0, 10, 28.2, 0, 10, 28.571429, 0, 10, 30.142857, 42.2, 10, 42.555556, 33.333333, 10, 60.9, 0, 10, 60.285714, 34.5, 10, 37.857143, 30, 10, 55.222222, 50, 10, 61.5, 88, 10, 88.857143, 84.5, 10, 68, 72.2, 10, 81.555556, 83.333333, 10, 79.7, 88), tolerance = 1e-07) expect_equal(x20$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x20$conditionalPowerAchieved[2, ], c(0.14688077, 0.19244817, 0.083030211, 0.1268121), tolerance = 1e-07) expect_equal(x20$conditionalPowerAchieved[3, ], c(0.021357961, 0.35341345, 0.67128636, 1), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x20), NA))) expect_output(print(x20)$show()) invisible(capture.output(expect_error(summary(x20), NA))) expect_output(summary(x20)$show()) x20CodeBased <- eval(parse(text = getObjectRCode(x20, stringWrapParagraphWidth = NULL))) expect_equal(x20CodeBased$iterations, x20$iterations, tolerance = 1e-05) expect_equal(x20CodeBased$rejectAtLeastOne, x20$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x20CodeBased$rejectedArmsPerStage, x20$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x20CodeBased$futilityStop, x20$futilityStop, tolerance = 1e-05) expect_equal(x20CodeBased$futilityPerStage, x20$futilityPerStage, tolerance = 1e-05) expect_equal(x20CodeBased$earlyStop, x20$earlyStop, tolerance = 1e-05) expect_equal(x20CodeBased$successPerStage, x20$successPerStage, tolerance = 1e-05) expect_equal(x20CodeBased$selectedArms, x20$selectedArms, tolerance = 1e-05) expect_equal(x20CodeBased$numberOfActiveArms, x20$numberOfActiveArms, tolerance = 1e-05) expect_equal(x20CodeBased$expectedNumberOfSubjects, x20$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x20CodeBased$sampleSizes, x20$sampleSizes, tolerance = 1e-05) expect_equal(x20CodeBased$conditionalPowerAchieved, x20$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x20), "character") df <- as.data.frame(x20) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x20) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x21 <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0, typeOfSelection = "epsilon", epsilonValue = 0.1, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = c(TRUE, FALSE), intersectionTest = "Hierarchical", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10) ## Comparison of the results of SimulationResultsMultiArmRates object 'x21' with expected results expect_equal(x21$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x21$iterations[2, ], c(9, 9, 9, 10)) expect_equal(x21$iterations[3, ], c(2, 4, 4, 2)) expect_equal(x21$rejectAtLeastOne, c(0, 0, 0, 0)) expect_equal(unlist(as.list(x21$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x21$futilityStop, c(0.8, 0.6, 0.6, 0.8), tolerance = 1e-07) expect_equal(x21$futilityPerStage[1, ], c(0.1, 0.1, 0.1, 0), tolerance = 1e-07) expect_equal(x21$futilityPerStage[2, ], c(0.7, 0.5, 0.5, 0.8), tolerance = 1e-07) expect_equal(x21$earlyStop[1, ], c(0.1, 0.1, 0.1, 0), tolerance = 1e-07) expect_equal(x21$earlyStop[2, ], c(0.7, 0.5, 0.5, 0.8), tolerance = 1e-07) expect_equal(x21$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x21$successPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x21$successPerStage[3, ], c(0, 0, 0, 0)) expect_equal(unlist(as.list(x21$selectedArms)), c(1, 0.2, 0.2, 1, 0.4, 0.4, 1, 0.4, 0.4, 1, 0.2, 0.2, 1, 0.2, 0, 1, 0.2, 0.1, 1, 0.3, 0.1, 1, 0.4, 0.1, 1, 0.5, 0.1, 1, 0.5, 0.2, 1, 0.2, 0.2, 1, 0.7, 0.1, 1, 0.4, 0, 1, 0.2, 0, 1, 0.7, 0.3, 1, 0.9, 0.2, 1, 0.9, 0.2, 1, 0.9, 0.4, 1, 0.9, 0.4, 1, 1, 0.2), tolerance = 1e-07) expect_equal(x21$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x21$numberOfActiveArms[2, ], c(1.4444444, 1.4444444, 1.7777778, 2.2), tolerance = 1e-07) expect_equal(x21$numberOfActiveArms[3, ], c(1.5, 1.75, 2.5, 3), tolerance = 1e-07) expect_equal(x21$expectedNumberOfSubjects, c(240.6, 332.2, 346.2, 256.5), tolerance = 1e-07) expect_equal(unlist(as.list(x21$sampleSizes)), c(10, 17.666667, 79, 10, 39.222222, 88.25, 10, 35.777778, 80.25, 10, 7.9, 39, 10, 13.555556, 0, 10, 22.222222, 25, 10, 24.666667, 5.25, 10, 17.7, 25, 10, 42.333333, 50, 10, 47.555556, 50, 10, 22.222222, 50, 10, 44.9, 25, 10, 27.111111, 0, 10, 14.111111, 0, 10, 51.888889, 55.25, 10, 50.7, 39, 10, 64.888889, 79, 10, 78.666667, 88.25, 10, 74.111111, 80.25, 10, 51.9, 39), tolerance = 1e-07) expect_equal(x21$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x21$conditionalPowerAchieved[2, ], c(0.071382822, 0.0014758747, 0.067299064, 0.14413714), tolerance = 1e-07) expect_equal(x21$conditionalPowerAchieved[3, ], c(0.29927137, 0.0060466075, 0.55383829, 0.59417789), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x21), NA))) expect_output(print(x21)$show()) invisible(capture.output(expect_error(summary(x21), NA))) expect_output(summary(x21)$show()) x21CodeBased <- eval(parse(text = getObjectRCode(x21, stringWrapParagraphWidth = NULL))) expect_equal(x21CodeBased$iterations, x21$iterations, tolerance = 1e-05) expect_equal(x21CodeBased$rejectAtLeastOne, x21$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x21CodeBased$rejectedArmsPerStage, x21$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x21CodeBased$futilityStop, x21$futilityStop, tolerance = 1e-05) expect_equal(x21CodeBased$futilityPerStage, x21$futilityPerStage, tolerance = 1e-05) expect_equal(x21CodeBased$earlyStop, x21$earlyStop, tolerance = 1e-05) expect_equal(x21CodeBased$successPerStage, x21$successPerStage, tolerance = 1e-05) expect_equal(x21CodeBased$selectedArms, x21$selectedArms, tolerance = 1e-05) expect_equal(x21CodeBased$numberOfActiveArms, x21$numberOfActiveArms, tolerance = 1e-05) expect_equal(x21CodeBased$expectedNumberOfSubjects, x21$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x21CodeBased$sampleSizes, x21$sampleSizes, tolerance = 1e-05) expect_equal(x21CodeBased$conditionalPowerAchieved, x21$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x21), "character") df <- as.data.frame(x21) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x21) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x22 <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), activeArms = 4, threshold = 0.1, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.1, 0.3, 0.1), intersectionTest = "Hierarchical", conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), directionUpper = FALSE, maxNumberOfIterations = 1) ## Comparison of the results of SimulationResultsMultiArmRates object 'x22' with expected results expect_equal(x22$iterations[1, ], c(1, 1, 1)) expect_equal(x22$iterations[2, ], c(0, 1, 0)) expect_equal(x22$iterations[3, ], c(0, 0, 0)) expect_equal(x22$rejectAtLeastOne, c(0, 0, 0)) expect_equal(unlist(as.list(x22$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)) expect_equal(x22$futilityStop, c(1, 1, 1)) expect_equal(x22$futilityPerStage[1, ], c(1, 0, 1)) expect_equal(x22$futilityPerStage[2, ], c(0, 1, 0)) expect_equal(x22$earlyStop[1, ], c(1, 0, 1)) expect_equal(x22$earlyStop[2, ], c(0, 1, 0)) expect_equal(x22$successPerStage[1, ], c(0, 0, 0)) expect_equal(x22$successPerStage[2, ], c(0, 0, 0)) expect_equal(x22$successPerStage[3, ], c(0, 0, 0)) expect_equal(unlist(as.list(x22$selectedArms)), c(1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 0, 0)) expect_equal(x22$numberOfActiveArms[1, ], c(4, 4, 4)) expect_equal(x22$numberOfActiveArms[2, ], c(NaN, 1, NaN)) expect_equal(x22$numberOfActiveArms[3, ], c(NaN, NaN, NaN)) expect_equal(x22$expectedNumberOfSubjects, c(NaN, NaN, NaN)) expect_equal(unlist(as.list(x22$sampleSizes)), c(10, 0, 0, 10, 0, 0, 10, NaN, NaN, 10, 0, 0, 10, 0, 0, 10, NaN, NaN, 10, 0, 0, 10, 91, 0, 10, NaN, NaN, 10, 0, 0, 10, 0, 0, 10, NaN, NaN, 10, 0, 0, 10, 91, 0, 10, NaN, NaN)) expect_equal(x22$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x22$conditionalPowerAchieved[2, ], c(NaN, 3.7427402e-05, NaN), tolerance = 1e-07) expect_equal(x22$conditionalPowerAchieved[3, ], c(NaN, NaN, NaN)) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x22), NA))) expect_output(print(x22)$show()) invisible(capture.output(expect_error(summary(x22), NA))) expect_output(summary(x22)$show()) x22CodeBased <- eval(parse(text = getObjectRCode(x22, stringWrapParagraphWidth = NULL))) expect_equal(x22CodeBased$iterations, x22$iterations, tolerance = 1e-05) expect_equal(x22CodeBased$rejectAtLeastOne, x22$rejectAtLeastOne, tolerance = 1e-05) expect_equal(x22CodeBased$rejectedArmsPerStage, x22$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(x22CodeBased$futilityStop, x22$futilityStop, tolerance = 1e-05) expect_equal(x22CodeBased$futilityPerStage, x22$futilityPerStage, tolerance = 1e-05) expect_equal(x22CodeBased$earlyStop, x22$earlyStop, tolerance = 1e-05) expect_equal(x22CodeBased$successPerStage, x22$successPerStage, tolerance = 1e-05) expect_equal(x22CodeBased$selectedArms, x22$selectedArms, tolerance = 1e-05) expect_equal(x22CodeBased$numberOfActiveArms, x22$numberOfActiveArms, tolerance = 1e-05) expect_equal(x22CodeBased$expectedNumberOfSubjects, x22$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(x22CodeBased$sampleSizes, x22$sampleSizes, tolerance = 1e-05) expect_equal(x22CodeBased$conditionalPowerAchieved, x22$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x22), "character") df <- as.data.frame(x22) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x22) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationMultiArmRates': using calcSubjectsFunction", { .skipTestIfDisabled() .skipTestIfNotX64() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmRates} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmRatesGenerate} # @refFS[Formula]{fs:SimulationMultiArmRatesTestStatistics} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} calcSubjectsFunctionSimulationMultiArmRates <- function(..., stage, minNumberOfSubjectsPerStage) { return(ifelse(stage == 3, 33, minNumberOfSubjectsPerStage[stage])) } x <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), typeOfShape = "linear", activeArms = 4, plannedSubjects = c(10, 30, 50), piControl = 0.3, piMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), minNumberOfSubjectsPerStage = c(10, 4, 4), maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 10, calcSubjectsFunction = calcSubjectsFunctionSimulationMultiArmRates) ## Comparison of the results of SimulationResultsMultiArmRates object 'x' with expected results expect_equal(x$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x$iterations[3, ], c(10, 10, 10, 9)) expect_equal(x$rejectAtLeastOne, c(0, 0, 0.2, 0.4), tolerance = 1e-07) expect_equal(unlist(as.list(x$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0, 0.1, 0.3), tolerance = 1e-07) expect_equal(x$futilityStop, c(0, 0, 0, 0)) expect_equal(x$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x$earlyStop[2, ], c(0, 0, 0, 0.1), tolerance = 1e-07) expect_equal(x$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x$successPerStage[2, ], c(0, 0, 0, 0.1), tolerance = 1e-07) expect_equal(x$successPerStage[3, ], c(0, 0, 0.2, 0.3), tolerance = 1e-07) expect_equal(unlist(as.list(x$selectedArms)), c(1, 0.1, 0.1, 1, 0.4, 0.4, 1, 0, 0, 1, 0.1, 0.1, 1, 0, 0, 1, 0.1, 0.1, 1, 0.4, 0.4, 1, 0.2, 0.2, 1, 0.3, 0.3, 1, 0.2, 0.2, 1, 0.2, 0.2, 1, 0.1, 0.1, 1, 0.6, 0.6, 1, 0.3, 0.3, 1, 0.4, 0.4, 1, 0.6, 0.5, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0.9), tolerance = 1e-07) expect_equal(x$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x$expectedNumberOfSubjects, c(124, 124, 124, 117.4), tolerance = 1e-07) expect_equal(unlist(as.list(x$sampleSizes)), c(10, 0.4, 3.3, 10, 1.6, 13.2, 10, 0, 0, 10, 0.4, 3.6666667, 10, 0, 0, 10, 0.4, 3.3, 10, 1.6, 13.2, 10, 0.8, 7.3333333, 10, 1.2, 9.9, 10, 0.8, 6.6, 10, 0.8, 6.6, 10, 0.4, 3.6666667, 10, 2.4, 19.8, 10, 1.2, 9.9, 10, 1.6, 13.2, 10, 2.4, 18.333333, 10, 4, 33, 10, 4, 33, 10, 4, 33, 10, 4, 33), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$conditionalPowerAchieved[2, ], c(0.012189382, 0.016190277, 0.020380353, 0.11925746), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[3, ], c(0.32488024, 0.34652134, 0.40081174, 0.68872913), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x), NA))) expect_output(print(x)$show()) invisible(capture.output(expect_error(summary(x), NA))) expect_output(summary(x)$show()) xCodeBased <- eval(parse(text = getObjectRCode(x, stringWrapParagraphWidth = NULL))) expect_equal(xCodeBased$iterations, x$iterations, tolerance = 1e-05) expect_equal(xCodeBased$rejectAtLeastOne, x$rejectAtLeastOne, tolerance = 1e-05) expect_equal(xCodeBased$rejectedArmsPerStage, x$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$futilityStop, x$futilityStop, tolerance = 1e-05) expect_equal(xCodeBased$futilityPerStage, x$futilityPerStage, tolerance = 1e-05) expect_equal(xCodeBased$earlyStop, x$earlyStop, tolerance = 1e-05) expect_equal(xCodeBased$successPerStage, x$successPerStage, tolerance = 1e-05) expect_equal(xCodeBased$selectedArms, x$selectedArms, tolerance = 1e-05) expect_equal(xCodeBased$numberOfActiveArms, x$numberOfActiveArms, tolerance = 1e-05) expect_equal(xCodeBased$expectedNumberOfSubjects, x$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(xCodeBased$sampleSizes, x$sampleSizes, tolerance = 1e-05) expect_equal(xCodeBased$conditionalPowerAchieved, x$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x), "character") df <- as.data.frame(x) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationMultiArmRates': using selectArmsFunction", { .skipTestIfDisabled() .skipTestIfNotX64() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmRates} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmRatesGenerate} # @refFS[Formula]{fs:SimulationMultiArmRatesTestStatistics} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} selectArmsFunctionSimulationMultiArmRates <- function(effectSizes) { return(c(TRUE, FALSE, FALSE, FALSE)) } x <- getSimulationMultiArmRates(seed = 1234, getDesignFisher(informationRates = c(0.2, 0.6, 1)), typeOfShape = "linear", activeArms = 4, plannedSubjects = c(10, 30, 50), piMaxVector = seq(0.3, 0.6, 0.1), adaptations = rep(TRUE, 2), maxNumberOfIterations = 10, selectArmsFunction = selectArmsFunctionSimulationMultiArmRates, typeOfSelection = "userDefined") ## Comparison of the results of SimulationResultsMultiArmRates object 'x' with expected results expect_equal(x$iterations[1, ], c(10, 10, 10, 10)) expect_equal(x$iterations[2, ], c(10, 10, 10, 10)) expect_equal(x$iterations[3, ], c(10, 10, 10, 9)) expect_equal(x$rejectAtLeastOne, c(0, 0, 0.1, 0.4), tolerance = 1e-07) expect_equal(unlist(as.list(x$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.4, 0, 0), tolerance = 1e-07) expect_equal(x$futilityStop, c(0, 0, 0, 0)) expect_equal(x$futilityPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x$futilityPerStage[2, ], c(0, 0, 0, 0)) expect_equal(x$earlyStop[1, ], c(0, 0, 0, 0)) expect_equal(x$earlyStop[2, ], c(0, 0, 0, 0.1), tolerance = 1e-07) expect_equal(x$successPerStage[1, ], c(0, 0, 0, 0)) expect_equal(x$successPerStage[2, ], c(0, 0, 0, 0.1), tolerance = 1e-07) expect_equal(x$successPerStage[3, ], c(0, 0, 0.1, 0), tolerance = 1e-07) expect_equal(unlist(as.list(x$selectedArms)), c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0.9, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0.9), tolerance = 1e-07) expect_equal(x$numberOfActiveArms[1, ], c(4, 4, 4, 4)) expect_equal(x$numberOfActiveArms[2, ], c(1, 1, 1, 1)) expect_equal(x$numberOfActiveArms[3, ], c(1, 1, 1, 1)) expect_equal(x$expectedNumberOfSubjects, c(130, 130, 130, 126)) expect_equal(unlist(as.list(x$sampleSizes)), c(10, 20, 20, 10, 20, 20, 10, 20, 20, 10, 20, 20, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 0, 0, 10, 20, 20, 10, 20, 20, 10, 20, 20, 10, 20, 20)) expect_equal(x$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$conditionalPowerAchieved[2, ], c(0.044616119, 0.11264062, 0.1248477, 0.43958255), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[3, ], c(0.087582974, 0.1172724, 0.15105487, 0.4331775), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x), NA))) expect_output(print(x)$show()) invisible(capture.output(expect_error(summary(x), NA))) expect_output(summary(x)$show()) xCodeBased <- eval(parse(text = getObjectRCode(x, stringWrapParagraphWidth = NULL))) expect_equal(xCodeBased$iterations, x$iterations, tolerance = 1e-05) expect_equal(xCodeBased$rejectAtLeastOne, x$rejectAtLeastOne, tolerance = 1e-05) expect_equal(xCodeBased$rejectedArmsPerStage, x$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$futilityStop, x$futilityStop, tolerance = 1e-05) expect_equal(xCodeBased$futilityPerStage, x$futilityPerStage, tolerance = 1e-05) expect_equal(xCodeBased$earlyStop, x$earlyStop, tolerance = 1e-05) expect_equal(xCodeBased$successPerStage, x$successPerStage, tolerance = 1e-05) expect_equal(xCodeBased$selectedArms, x$selectedArms, tolerance = 1e-05) expect_equal(xCodeBased$numberOfActiveArms, x$numberOfActiveArms, tolerance = 1e-05) expect_equal(xCodeBased$expectedNumberOfSubjects, x$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(xCodeBased$sampleSizes, x$sampleSizes, tolerance = 1e-05) expect_equal(xCodeBased$conditionalPowerAchieved, x$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x), "character") df <- as.data.frame(x) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationMultiArmRates': typeOfShape = sigmoidEmax", { .skipTestIfDisabled() .skipTestIfNotX64() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmRates} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmRatesGenerate} # @refFS[Formula]{fs:SimulationMultiArmRatesTestStatistics} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} designIN <- getDesignInverseNormal(typeOfDesign = "P", kMax = 3, futilityBounds = c(0, 0)) x <- getSimulationMultiArmRates(designIN, activeArms = 3, typeOfShape = "sigmoidEmax", piMaxVector = seq(0.1, 0.9, 0.2), gED50 = 2, plannedSubjects = cumsum(rep(20, 3)), piControl = 0.1, intersectionTest = "Sidak", typeOfSelection = "rBest", rValue = 2, threshold = -Inf, successCriterion = "all", maxNumberOfIterations = 100, seed = 3456) ## Comparison of the results of SimulationResultsMultiArmRates object 'x' with expected results expect_equal(x$iterations[1, ], c(100, 100, 100, 100, 100)) expect_equal(x$iterations[2, ], c(20, 60, 88, 84, 81)) expect_equal(x$iterations[3, ], c(4, 45, 70, 38, 20)) expect_equal(x$rejectAtLeastOne, c(0, 0.07, 0.55, 0.89, 0.99), tolerance = 1e-07) expect_equal(unlist(as.list(x$rejectedArmsPerStage)), c(0, 0, 0, 0, 0, 0, 0.03, 0.02, 0.01, 0.11, 0.11, 0.05, 0.19, 0.06, 0.03, 0, 0, 0, 0, 0.01, 0.03, 0.07, 0.1, 0.13, 0.3, 0.22, 0.14, 0.45, 0.3, 0.12, 0, 0, 0, 0.01, 0.03, 0.01, 0.11, 0.23, 0.18, 0.41, 0.32, 0.09, 0.62, 0.31, 0.04), tolerance = 1e-07) expect_equal(x$futilityStop, c(0.96, 0.54, 0.13, 0.05, 0), tolerance = 1e-07) expect_equal(x$futilityPerStage[1, ], c(0.8, 0.4, 0.11, 0.05, 0), tolerance = 1e-07) expect_equal(x$futilityPerStage[2, ], c(0.16, 0.14, 0.02, 0, 0), tolerance = 1e-07) expect_equal(x$earlyStop[1, ], c(0.8, 0.4, 0.12, 0.16, 0.19), tolerance = 1e-07) expect_equal(x$earlyStop[2, ], c(0.16, 0.15, 0.18, 0.46, 0.61), tolerance = 1e-07) expect_equal(x$successPerStage[1, ], c(0, 0, 0.01, 0.11, 0.19), tolerance = 1e-07) expect_equal(x$successPerStage[2, ], c(0, 0.01, 0.16, 0.46, 0.61), tolerance = 1e-07) expect_equal(x$successPerStage[3, ], c(0, 0.01, 0.15, 0.18, 0.14), tolerance = 1e-07) expect_equal(unlist(as.list(x$selectedArms)), c(1, 0.11, 0.01, 1, 0.24, 0.17, 1, 0.26, 0.2, 1, 0.24, 0.14, 1, 0.14, 0.08, 1, 0.13, 0.03, 1, 0.44, 0.34, 1, 0.7, 0.55, 1, 0.69, 0.31, 1, 0.69, 0.13, 1, 0.16, 0.04, 1, 0.52, 0.39, 1, 0.8, 0.65, 1, 0.75, 0.31, 1, 0.79, 0.19, 1, 0.2, 0.04, 1, 0.6, 0.45, 1, 0.88, 0.7, 1, 0.84, 0.38, 1, 0.81, 0.2), tolerance = 1e-07) expect_equal(x$numberOfActiveArms[1, ], c(3, 3, 3, 3, 3)) expect_equal(x$numberOfActiveArms[2, ], c(2, 2, 2, 2, 2)) expect_equal(x$numberOfActiveArms[3, ], c(2, 2, 2, 2, 2)) expect_equal(x$expectedNumberOfSubjects, c(94.4, 143, 174.8, 153.2, 140.6), tolerance = 1e-07) expect_equal(unlist(as.list(x$sampleSizes)), c(20, 11, 5, 20, 8, 7.5555556, 20, 5.9090909, 5.7142857, 20, 5.7142857, 7.3684211, 20, 3.4567901, 8, 20, 13, 15, 20, 14.666667, 15.111111, 20, 15.909091, 15.714286, 20, 16.428571, 16.315789, 20, 17.037037, 13, 20, 16, 20, 20, 17.333333, 17.333333, 20, 18.181818, 18.571429, 20, 17.857143, 16.315789, 20, 19.506173, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(x$conditionalPowerAchieved[2, ], c(0.011866207, 0.085418744, 0.23090361, 0.47460917, 0.65183497), tolerance = 1e-07) expect_equal(x$conditionalPowerAchieved[3, ], c(0.02497337, 0.151524, 0.4525101, 0.68922536, 0.80573911), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x), NA))) expect_output(print(x)$show()) invisible(capture.output(expect_error(summary(x), NA))) expect_output(summary(x)$show()) xCodeBased <- eval(parse(text = getObjectRCode(x, stringWrapParagraphWidth = NULL))) expect_equal(xCodeBased$iterations, x$iterations, tolerance = 1e-05) expect_equal(xCodeBased$rejectAtLeastOne, x$rejectAtLeastOne, tolerance = 1e-05) expect_equal(xCodeBased$rejectedArmsPerStage, x$rejectedArmsPerStage, tolerance = 1e-05) expect_equal(xCodeBased$futilityStop, x$futilityStop, tolerance = 1e-05) expect_equal(xCodeBased$futilityPerStage, x$futilityPerStage, tolerance = 1e-05) expect_equal(xCodeBased$earlyStop, x$earlyStop, tolerance = 1e-05) expect_equal(xCodeBased$successPerStage, x$successPerStage, tolerance = 1e-05) expect_equal(xCodeBased$selectedArms, x$selectedArms, tolerance = 1e-05) expect_equal(xCodeBased$numberOfActiveArms, x$numberOfActiveArms, tolerance = 1e-05) expect_equal(xCodeBased$expectedNumberOfSubjects, x$expectedNumberOfSubjects, tolerance = 1e-05) expect_equal(xCodeBased$sampleSizes, x$sampleSizes, tolerance = 1e-05) expect_equal(xCodeBased$conditionalPowerAchieved, x$conditionalPowerAchieved, tolerance = 1e-05) expect_type(names(x), "character") df <- as.data.frame(x) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getSimulationMultiArmRates': comparison of base and multi-arm", { .skipTestIfDisabled() .skipTestIfNotX64() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmRates} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmRatesGenerate} # @refFS[Formula]{fs:SimulationMultiArmRatesTestStatistics} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} allocationRatioPlanned <- 2 design <- getDesignInverseNormal(typeOfDesign = "WT", deltaWT = 0.15, futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.8, 1)) x <- getSimulationMultiArmRates(design, activeArms = 1, plannedSubjects = c(20, 40, 60), directionUpper = FALSE, piControl = 0.6, piMaxVector = seq(0.3, 0.6, 0.1), conditionalPower = 0.6, minNumberOfSubjectsPerStage = c(NA, 20, 20), maxNumberOfSubjectsPerStage = c(NA, 80, 80), piControlH1 = 0.4, piH1 = 0.3, maxNumberOfIterations = 100, allocationRatioPlanned = allocationRatioPlanned, seed = 1234) y <- getSimulationRates(design, plannedSubjects = round((1 + 1/allocationRatioPlanned) *c(20, 40, 60)), normalApproximation = TRUE, pi2 = 0.6, pi1 = seq(0.3, 0.6, 0.1), directionUpper = FALSE, conditionalPower = 0.6, pi2H1 = 0.4, pi1H1 = 0.3, minNumberOfSubjectsPerStage = round((1 + 1/allocationRatioPlanned)*c(NA, 20, 20)), maxNumberOfSubjectsPerStage = round((1 + 1/allocationRatioPlanned)*c(NA, 80, 80)), maxNumberOfIterations = 100, allocationRatioPlanned = allocationRatioPlanned, seed = 1234) comp1 <- y$overallReject - x$rejectAtLeastOne ## Comparison of the results of numeric object 'comp1' with expected results expect_equal(comp1, c(-0.03, -0.02, 0.09, 0.03), tolerance = 1e-07) comp2 <- y$rejectPerStage - x$rejectedArmsPerStage[, , 1] ## Comparison of the results of matrixarray object 'comp2' with expected results expect_equal(comp2[1, ], c(0, 0, 0, 0)) expect_equal(comp2[2, ], c(0.09, -0.01, 0.06, 0.02), tolerance = 1e-07) expect_equal(comp2[3, ], c(-0.12, -0.01, 0.03, 0.01), tolerance = 1e-07) comp3 <- y$futilityPerStage - x$futilityPerStage ## Comparison of the results of matrixarray object 'comp3' with expected results expect_equal(comp3[1, ], c(0.04, 0.04, -0.12, -0.03), tolerance = 1e-07) expect_equal(comp3[2, ], c(0.01, 0.02, -0.05, 0.03), tolerance = 1e-07) comp4 <- round(y$sampleSizes - (x$sampleSizes[, , 1] + x$sampleSizes[, , 2]), 1) ## Comparison of the results of matrixarray object 'comp4' with expected results expect_equal(comp4[1, ], c(0, 0, 0, 0)) expect_equal(comp4[2, ], c(1.1, 0.3, 0, 0), tolerance = 1e-07) expect_equal(comp4[3, ], c(-44.7, 9.7, 1.3, -3.2), tolerance = 1e-07) comp5 <- round(y$expectedNumberOfSubjects - x$expectedNumberOfSubjects, 1) ## Comparison of the results of numeric object 'comp5' with expected results expect_equal(comp5, c(-14.6, -6.6, 26.9, 0.4), tolerance = 1e-07) comp6 <- x$earlyStop - y$earlyStop ## Comparison of the results of matrixarray object 'comp6' with expected results expect_equal(comp6[1, ], c(-0.96, -0.39, -0.75, -0.06), tolerance = 1e-07) expect_equal(comp6[2, ], c(0.1, -0.16, -0.38, -0.43), tolerance = 1e-07) }) test_that("'getSimulationMultiArmRates': comparison of base and multi-arm, Fisher design", { .skipTestIfDisabled() .skipTestIfNotX64() # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} # @refFS[Sec.]{fs:sec:simulatingMultiArmDesigns} # @refFS[Sec.]{fs:sec:simulatingMultiArmDoseResponseRelationShips} # @refFS[Sec.]{fs:sec:simulatingMultiArmSelections} # @refFS[Tab.]{fs:tab:output:getSimulationMultiArmRates} # @refFS[Formula]{fs:SimulationMultiArmDoseResponse} # @refFS[Formula]{fs:SimulationMultiArmRatesGenerate} # @refFS[Formula]{fs:SimulationMultiArmRatesTestStatistics} # @refFS[Formula]{fs:SimulationMultiArmSelections} # @refFS[Formula]{fs:multiarmRejectionRule} allocationRatioPlanned <- 1 design <- getDesignFisher(alpha0Vec = c(0.3, 0.4), informationRates = c(0.5, 0.7, 1)) x <- getSimulationMultiArmRates(design, activeArms = 1, plannedSubjects = c(20, 40, 60), directionUpper = FALSE, piControl = 0.6, piMaxVector = seq(0.3, 0.6, 0.1), conditionalPower = 0.6, minNumberOfSubjectsPerStage = c(NA, 20, 20), maxNumberOfSubjectsPerStage = c(NA, 80, 80), maxNumberOfIterations = 100, allocationRatioPlanned = allocationRatioPlanned, seed = -1008239793) y <- getSimulationRates(design, plannedSubjects = round((1 + 1/allocationRatioPlanned) *c(20, 40, 60)), normalApproximation = TRUE, pi2 = 0.6, pi1 = seq(0.3, 0.6, 0.1), directionUpper = FALSE, conditionalPower = 0.6, minNumberOfSubjectsPerStage = round((1 + 1/allocationRatioPlanned)*c(NA, 20, 20)), maxNumberOfSubjectsPerStage = round((1 + 1/allocationRatioPlanned)*c(NA, 80, 80)), maxNumberOfIterations = 100, allocationRatioPlanned = allocationRatioPlanned, seed = -2039707705) comp1 <- y$overallReject - x$rejectAtLeastOne ## Comparison of the results of numeric object 'comp1' with expected results expect_equal(comp1, c(0.05, 0.1, 0.07, 0.02), tolerance = 1e-07) comp2 <- y$rejectPerStage - x$rejectedArmsPerStage[, , 1] ## Comparison of the results of matrixarray object 'comp2' with expected results expect_equal(comp2[1, ], c(0.05, 0.01, 0.02, 0.03), tolerance = 1e-07) expect_equal(comp2[2, ], c(-0.03, 0.04, -0.01, -0.01), tolerance = 1e-07) expect_equal(comp2[3, ], c(0.03, 0.05, 0.06, 0), tolerance = 1e-07) comp3 <- y$futilityPerStage - x$futilityPerStage ## Comparison of the results of matrixarray object 'comp3' with expected results expect_equal(comp3[1, ], c(-0.05, -0.09, 0, 0), tolerance = 1e-07) expect_equal(comp3[2, ], c(0, 0, -0.05, 0.01), tolerance = 1e-07) comp4 <- round(y$sampleSizes - (x$sampleSizes[, , 1] + x$sampleSizes[, , 2]), 1) ## Comparison of the results of matrixarray object 'comp4' with expected results expect_equal(comp4[1, ], c(0, 0, 0, 0)) expect_equal(comp4[2, ], c(7.4, 3.6, -6.3, 6.6), tolerance = 1e-07) expect_equal(comp4[3, ], c(0.5, 12.9, -5, 26), tolerance = 1e-07) comp5 <- round(y$expectedNumberOfSubjects - x$expectedNumberOfSubjects, 1) ## Comparison of the results of numeric object 'comp5' with expected results expect_equal(comp5, c(6.1, 19.9, -2, -3.9), tolerance = 1e-07) comp6 <- x$earlyStop - y$earlyStop ## Comparison of the results of matrixarray object 'comp6' with expected results expect_equal(comp6[1, ], c(-0.38, -0.17, -0.41, 0.14), tolerance = 1e-07) expect_equal(comp6[2, ], c(-0.29, -0.61, -0.52, -0.78), tolerance = 1e-07) }) rpact/tests/testthat/test-f_design_group_sequential.R0000644000175000017500000014555014154142422023054 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_design_group_sequential.R ## | Creation date: 08 December 2021, 09:08:50 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing the Group Sequential and Inverse Normal Design Functionality") test_that("'getDesignInverseNormal' with default parameters: parameters and results are as expected", { # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} # @refFS[Formula]{fs:criticalValuesOBrienFleming} x0 <- getDesignInverseNormal() ## Comparison of the results of TrialDesignInverseNormal object 'x0' with expected results expect_equal(x0$alphaSpent, c(0.00025917372, 0.0071600594, 0.02499999), tolerance = 1e-07) expect_equal(x0$criticalValues, c(3.4710914, 2.4544323, 2.0040356), tolerance = 1e-07) expect_equal(x0$stageLevels, c(0.00025917372, 0.0070553616, 0.022533125), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x0), NA))) expect_output(print(x0)$show()) invisible(capture.output(expect_error(summary(x0), NA))) expect_output(summary(x0)$show()) x0CodeBased <- eval(parse(text = getObjectRCode(x0, stringWrapParagraphWidth = NULL))) expect_equal(x0CodeBased$alphaSpent, x0$alphaSpent, tolerance = 1e-05) expect_equal(x0CodeBased$criticalValues, x0$criticalValues, tolerance = 1e-05) expect_equal(x0CodeBased$stageLevels, x0$stageLevels, tolerance = 1e-05) expect_type(names(x0), "character") df <- as.data.frame(x0) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x0) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getDesignInverseNormal' with type of design = 'asHSD', 'bsHSD', 'asKD', and 'bsKD'", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} # @refFS[Formula]{fs:alphaSpendingConcept} # @refFS[Formula]{fs:alphaSpendingHwangShiDeCani} x1 <- getDesignInverseNormal(kMax = 3, informationRates = c(0.2, 0.4, 1), alpha = 0.03, sided = 1, beta = 0.14, typeOfDesign = "asHSD", gammaA = 0) ## Comparison of the results of TrialDesignInverseNormal object 'x1' with expected results expect_equal(x1$alphaSpent, c(0.006, 0.012, 0.02999999), tolerance = 1e-07) expect_equal(x1$criticalValues, c(2.5121443, 2.4228747, 2.0280392), tolerance = 1e-07) expect_equal(x1$stageLevels, c(0.006, 0.0076991189, 0.021278125), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$alphaSpent, x1$alphaSpent, tolerance = 1e-05) expect_equal(x1CodeBased$criticalValues, x1$criticalValues, tolerance = 1e-05) expect_equal(x1CodeBased$stageLevels, x1$stageLevels, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getDesignCharacteristics} # @refFS[Formula]{fs:inflationFactor} # @refFS[Formula]{fs:expectedReduction} y1 <- getDesignCharacteristics(x1) ## Comparison of the results of TrialDesignCharacteristics object 'y1' with expected results expect_equal(y1$nFixed, 8.7681899, tolerance = 1e-07) expect_equal(y1$shift, 9.4594102, tolerance = 1e-07) expect_equal(y1$inflationFactor, 1.0788327, tolerance = 1e-07) expect_equal(y1$information, c(1.891882, 3.7837641, 9.4594102), tolerance = 1e-07) expect_equal(y1$power, c(0.12783451, 0.34055165, 0.86), tolerance = 1e-07) expect_equal(y1$rejectionProbabilities, c(0.12783451, 0.21271713, 0.51944835), tolerance = 1e-07) expect_equal(y1$futilityProbabilities, c(9.8658765e-10, 9.7584074e-10), tolerance = 1e-07) expect_equal(y1$averageSampleNumber1, 0.83081135, tolerance = 1e-07) expect_equal(y1$averageSampleNumber01, 1.0142116, tolerance = 1e-07) expect_equal(y1$averageSampleNumber0, 1.0697705, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(y1), NA))) expect_output(print(y1)$show()) invisible(capture.output(expect_error(summary(y1), NA))) expect_output(summary(y1)$show()) y1CodeBased <- eval(parse(text = getObjectRCode(y1, stringWrapParagraphWidth = NULL))) expect_equal(y1CodeBased$nFixed, y1$nFixed, tolerance = 1e-05) expect_equal(y1CodeBased$shift, y1$shift, tolerance = 1e-05) expect_equal(y1CodeBased$inflationFactor, y1$inflationFactor, tolerance = 1e-05) expect_equal(y1CodeBased$information, y1$information, tolerance = 1e-05) expect_equal(y1CodeBased$power, y1$power, tolerance = 1e-05) expect_equal(y1CodeBased$rejectionProbabilities, y1$rejectionProbabilities, tolerance = 1e-05) expect_equal(y1CodeBased$futilityProbabilities, y1$futilityProbabilities, tolerance = 1e-05) expect_equal(y1CodeBased$averageSampleNumber1, y1$averageSampleNumber1, tolerance = 1e-05) expect_equal(y1CodeBased$averageSampleNumber01, y1$averageSampleNumber01, tolerance = 1e-05) expect_equal(y1CodeBased$averageSampleNumber0, y1$averageSampleNumber0, tolerance = 1e-05) expect_type(names(y1), "character") df <- as.data.frame(y1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(y1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} # @refFS[Formula]{fs:alphaSpendingConcept} # @refFS[Formula]{fs:alphaSpendingHwangShiDeCani} # @refFS[Formula]{fs:betaSpendingApproach} # @refFS[Formula]{fs:betaSpendingHwangShiDeCani} x2 <- getDesignInverseNormal(kMax = 3, informationRates = c(0.2, 0.4, 1), alpha = 0.07, sided = 1, beta = 0.14, typeOfDesign = "asHSD", gammaA = -1, typeBetaSpending = "bsHSD", gammaB = -2) ## Comparison of the results of TrialDesignInverseNormal object 'x2' with expected results expect_equal(x2$power, c(0.12038954, 0.32895265, 0.86), tolerance = 1e-07) expect_equal(x2$futilityBounds, c(-1.1063623, -0.35992438), tolerance = 1e-07) expect_equal(x2$alphaSpent, c(0.0090195874, 0.020036136, 0.06999999), tolerance = 1e-07) expect_equal(x2$betaSpent, c(0.010777094, 0.026854629, 0.14), tolerance = 1e-07) expect_equal(x2$criticalValues, c(2.364813, 2.1928805, 1.5660474), tolerance = 1e-07) expect_equal(x2$stageLevels, c(0.0090195874, 0.014157994, 0.058668761), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$power, x2$power, tolerance = 1e-05) expect_equal(x2CodeBased$futilityBounds, x2$futilityBounds, tolerance = 1e-05) expect_equal(x2CodeBased$alphaSpent, x2$alphaSpent, tolerance = 1e-05) expect_equal(x2CodeBased$betaSpent, x2$betaSpent, tolerance = 1e-05) expect_equal(x2CodeBased$criticalValues, x2$criticalValues, tolerance = 1e-05) expect_equal(x2CodeBased$stageLevels, x2$stageLevels, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getDesignCharacteristics} # @refFS[Formula]{fs:inflationFactor} # @refFS[Formula]{fs:expectedReduction} y2 <- getDesignCharacteristics(x2) ## Comparison of the results of TrialDesignCharacteristics object 'y2' with expected results expect_equal(y2$nFixed, 6.5337002, tolerance = 1e-07) expect_equal(y2$shift, 7.1015943, tolerance = 1e-07) expect_equal(y2$inflationFactor, 1.0869177, tolerance = 1e-07) expect_equal(y2$information, c(1.4203189, 2.8406377, 7.1015943), tolerance = 1e-07) expect_equal(y2$power, c(0.12038953, 0.32895265, 0.86), tolerance = 1e-07) expect_equal(y2$rejectionProbabilities, c(0.12038953, 0.20856311, 0.53104735), tolerance = 1e-07) expect_equal(y2$futilityProbabilities, c(0.010777094, 0.016077535), tolerance = 1e-07) expect_equal(y2$averageSampleNumber1, 0.82636428, tolerance = 1e-07) expect_equal(y2$averageSampleNumber01, 0.91614201, tolerance = 1e-07) expect_equal(y2$averageSampleNumber0, 0.79471657, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(y2), NA))) expect_output(print(y2)$show()) invisible(capture.output(expect_error(summary(y2), NA))) expect_output(summary(y2)$show()) y2CodeBased <- eval(parse(text = getObjectRCode(y2, stringWrapParagraphWidth = NULL))) expect_equal(y2CodeBased$nFixed, y2$nFixed, tolerance = 1e-05) expect_equal(y2CodeBased$shift, y2$shift, tolerance = 1e-05) expect_equal(y2CodeBased$inflationFactor, y2$inflationFactor, tolerance = 1e-05) expect_equal(y2CodeBased$information, y2$information, tolerance = 1e-05) expect_equal(y2CodeBased$power, y2$power, tolerance = 1e-05) expect_equal(y2CodeBased$rejectionProbabilities, y2$rejectionProbabilities, tolerance = 1e-05) expect_equal(y2CodeBased$futilityProbabilities, y2$futilityProbabilities, tolerance = 1e-05) expect_equal(y2CodeBased$averageSampleNumber1, y2$averageSampleNumber1, tolerance = 1e-05) expect_equal(y2CodeBased$averageSampleNumber01, y2$averageSampleNumber01, tolerance = 1e-05) expect_equal(y2CodeBased$averageSampleNumber0, y2$averageSampleNumber0, tolerance = 1e-05) expect_type(names(y2), "character") df <- as.data.frame(y2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(y2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} # @refFS[Formula]{fs:alphaSpendingConcept} # @refFS[Formula]{fs:alphaSpendingKimDeMets} # @refFS[Formula]{fs:betaSpendingApproach} # @refFS[Formula]{fs:betaSpendingKimDeMets} x3 <- getDesignInverseNormal(kMax = 3, informationRates = c(0.3, 0.7, 1), alpha = 0.03, sided = 1, beta = 0.34, typeOfDesign = "asKD", gammaA = 2.2, typeBetaSpending = "bsKD", gammaB = 3.2) ## Comparison of the results of TrialDesignInverseNormal object 'x3' with expected results expect_equal(x3$power, c(0.058336437, 0.39824601, 0.66), tolerance = 1e-07) expect_equal(x3$futilityBounds, c(-1.1558435, 0.72836893), tolerance = 1e-07) expect_equal(x3$alphaSpent, c(0.0021222083, 0.013687904, 0.02999999), tolerance = 1e-07) expect_equal(x3$betaSpent, c(0.0072155083, 0.1085907, 0.34), tolerance = 1e-07) expect_equal(x3$criticalValues, c(2.8594012, 2.2435708, 1.9735737), tolerance = 1e-07) expect_equal(x3$stageLevels, c(0.0021222083, 0.012430015, 0.02421512), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$power, x3$power, tolerance = 1e-05) expect_equal(x3CodeBased$futilityBounds, x3$futilityBounds, tolerance = 1e-05) expect_equal(x3CodeBased$alphaSpent, x3$alphaSpent, tolerance = 1e-05) expect_equal(x3CodeBased$betaSpent, x3$betaSpent, tolerance = 1e-05) expect_equal(x3CodeBased$criticalValues, x3$criticalValues, tolerance = 1e-05) expect_equal(x3CodeBased$stageLevels, x3$stageLevels, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getDesignCharacteristics} # @refFS[Formula]{fs:inflationFactor} # @refFS[Formula]{fs:expectedReduction} y3 <- getDesignCharacteristics(x3) ## Comparison of the results of TrialDesignCharacteristics object 'y3' with expected results expect_equal(y3$nFixed, 5.2590265, tolerance = 1e-07) expect_equal(y3$shift, 5.5513711, tolerance = 1e-07) expect_equal(y3$inflationFactor, 1.0555891, tolerance = 1e-07) expect_equal(y3$information, c(1.6654113, 3.8859597, 5.5513711), tolerance = 1e-07) expect_equal(y3$power, c(0.058336437, 0.39824601, 0.66), tolerance = 1e-07) expect_equal(y3$rejectionProbabilities, c(0.058336437, 0.33990957, 0.26175399), tolerance = 1e-07) expect_equal(y3$futilityProbabilities, c(0.0072155083, 0.10137519), tolerance = 1e-07) expect_equal(y3$averageSampleNumber1, 0.86740735, tolerance = 1e-07) expect_equal(y3$averageSampleNumber01, 0.87361708, tolerance = 1e-07) expect_equal(y3$averageSampleNumber0, 0.75480974, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(y3), NA))) expect_output(print(y3)$show()) invisible(capture.output(expect_error(summary(y3), NA))) expect_output(summary(y3)$show()) y3CodeBased <- eval(parse(text = getObjectRCode(y3, stringWrapParagraphWidth = NULL))) expect_equal(y3CodeBased$nFixed, y3$nFixed, tolerance = 1e-05) expect_equal(y3CodeBased$shift, y3$shift, tolerance = 1e-05) expect_equal(y3CodeBased$inflationFactor, y3$inflationFactor, tolerance = 1e-05) expect_equal(y3CodeBased$information, y3$information, tolerance = 1e-05) expect_equal(y3CodeBased$power, y3$power, tolerance = 1e-05) expect_equal(y3CodeBased$rejectionProbabilities, y3$rejectionProbabilities, tolerance = 1e-05) expect_equal(y3CodeBased$futilityProbabilities, y3$futilityProbabilities, tolerance = 1e-05) expect_equal(y3CodeBased$averageSampleNumber1, y3$averageSampleNumber1, tolerance = 1e-05) expect_equal(y3CodeBased$averageSampleNumber01, y3$averageSampleNumber01, tolerance = 1e-05) expect_equal(y3CodeBased$averageSampleNumber0, y3$averageSampleNumber0, tolerance = 1e-05) expect_type(names(y3), "character") df <- as.data.frame(y3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(y3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getDesignInverseNormal' with binding futility bounds", { # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} # @refFS[Formula]{fs:criticalValuesWithFutility} # @refFS[Formula]{fs:criticalValuesWangTiatis} x4 <- getDesignInverseNormal(kMax = 4, alpha = 0.035, futilityBounds = rep(0.5244, 3), bindingFutility = TRUE, typeOfDesign = "WT", deltaWT = 0.4) ## Comparison of the results of TrialDesignInverseNormal object 'x4' with expected results expect_equal(x4$alphaSpent, c(0.0099446089, 0.020756912, 0.029001537, 0.03499999), tolerance = 1e-07) expect_equal(x4$criticalValues, c(2.3284312, 2.1725031, 2.0861776, 2.0270171), tolerance = 1e-07) expect_equal(x4$stageLevels, c(0.0099446089, 0.014908866, 0.018481267, 0.021330332), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$alphaSpent, x4$alphaSpent, tolerance = 1e-05) expect_equal(x4CodeBased$criticalValues, x4$criticalValues, tolerance = 1e-05) expect_equal(x4CodeBased$stageLevels, x4$stageLevels, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getDesignGroupSequential' with type of design = 'asUser'", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} # @refFS[Formula]{fs:alphaSpendingConcept} x5 <- getDesignGroupSequential(typeOfDesign = "asUser", userAlphaSpending = c(0.01, 0.02, 0.03, 0.05)) ## Comparison of the results of TrialDesignGroupSequential object 'x5' with expected results expect_equal(x5$alphaSpent, c(0.01, 0.02, 0.03, 0.04999999), tolerance = 1e-07) expect_equal(x5$criticalValues, c(2.3263479, 2.2192994, 2.1201347, 1.8189562), tolerance = 1e-07) expect_equal(x5$stageLevels, c(0.01, 0.01323318, 0.016997342, 0.034459058), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x5), NA))) expect_output(print(x5)$show()) invisible(capture.output(expect_error(summary(x5), NA))) expect_output(summary(x5)$show()) x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) expect_equal(x5CodeBased$alphaSpent, x5$alphaSpent, tolerance = 1e-05) expect_equal(x5CodeBased$criticalValues, x5$criticalValues, tolerance = 1e-05) expect_equal(x5CodeBased$stageLevels, x5$stageLevels, tolerance = 1e-05) expect_type(names(x5), "character") df <- as.data.frame(x5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsUser'", { # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} # @refFS[Formula]{fs:alphaSpendingConcept} # @refFS[Formula]{fs:alphaSpendingOBrienFleming} # @refFS[Formula]{fs:betaSpendingApproach} x6 <- getDesignGroupSequential(kMax = 3, alpha = 0.03, typeOfDesign = "asOF", typeBetaSpending = "bsUser", bindingFutility = FALSE, userBetaSpending = c(0.01, 0.05, 0.3)) ## Comparison of the results of TrialDesignGroupSequential object 'x6' with expected results expect_equal(x6$power, c(0.014685829, 0.33275272, 0.7), tolerance = 1e-07) expect_equal(x6$futilityBounds, c(-0.92327973, 0.29975473), tolerance = 1e-07) expect_equal(x6$alphaSpent, c(0.00017079385, 0.0078650906, 0.03), tolerance = 1e-07) expect_equal(x6$betaSpent, c(0.01, 0.05, 0.3), tolerance = 1e-07) expect_equal(x6$criticalValues, c(3.5815302, 2.417863, 1.9175839), tolerance = 1e-07) expect_equal(x6$stageLevels, c(0.00017079385, 0.0078059773, 0.027581894), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x6), NA))) expect_output(print(x6)$show()) invisible(capture.output(expect_error(summary(x6), NA))) expect_output(summary(x6)$show()) x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) expect_equal(x6CodeBased$power, x6$power, tolerance = 1e-05) expect_equal(x6CodeBased$futilityBounds, x6$futilityBounds, tolerance = 1e-05) expect_equal(x6CodeBased$alphaSpent, x6$alphaSpent, tolerance = 1e-05) expect_equal(x6CodeBased$betaSpent, x6$betaSpent, tolerance = 1e-05) expect_equal(x6CodeBased$criticalValues, x6$criticalValues, tolerance = 1e-05) expect_equal(x6CodeBased$stageLevels, x6$stageLevels, tolerance = 1e-05) expect_type(names(x6), "character") df <- as.data.frame(x6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and binding futility bounds", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} # @refFS[Formula]{fs:alphaSpendingConcept} # @refFS[Formula]{fs:alphaSpendingOBrienFleming} # @refFS[Formula]{fs:betaSpendingApproach} # @refFS[Formula]{fs:betaSpendingKimDeMets} x7 <- getDesignGroupSequential(kMax = 3, alpha = 0.03, typeOfDesign = "asOF", typeBetaSpending = "bsKD", informationRates = c(0.4, 0.75, 1), gammaB = 2.5, bindingFutility = TRUE) ## Comparison of the results of TrialDesignGroupSequential object 'x7' with expected results expect_equal(x7$power, c(0.068966747, 0.55923121, 0.8), tolerance = 1e-07) expect_equal(x7$futilityBounds, c(-0.29391761, 1.0736333), tolerance = 1e-07) expect_equal(x7$alphaSpent, c(0.00060088601, 0.012217314, 0.03), tolerance = 1e-07) expect_equal(x7$betaSpent, c(0.020238577, 0.097427858, 0.2), tolerance = 1e-07) expect_equal(x7$criticalValues, c(3.2384592, 2.2562378, 1.905812), tolerance = 1e-07) expect_equal(x7$stageLevels, c(0.00060088601, 0.012027871, 0.0283373), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x7), NA))) expect_output(print(x7)$show()) invisible(capture.output(expect_error(summary(x7), NA))) expect_output(summary(x7)$show()) x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) expect_equal(x7CodeBased$power, x7$power, tolerance = 1e-05) expect_equal(x7CodeBased$futilityBounds, x7$futilityBounds, tolerance = 1e-05) expect_equal(x7CodeBased$alphaSpent, x7$alphaSpent, tolerance = 1e-05) expect_equal(x7CodeBased$betaSpent, x7$betaSpent, tolerance = 1e-05) expect_equal(x7CodeBased$criticalValues, x7$criticalValues, tolerance = 1e-05) expect_equal(x7CodeBased$stageLevels, x7$stageLevels, tolerance = 1e-05) expect_type(names(x7), "character") df <- as.data.frame(x7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getDesignGroupSequential' with binding futility bounds ", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} # @refFS[Formula]{fs:criticalValuesWithFutility} # @refFS[Formula]{fs:criticalValuesWangTiatis} x8 <- getDesignGroupSequential(kMax = 4, alpha = 0.025, futilityBounds = rep(0.5244, 3), bindingFutility = TRUE, typeOfDesign = "WT", deltaWT = 0.4) ## Comparison of the results of TrialDesignGroupSequential object 'x8' with expected results expect_equal(x8$alphaSpent, c(0.0062828133, 0.013876673, 0.02015684, 0.02499999), tolerance = 1e-07) expect_equal(x8$criticalValues, c(2.4958485, 2.328709, 2.2361766, 2.1727623), tolerance = 1e-07) expect_equal(x8$stageLevels, c(0.0062828133, 0.0099372444, 0.012670104, 0.014899106), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x8), NA))) expect_output(print(x8)$show()) invisible(capture.output(expect_error(summary(x8), NA))) expect_output(summary(x8)$show()) x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) expect_equal(x8CodeBased$alphaSpent, x8$alphaSpent, tolerance = 1e-05) expect_equal(x8CodeBased$criticalValues, x8$criticalValues, tolerance = 1e-05) expect_equal(x8CodeBased$stageLevels, x8$stageLevels, tolerance = 1e-05) expect_type(names(x8), "character") df <- as.data.frame(x8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getDesignGroupSequential' with Haybittle Peto boundaries ", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} # @refFS[Formula]{fs:criticalValuesHaybittlePeto} x9 <- getDesignGroupSequential(kMax = 4, alpha = 0.025, typeOfDesign = "HP") ## Comparison of the results of TrialDesignGroupSequential object 'x9' with expected results expect_equal(x9$alphaSpent, c(0.001349898, 0.0024617416, 0.0033695882, 0.025), tolerance = 1e-07) expect_equal(x9$criticalValues, c(3, 3, 3, 1.9827514), tolerance = 1e-07) expect_equal(x9$stageLevels, c(0.001349898, 0.001349898, 0.001349898, 0.023697604), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x9), NA))) expect_output(print(x9)$show()) invisible(capture.output(expect_error(summary(x9), NA))) expect_output(summary(x9)$show()) x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) expect_equal(x9CodeBased$alphaSpent, x9$alphaSpent, tolerance = 1e-05) expect_equal(x9CodeBased$criticalValues, x9$criticalValues, tolerance = 1e-05) expect_equal(x9CodeBased$stageLevels, x9$stageLevels, tolerance = 1e-05) expect_type(names(x9), "character") df <- as.data.frame(x9) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x9) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getDesignGroupSequential' with Pampallona Tsiatis boundaries ", { .skipTestIfDisabled() # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} x10 <- getDesignGroupSequential(kMax = 3, alpha = 0.035, beta = 0.1, informationRates = c(0.3, 0.8, 1), typeOfDesign = "PT", sided = 1, bindingFutility = TRUE, deltaPT1 = 0.2, deltaPT0 = 0.3) ## Comparison of the results of TrialDesignGroupSequential object 'x10' with expected results expect_equal(x10$power, c(0.19834666, 0.83001122, 0.9), tolerance = 1e-07) expect_equal(x10$futilityBounds, c(-0.042079551, 1.4407359), tolerance = 1e-07) expect_equal(x10$alphaSpent, c(0.0038332428, 0.024917169, 0.035), tolerance = 1e-07) expect_equal(x10$betaSpent, c(0.031375367, 0.080734149, 0.099999999), tolerance = 1e-07) expect_equal(x10$criticalValues, c(2.6664156, 1.9867225, 1.8580792), tolerance = 1e-07) expect_equal(x10$stageLevels, c(0.0038332428, 0.023476576, 0.031578886), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x10), NA))) expect_output(print(x10)$show()) invisible(capture.output(expect_error(summary(x10), NA))) expect_output(summary(x10)$show()) x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) expect_equal(x10CodeBased$power, x10$power, tolerance = 1e-05) expect_equal(x10CodeBased$futilityBounds, x10$futilityBounds, tolerance = 1e-05) expect_equal(x10CodeBased$alphaSpent, x10$alphaSpent, tolerance = 1e-05) expect_equal(x10CodeBased$betaSpent, x10$betaSpent, tolerance = 1e-05) expect_equal(x10CodeBased$criticalValues, x10$criticalValues, tolerance = 1e-05) expect_equal(x10CodeBased$stageLevels, x10$stageLevels, tolerance = 1e-05) expect_type(names(x10), "character") df <- as.data.frame(x10) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x10) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} x11 <- getDesignGroupSequential(kMax = 3, alpha = 0.035, beta = 0.05, informationRates = c(0.3, 0.8, 1), typeOfDesign = "PT", sided = 2, bindingFutility = TRUE, deltaPT1 = 0.2, deltaPT0 = 0.3) ## Comparison of the results of TrialDesignGroupSequential object 'x11' with expected results expect_equal(x11$power, c(0.16615376, 0.88013007, 0.94999991), tolerance = 1e-07) expect_equal(x11$futilityBounds, c(NA_real_, 1.671433), tolerance = 1e-07) expect_equal(x11$alphaSpent, c(0.0019236202, 0.022017713, 0.035), tolerance = 1e-07) expect_equal(x11$betaSpent, c(0, 0.035025978, 0.05), tolerance = 1e-07) expect_equal(x11$criticalValues, c(3.1017782, 2.3111074, 2.1614596), tolerance = 1e-07) expect_equal(x11$stageLevels, c(0.00096181012, 0.010413463, 0.015329928), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x11), NA))) expect_output(print(x11)$show()) invisible(capture.output(expect_error(summary(x11), NA))) expect_output(summary(x11)$show()) x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) expect_equal(x11CodeBased$power, x11$power, tolerance = 1e-05) expect_equal(x11CodeBased$futilityBounds, x11$futilityBounds, tolerance = 1e-05) expect_equal(x11CodeBased$alphaSpent, x11$alphaSpent, tolerance = 1e-05) expect_equal(x11CodeBased$betaSpent, x11$betaSpent, tolerance = 1e-05) expect_equal(x11CodeBased$criticalValues, x11$criticalValues, tolerance = 1e-05) expect_equal(x11CodeBased$stageLevels, x11$stageLevels, tolerance = 1e-05) expect_type(names(x11), "character") df <- as.data.frame(x11) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x11) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} x12 <- getDesignGroupSequential(kMax = 3, alpha = 0.035, beta = 0.05, informationRates = c(0.3, 0.8, 1), typeOfDesign = "PT", sided = 2, bindingFutility = FALSE, deltaPT1 = 0.2, deltaPT0 = 0.3) ## Comparison of the results of TrialDesignGroupSequential object 'x12' with expected results expect_equal(x12$power, c(0.15712278, 0.87874666, 0.94999995), tolerance = 1e-07) expect_equal(x12$futilityBounds, c(NA_real_, 1.7090472), tolerance = 1e-07) expect_equal(x12$alphaSpent, c(0.0015647742, 0.019435851, 0.035), tolerance = 1e-07) expect_equal(x12$betaSpent, c(0, 0.034947415, 0.05), tolerance = 1e-07) expect_equal(x12$criticalValues, c(3.1623945, 2.356272, 2.2036998), tolerance = 1e-07) expect_equal(x12$stageLevels, c(0.00078238708, 0.009229697, 0.013772733), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x12), NA))) expect_output(print(x12)$show()) invisible(capture.output(expect_error(summary(x12), NA))) expect_output(summary(x12)$show()) x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) expect_equal(x12CodeBased$power, x12$power, tolerance = 1e-05) expect_equal(x12CodeBased$futilityBounds, x12$futilityBounds, tolerance = 1e-05) expect_equal(x12CodeBased$alphaSpent, x12$alphaSpent, tolerance = 1e-05) expect_equal(x12CodeBased$betaSpent, x12$betaSpent, tolerance = 1e-05) expect_equal(x12CodeBased$criticalValues, x12$criticalValues, tolerance = 1e-05) expect_equal(x12CodeBased$stageLevels, x12$stageLevels, tolerance = 1e-05) expect_type(names(x12), "character") df <- as.data.frame(x12) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x12) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getDesignInverseNormal': illegal arguments throw exceptions as expected", { expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.025), kMax = 4), paste0("Conflicting arguments: length of 'userAlphaSpending' (5) ", "must be equal to 'kMax' (4)"), fixed = TRUE) expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.021)), paste0("'userAlphaSpending' = c(0.01, 0.02, 0.023, 0.023, 0.021) must be a vector that ", "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_5 <= alpha = 0.021"), fixed = TRUE) expect_error(getDesignInverseNormal(typeOfDesign = "asUser", userAlphaSpending = c(0.01, 0.02, 0.023), alpha = 0.02), paste0("'userAlphaSpending' = c(0.01, 0.02, 0.023) must be a vector that ", "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_3 <= alpha = 0.02"), fixed = TRUE) expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_WT, deltaWT = NA_real_), "Missing argument: parameter 'deltaWT' must be specified in design", fixed = TRUE) expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_WT_OPTIMUM, optimizationCriterion = "x"), "Illegal argument: optimization criterion must be one of the following: 'ASNH1', 'ASNIFH1', 'ASNsum'", fixed = TRUE) expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_KD, gammaA = NA_real_), "Missing argument: parameter 'gammaA' must be specified in design", fixed = TRUE) expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_HSD, gammaA = NA_real_), "Missing argument: parameter 'gammaA' must be specified in design", fixed = TRUE) expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER), "Missing argument: parameter 'userAlphaSpending' must be specified in design", fixed = TRUE) expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = "x"), "Illegal argument: type of beta spending must be one of the following: 'none', 'bsP', 'bsOF', 'bsKD', 'bsHSD', 'bsUser'", fixed = TRUE) expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER), "Missing argument: parameter 'userBetaSpending' must be specified in design", fixed = TRUE) expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, userBetaSpending = c(0.1, 0.2)), paste0("Conflicting arguments: length of 'userBetaSpending' (2) must ", "be equal to length of 'informationRates' (3)"), fixed = TRUE) expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, userBetaSpending = c(0.2, 0.1, 0.05)), paste0("'userBetaSpending' = c(0.2, 0.1, 0.05) must be a vector that satisfies the ", "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.05"), fixed = TRUE) expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, userBetaSpending = c(0.1, 0.2, 0.3), beta = 0.2), paste0("'userBetaSpending' = c(0.1, 0.2, 0.3) must be a vector that satisfies the ", "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.2"), fixed = TRUE) expect_error(getDesignInverseNormal(kMax = Inf), paste0("Argument out of bounds: 'kMax' (Inf) is out of bounds [1; ", C_KMAX_UPPER_BOUND, "]"), fixed = TRUE) expect_error(getDesignInverseNormal(kMax = -Inf), paste0("Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; ", C_KMAX_UPPER_BOUND, "]"), fixed = TRUE) expect_error(getDesignInverseNormal(kMax = -Inf), "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = -10), "Argument out of bounds: 'kMax' (-10) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = -9), "Argument out of bounds: 'kMax' (-9) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = -8), "Argument out of bounds: 'kMax' (-8) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = -7), "Argument out of bounds: 'kMax' (-7) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = -6), "Argument out of bounds: 'kMax' (-6) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = -5), "Argument out of bounds: 'kMax' (-5) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = -4), "Argument out of bounds: 'kMax' (-4) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = -3), "Argument out of bounds: 'kMax' (-3) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = -2), "Argument out of bounds: 'kMax' (-2) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = -1), "Argument out of bounds: 'kMax' (-1) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 0), "Argument out of bounds: 'kMax' (0) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 21), "Argument out of bounds: 'kMax' (21) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 22), "Argument out of bounds: 'kMax' (22) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 23), "Argument out of bounds: 'kMax' (23) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 24), "Argument out of bounds: 'kMax' (24) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 25), "Argument out of bounds: 'kMax' (25) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 26), "Argument out of bounds: 'kMax' (26) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 27), "Argument out of bounds: 'kMax' (27) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 28), "Argument out of bounds: 'kMax' (28) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 29), "Argument out of bounds: 'kMax' (29) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 30), "Argument out of bounds: 'kMax' (30) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = Inf), "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 2, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (2) - 1", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 3, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (3) - 1", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 4, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (4) - 1", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 6, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (6) - 1", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 7, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (7) - 1", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 8, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (8) - 1", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 9, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (9) - 1", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 10, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (10) - 1", fixed = TRUE) expect_warning(expect_error(getDesignInverseNormal(kMax = 11, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (11) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 12, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (12) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 13, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (13) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 14, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (14) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 15, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (15) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 16, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (16) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 17, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (17) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 18, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (18) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 19, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (19) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 20, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (20) - 1", fixed = TRUE)) expect_error(getDesignInverseNormal(futilityBounds = c(-7, 5)), "Illegal argument: 'futilityBounds' (-7, 5) too extreme for this situation", fixed = TRUE) expect_error(getDesignInverseNormal(futilityBounds = c(1, 7)), "Argument out of bounds: 'futilityBounds' (1, 7) is out of bounds [-Inf; 6]", fixed = TRUE) }) test_that("'getDesignGroupSequential': illegal arguments throw exceptions as expected", { expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.025), kMax = 4), paste0("Conflicting arguments: length of 'userAlphaSpending' (5) ", "must be equal to 'kMax' (4)"), fixed = TRUE) expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.021)), paste0("'userAlphaSpending' = c(0.01, 0.02, 0.023, 0.023, 0.021) must be a vector that ", "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_5 <= alpha = 0.021"), fixed = TRUE) expect_error(getDesignGroupSequential(typeOfDesign = "asUser", userAlphaSpending = c(0.01, 0.02, 0.023), alpha = 0.02), paste0("'userAlphaSpending' = c(0.01, 0.02, 0.023) must be a vector that ", "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_3 <= alpha = 0.02"), fixed = TRUE) expect_equal(getDesignGroupSequential(typeOfDesign = "asUser", userAlphaSpending = c(0.01, 0.02, 0.023))$alpha, 0.023) expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_WT, deltaWT = NA_real_), "Missing argument: parameter 'deltaWT' must be specified in design", fixed = TRUE) expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_WT_OPTIMUM, optimizationCriterion = "x"), "Illegal argument: optimization criterion must be one of the following: 'ASNH1', 'ASNIFH1', 'ASNsum'", fixed = TRUE) expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_KD, gammaA = NA_real_), "Missing argument: parameter 'gammaA' must be specified in design", fixed = TRUE) expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_HSD, gammaA = NA_real_), "Missing argument: parameter 'gammaA' must be specified in design", fixed = TRUE) expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER), "Missing argument: parameter 'userAlphaSpending' must be specified in design", fixed = TRUE) expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = "x"), paste0("Illegal argument: type of beta spending must be one of the following: ", "'none', 'bsP', 'bsOF', 'bsKD', 'bsHSD', 'bsUser'"), fixed = TRUE) expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER), "Missing argument: parameter 'userBetaSpending' must be specified in design", fixed = TRUE) expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, userBetaSpending = c(0.1, 0.2)), paste0("Conflicting arguments: length of 'userBetaSpending' (2) must ", "be equal to length of 'informationRates' (3)"), fixed = TRUE) expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, userBetaSpending = c(0.2, 0.1, 0.05)), paste0("'userBetaSpending' = c(0.2, 0.1, 0.05) must be a vector that satisfies the ", "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.05"), fixed = TRUE) expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, userBetaSpending = c(0.1, 0.2, 0.3), beta = 0.2), paste0("'userBetaSpending' = c(0.1, 0.2, 0.3) must be a vector that satisfies the ", "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.2"), fixed = TRUE) expect_error(getDesignGroupSequential(kMax = Inf), paste0("Argument out of bounds: 'kMax' (Inf) is out of bounds [1; ", C_KMAX_UPPER_BOUND, "]"), fixed = TRUE) expect_error(getDesignGroupSequential(kMax = -Inf), paste0("Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; ", C_KMAX_UPPER_BOUND, "]"), fixed = TRUE) expect_error(getDesignInverseNormal(kMax = -5), "Argument out of bounds: 'kMax' (-5) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 0), "Argument out of bounds: 'kMax' (0) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 21), "Argument out of bounds: 'kMax' (21) is out of bounds [1; 20]", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 2, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (2) - 1", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 3, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (3) - 1", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 4, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (4) - 1", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 6, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (6) - 1", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 7, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (7) - 1", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 8, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (8) - 1", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 9, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (9) - 1", fixed = TRUE) expect_error(getDesignInverseNormal(kMax = 10, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (10) - 1", fixed = TRUE) expect_warning(expect_error(getDesignInverseNormal(kMax = 11, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (11) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 12, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (12) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 13, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (13) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 14, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (14) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 15, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (15) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 16, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (16) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 17, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (17) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 18, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (18) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 19, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (19) - 1", fixed = TRUE)) expect_warning(expect_error(getDesignInverseNormal(kMax = 20, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (20) - 1", fixed = TRUE)) expect_error(getDesignGroupSequential(futilityBounds = c(-7, 5)), "Illegal argument: 'futilityBounds' (-7, 5) too extreme for this situation", fixed = TRUE) expect_error(getDesignGroupSequential(futilityBounds = c(1, 7)), "Argument out of bounds: 'futilityBounds' (1, 7) is out of bounds [-Inf; 6]", fixed = TRUE) }) rpact/tests/testthat/test-f_analysis_enrichment_means.R0000644000175000017500000021320214154142422023345 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_analysis_enrichment_means.R ## | Creation date: 08 December 2021, 09:03:08 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Analysis Enrichment Means Function (one sub-population)") test_that("'getAnalysisResults': select S1 at first IA, gMax = 2, inverse normal design", { # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichment} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedtTestEnrichment} S1 <- getDataset( sampleSize1 = c(12,21), sampleSize2 = c(18,21), mean1 = c(107.7, 84.9), mean2 = c(165.6, 195.9), stDev1 = c(128.5, 139.5), stDev2 = c(120.1, 185.0)) F <- getDataset( sampleSize1 = c(26, NA), sampleSize2 = c(29, NA), mean1 = c(86.48462, NA), mean2 = c(148.34138, NA), stDev1 = c(129.1485, NA), stDev2 = c(122.888, NA)) dataInput1 <- getDataset(S1 = S1, F = F) ## Comparison of the results of DatasetMeans object 'dataInput1' with expected results expect_equal(dataInput1$overallSampleSizes, c(12, 26, 18, 29, 33, NA_real_, 39, NA_real_)) expect_equal(dataInput1$overallMeans, c(107.7, 86.48462, 165.6, 148.34138, 93.190909, NA_real_, 181.91538, NA_real_), tolerance = 1e-07) expect_equal(dataInput1$overallStDevs, c(128.5, 129.1485, 120.1, 122.888, 134.02535, NA_real_, 157.16289, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(dataInput1), NA))) expect_output(print(dataInput1)$show()) invisible(capture.output(expect_error(summary(dataInput1), NA))) expect_output(summary(dataInput1)$show()) dataInput1CodeBased <- eval(parse(text = getObjectRCode(dataInput1, stringWrapParagraphWidth = NULL))) expect_equal(dataInput1CodeBased$overallSampleSizes, dataInput1$overallSampleSizes, tolerance = 1e-05) expect_equal(dataInput1CodeBased$overallMeans, dataInput1$overallMeans, tolerance = 1e-05) expect_equal(dataInput1CodeBased$overallStDevs, dataInput1$overallStDevs, tolerance = 1e-05) expect_type(names(dataInput1), "character") df <- as.data.frame(dataInput1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(dataInput1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.02, futilityBounds = c(-0.5,0), bindingFutility = FALSE, typeOfDesign = "OF", informationRates = c(0.5,0.7,1)) x1 <- getAnalysisResults(design = design1, dataInput = dataInput1, directionUpper = FALSE, normalApproximation = FALSE, varianceOption = "pooledFromFull", intersectionTest = "Bonferroni", stratifiedAnalysis = FALSE, stage = 2, thetaH1 = c(-30, NA), assumedStDevs = c(88, NA), nPlanned = c(30), allocationRatioPlanned = 2 ) ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.040655272, 0.29596348, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.065736952, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.6346437), tolerance = 1e-07) expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(-215.41406, -176.0794, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(-176.00816, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(99.614058, 24.117528, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(52.294639, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[1, ], c(0.25380947, 0.041128123, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[2, ], c(0.19818652, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults': stratified analysis, select S1 at first IA, gMax = 2, Fisher design", { # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichment} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedtTestEnrichment} S1 <- getDataset( sampleSize1 = c(12,21), sampleSize2 = c(18,21), mean1 = c(107.7, 84.9), mean2 = c(165.6, 195.9), stDev1 = c(128.5, 139.5), stDev2 = c(120.1, 185.0)) R <- getDataset( sampleSize1 = c(14, NA), sampleSize2 = c(11, NA), mean1 = c(68.3, NA), mean2 = c(120.1, NA), stDev1 = c(124.0, NA), stDev2 = c(116.8, NA)) dataInput2 <- getDataset(S1 = S1, R = R) ## Comparison of the results of DatasetMeans object 'dataInput2' with expected results expect_equal(dataInput2$overallSampleSizes, c(12, 14, 18, 11, 33, NA_real_, 39, NA_real_)) expect_equal(dataInput2$overallMeans, c(107.7, 68.3, 165.6, 120.1, 93.190909, NA_real_, 181.91538, NA_real_), tolerance = 1e-07) expect_equal(dataInput2$overallStDevs, c(128.5, 124, 120.1, 116.8, 134.02535, NA_real_, 157.16289, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(dataInput2), NA))) expect_output(print(dataInput2)$show()) invisible(capture.output(expect_error(summary(dataInput2), NA))) expect_output(summary(dataInput2)$show()) dataInput2CodeBased <- eval(parse(text = getObjectRCode(dataInput2, stringWrapParagraphWidth = NULL))) expect_equal(dataInput2CodeBased$overallSampleSizes, dataInput2$overallSampleSizes, tolerance = 1e-05) expect_equal(dataInput2CodeBased$overallMeans, dataInput2$overallMeans, tolerance = 1e-05) expect_equal(dataInput2CodeBased$overallStDevs, dataInput2$overallStDevs, tolerance = 1e-05) expect_type(names(dataInput2), "character") df <- as.data.frame(dataInput2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(dataInput2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design2 <- getDesignFisher(kMax = 3, alpha = 0.02, alpha0Vec = c(0.7,0.5), method = "fullAlpha", bindingFutility = TRUE, informationRates = c(0.3,0.7,1)) x2 <- getAnalysisResults(design = design2, dataInput = dataInput2, directionUpper = FALSE, normalApproximation = FALSE, varianceOption = "pooledFromFull", intersectionTest = "Bonferroni", stratifiedAnalysis = FALSE, stage = 2, thetaH1 = c(-30, NA), assumedStDevs = c(88, NA), nPlanned = c(30), allocationRatioPlanned = 2 ) ## Comparison of the results of AnalysisResultsEnrichmentFisher object 'x2' with expected results expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.030372979, 0.38266716, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.042518986, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, 0.71962915), tolerance = 1e-07) expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(-187.96966, -183.80634, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(-156.27269, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(72.16966, 16.133901, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(32.559163, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[1, ], c(0.19557155, 0.034517266, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[2, ], c(0.13877083, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.02, futilityBounds = c(-0.5,0), bindingFutility = FALSE, typeOfDesign = "OF", informationRates = c(0.5,0.7,1)) x3 <- getAnalysisResults(design = design1, dataInput = dataInput2, directionUpper = FALSE, normalApproximation = FALSE, intersectionTest = "Sidak", stratifiedAnalysis = TRUE, stage = 2, thetaH1 = c(-30, NA), assumedStDevs = c(88, NA), nPlanned = c(30), allocationRatioPlanned = 2 ) ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x3' with expected results expect_equal(x3$conditionalRejectionProbabilities[1, ], c(0.041603465, 0.30059767, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalRejectionProbabilities[2, ], c(0.044887021, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalPower[1, ], c(NA_real_, NA_real_, 0.63965664), tolerance = 1e-07) expect_equal(x3$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$repeatedConfidenceIntervalLowerBounds[1, ], c(-220.28415, -176.85912, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalLowerBounds[2, ], c(-167.67059, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds[1, ], c(104.48415, 23.636689, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds[2, ], c(57.495741, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues[1, ], c(0.25104477, 0.040430988, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues[2, ], c(0.24199442, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults': select S1 at first IA, gMax = 2, inverse normal design, Sidak", { .skipTestIfDisabled() # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichment} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedtTestEnrichment} design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.02, futilityBounds = c(-0.5,0), bindingFutility = FALSE, typeOfDesign = "OF", informationRates = c(0.5,0.7,1)) S1 <- getDataset( sampleSize1 = c(12,21), sampleSize2 = c(18,21), mean1 = c(107.7, 84.9), mean2 = c(165.6, 195.9), stDev1 = c(128.5, 139.5), stDev2 = c(120.1, 185.0)) F <- getDataset( sampleSize1 = c(26, NA), sampleSize2 = c(29, NA), mean1 = c(86.48462, NA), mean2 = c(148.34138, NA), stDev1 = c(129.1485, NA), stDev2 = c(122.888, NA)) dataInput1 <- getDataset(S1 = S1, F = F) x4 <- getAnalysisResults(design = design1, dataInput = dataInput1, directionUpper = FALSE, normalApproximation = FALSE, varianceOption = "notPooled", intersectionTest = "Sidak", stratifiedAnalysis = FALSE, stage = 2, nPlanned = c(30), allocationRatioPlanned = 2 ) ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x4' with expected results expect_equal(x4$thetaH1[1, ], -88.724476, tolerance = 1e-07) expect_equal(x4$thetaH1[2, ], NA_real_) expect_equal(x4$assumedStDevs[1, ], 147.03819, tolerance = 1e-07) expect_equal(x4$assumedStDevs[2, ], NA_real_) expect_equal(x4$conditionalRejectionProbabilities[1, ], c(0.039522227, 0.28885292, NA_real_), tolerance = 1e-07) expect_equal(x4$conditionalRejectionProbabilities[2, ], c(0.066220149, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$conditionalPower[1, ], c(NA_real_, NA_real_, 0.84164989), tolerance = 1e-07) expect_equal(x4$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x4$repeatedConfidenceIntervalLowerBounds[1, ], c(-226.91549, -179.08628, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalLowerBounds[2, ], c(-176.48166, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalUpperBounds[1, ], c(111.11549, 25.050962, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalUpperBounds[2, ], c(52.768138, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedPValues[1, ], c(0.25721122, 0.042227707, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedPValues[2, ], c(0.1973759, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$thetaH1, x4$thetaH1, tolerance = 1e-05) expect_equal(x4CodeBased$assumedStDevs, x4$assumedStDevs, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x5 <- getAnalysisResults(design = design1, dataInput = dataInput1, directionUpper = FALSE, normalApproximation = FALSE, varianceOption = "pooledFromFull", intersectionTest = "SpiessensDebois", stratifiedAnalysis = TRUE, stage = 2, nPlanned = c(30), allocationRatioPlanned = 2 ) ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x5' with expected results expect_equal(x5$thetaH1[1, ], -88.724476, tolerance = 1e-07) expect_equal(x5$thetaH1[2, ], NA_real_) expect_equal(x5$assumedStDevs[1, ], 147.03819, tolerance = 1e-07) expect_equal(x5$assumedStDevs[2, ], NA_real_) expect_equal(x5$conditionalRejectionProbabilities[1, ], c(0.039526191, 0.29036799, NA_real_), tolerance = 1e-07) expect_equal(x5$conditionalRejectionProbabilities[2, ], c(0.083354471, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x5$conditionalPower[1, ], c(NA_real_, NA_real_, 0.84271782), tolerance = 1e-07) expect_equal(x5$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x5$repeatedConfidenceIntervalLowerBounds[1, ], c(-213.98234, -174.20657, NA_real_), tolerance = 1e-07) expect_equal(x5$repeatedConfidenceIntervalLowerBounds[2, ], c(-174.97059, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x5$repeatedConfidenceIntervalUpperBounds[1, ], c(98.182344, 20.343092, NA_real_), tolerance = 1e-07) expect_equal(x5$repeatedConfidenceIntervalUpperBounds[2, ], c(51.257068, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x5$repeatedPValues[1, ], c(0.25719977, 0.041990242, NA_real_), tolerance = 1e-07) expect_equal(x5$repeatedPValues[2, ], c(0.17255753, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x5), NA))) expect_output(print(x5)$show()) invisible(capture.output(expect_error(summary(x5), NA))) expect_output(summary(x5)$show()) x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) expect_equal(x5CodeBased$thetaH1, x5$thetaH1, tolerance = 1e-05) expect_equal(x5CodeBased$assumedStDevs, x5$assumedStDevs, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-05) expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-05) expect_type(names(x5), "character") df <- as.data.frame(x5) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x5) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x6 <- getAnalysisResults(design = design1, dataInput = dataInput1, directionUpper = FALSE, normalApproximation = TRUE, varianceOption = "notPooled", intersectionTest = "SpiessensDebois", stratifiedAnalysis = FALSE, stage = 2, nPlanned = c(30), allocationRatioPlanned = 2 ) ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x6' with expected results expect_equal(x6$thetaH1[1, ], -88.724476, tolerance = 1e-07) expect_equal(x6$thetaH1[2, ], NA_real_) expect_equal(x6$assumedStDevs[1, ], 147.03819, tolerance = 1e-07) expect_equal(x6$assumedStDevs[2, ], NA_real_) expect_equal(x6$conditionalRejectionProbabilities[1, ], c(0.042609088, 0.32732548, NA_real_), tolerance = 1e-07) expect_equal(x6$conditionalRejectionProbabilities[2, ], c(0.088609047, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x6$conditionalPower[1, ], c(NA_real_, NA_real_, 0.86664918), tolerance = 1e-07) expect_equal(x6$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x6$repeatedConfidenceIntervalLowerBounds[1, ], c(-205.0678, -171.09289, NA_real_), tolerance = 1e-07) expect_equal(x6$repeatedConfidenceIntervalLowerBounds[2, ], c(-169.37906, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x6$repeatedConfidenceIntervalUpperBounds[1, ], c(89.267801, 17.032571, NA_real_), tolerance = 1e-07) expect_equal(x6$repeatedConfidenceIntervalUpperBounds[2, ], c(45.665535, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x6$repeatedPValues[1, ], c(0.24818852, 0.036684963, NA_real_), tolerance = 1e-07) expect_equal(x6$repeatedPValues[2, ], c(0.16619082, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x6), NA))) expect_output(print(x6)$show()) invisible(capture.output(expect_error(summary(x6), NA))) expect_output(summary(x6)$show()) x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) expect_equal(x6CodeBased$thetaH1, x6$thetaH1, tolerance = 1e-05) expect_equal(x6CodeBased$assumedStDevs, x6$assumedStDevs, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x6CodeBased$conditionalPower, x6$conditionalPower, tolerance = 1e-05) expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-05) expect_type(names(x6), "character") df <- as.data.frame(x6) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x6) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults': select S1 at first IA, gMax = 2, Fisher design, Sidak", { .skipTestIfDisabled() # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichment} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedtTestEnrichment} design2 <- getDesignFisher(kMax = 3, alpha = 0.02, alpha0Vec = c(0.7,0.5), method = "fullAlpha", bindingFutility = TRUE, informationRates = c(0.3,0.7,1)) S1 <- getDataset( sampleSize1 = c(12,21), sampleSize2 = c(18,21), mean1 = c(107.7, 84.9), mean2 = c(165.6, 195.9), stDev1 = c(128.5, 139.5), stDev2 = c(120.1, 185.0)) F <- getDataset( sampleSize1 = c(26, NA), sampleSize2 = c(29, NA), mean1 = c(86.48462, NA), mean2 = c(148.34138, NA), stDev1 = c(129.1485, NA), stDev2 = c(122.888, NA)) dataInput1 <- getDataset(S1 = S1, F = F) x7 <- getAnalysisResults(design = design2, dataInput = dataInput1, directionUpper = FALSE, normalApproximation = FALSE, varianceOption = "pooled", intersectionTest = "Sidak", stratifiedAnalysis = FALSE, stage = 2, thetaH1 = c(-30, NA), assumedStDevs = c(88, NA), nPlanned = c(30), allocationRatioPlanned = 2 ) ## Comparison of the results of AnalysisResultsEnrichmentFisher object 'x7' with expected results expect_equal(x7$conditionalRejectionProbabilities[1, ], c(0.029419226, 0.36686704, NA_real_), tolerance = 1e-07) expect_equal(x7$conditionalRejectionProbabilities[2, ], c(0.039811318, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x7$conditionalPower[1, ], c(NA_real_, NA_real_, 0.70542247), tolerance = 1e-07) expect_equal(x7$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x7$repeatedConfidenceIntervalLowerBounds[1, ], c(-194.17913, -187.01693, NA_real_), tolerance = 1e-07) expect_equal(x7$repeatedConfidenceIntervalLowerBounds[2, ], c(-158.83149, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x7$repeatedConfidenceIntervalUpperBounds[1, ], c(78.379133, 16.599438, NA_real_), tolerance = 1e-07) expect_equal(x7$repeatedConfidenceIntervalUpperBounds[2, ], c(35.117971, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x7$repeatedPValues[1, ], c(0.20187628, 0.035489058, NA_real_), tolerance = 1e-07) expect_equal(x7$repeatedPValues[2, ], c(0.14858412, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x7), NA))) expect_output(print(x7)$show()) invisible(capture.output(expect_error(summary(x7), NA))) expect_output(summary(x7)$show()) x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) expect_equal(x7CodeBased$conditionalRejectionProbabilities, x7$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x7CodeBased$conditionalPower, x7$conditionalPower, tolerance = 1e-05) expect_equal(x7CodeBased$repeatedConfidenceIntervalLowerBounds, x7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x7CodeBased$repeatedConfidenceIntervalUpperBounds, x7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x7CodeBased$repeatedPValues, x7$repeatedPValues, tolerance = 1e-05) expect_type(names(x7), "character") df <- as.data.frame(x7) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x7) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x8 <- getAnalysisResults(design = design2, dataInput = dataInput1, directionUpper = FALSE, normalApproximation = FALSE, varianceOption = "notPooled", intersectionTest = "Bonferroni", stratifiedAnalysis = FALSE, stage = 2, nPlanned = c(30), allocationRatioPlanned = 2 ) ## Comparison of the results of AnalysisResultsEnrichmentFisher object 'x8' with expected results expect_equal(x8$thetaH1[1, ], -88.724476, tolerance = 1e-07) expect_equal(x8$thetaH1[2, ], NA_real_) expect_equal(x8$assumedStDevs[1, ], 147.03819, tolerance = 1e-07) expect_equal(x8$assumedStDevs[2, ], NA_real_) expect_equal(x8$conditionalRejectionProbabilities[1, ], c(0.028559196, 0.34741778, NA_real_), tolerance = 1e-07) expect_equal(x8$conditionalRejectionProbabilities[2, ], c(0.038896649, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x8$conditionalPower[1, ], c(NA_real_, NA_real_, 0.878132), tolerance = 1e-07) expect_equal(x8$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x8$repeatedConfidenceIntervalLowerBounds[1, ], c(-198.85804, -189.35465, NA_real_), tolerance = 1e-07) expect_equal(x8$repeatedConfidenceIntervalLowerBounds[2, ], c(-159.22325, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x8$repeatedConfidenceIntervalUpperBounds[1, ], c(83.058044, 17.838621, NA_real_), tolerance = 1e-07) expect_equal(x8$repeatedConfidenceIntervalUpperBounds[2, ], c(35.509728, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x8$repeatedPValues[1, ], c(0.20789586, 0.036783191, NA_real_), tolerance = 1e-07) expect_equal(x8$repeatedPValues[2, ], c(0.15219281, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x8), NA))) expect_output(print(x8)$show()) invisible(capture.output(expect_error(summary(x8), NA))) expect_output(summary(x8)$show()) x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) expect_equal(x8CodeBased$thetaH1, x8$thetaH1, tolerance = 1e-05) expect_equal(x8CodeBased$assumedStDevs, x8$assumedStDevs, tolerance = 1e-05) expect_equal(x8CodeBased$conditionalRejectionProbabilities, x8$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x8CodeBased$conditionalPower, x8$conditionalPower, tolerance = 1e-05) expect_equal(x8CodeBased$repeatedConfidenceIntervalLowerBounds, x8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x8CodeBased$repeatedConfidenceIntervalUpperBounds, x8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x8CodeBased$repeatedPValues, x8$repeatedPValues, tolerance = 1e-05) expect_type(names(x8), "character") df <- as.data.frame(x8) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x8) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) context("Testing Analysis Enrichment Means Function (two sub-populations)") test_that("'getAnalysisResults': stratified analysis, select S1 and S2 at first IA, select S1 at second, gMax = 3", { # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichment} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedtTestEnrichment} S1 <- getDataset( sampleSize2 = c( 12, 33, 21), sampleSize1 = c( 18, 17, 23), mean2 = c(107.7, 77.7, 84.9), mean1 = c(125.6, 111.1, 99.9), stDev2 = c(128.5, 133.3, 84.9), stDev1 = c(120.1, 145.6, 74.3)) S2 <- getDataset( sampleSize2 = c( 14, NA, NA), sampleSize1 = c( 11, NA, NA), mean2 = c( 68.3, NA, NA), mean1 = c(100.1, NA, NA), stDev2 = c(124.0, NA, NA), stDev1 = c(116.8, NA, NA)) S12 <- getDataset( sampleSize2 = c( 21, 12, 33), sampleSize1 = c( 21, 17, 31), mean2 = c( 84.9, 107.7, 77.7), mean1 = c( 135.9, 117.7, 97.7), stDev2 = c( 139.5, 107.7, 77.7), stDev1 = c( 185.0, 92.3, 87.3)) R <- getDataset( sampleSize2 = c( 33, NA, NA), sampleSize1 = c( 19, NA, NA), mean2 = c( 77.1, NA, NA), mean1 = c(142.4, NA, NA), stDev2 = c(163.5, NA, NA), stDev1 = c(120.6, NA, NA)) dataInput1 <- getDataset(S1 = S1, S2 = S2, S12 = S12, R = R) ## Comparison of the results of DatasetMeans object 'dataInput1' with expected results expect_equal(dataInput1$overallSampleSizes, c(18, 11, 21, 19, 12, 14, 21, 33, 35, NA_real_, 38, NA_real_, 45, NA_real_, 33, NA_real_, 58, NA_real_, 69, NA_real_, 66, NA_real_, 66, NA_real_)) expect_equal(dataInput1$overallMeans, c(125.6, 100.1, 135.9, 142.4, 107.7, 68.3, 84.9, 77.1, 118.55714, NA_real_, 127.75789, NA_real_, 85.7, NA_real_, 93.190909, NA_real_, 111.15862, NA_real_, 114.25362, NA_real_, 85.445455, NA_real_, 85.445455, NA_real_), tolerance = 1e-07) expect_equal(dataInput1$overallStDevs, c(120.1, 116.8, 185, 120.6, 128.5, 124, 139.5, 163.5, 131.30971, NA_real_, 149.22508, NA_real_, 131.26649, NA_real_, 127.56945, NA_real_, 111.80482, NA_real_, 125.32216, NA_real_, 117.82181, NA_real_, 105.0948, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(dataInput1), NA))) expect_output(print(dataInput1)$show()) invisible(capture.output(expect_error(summary(dataInput1), NA))) expect_output(summary(dataInput1)$show()) dataInput1CodeBased <- eval(parse(text = getObjectRCode(dataInput1, stringWrapParagraphWidth = NULL))) expect_equal(dataInput1CodeBased$overallSampleSizes, dataInput1$overallSampleSizes, tolerance = 1e-05) expect_equal(dataInput1CodeBased$overallMeans, dataInput1$overallMeans, tolerance = 1e-05) expect_equal(dataInput1CodeBased$overallStDevs, dataInput1$overallStDevs, tolerance = 1e-05) expect_type(names(dataInput1), "character") df <- as.data.frame(dataInput1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(dataInput1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults': select S1 and S2 at first IA, select S1 at second, gMax = 3", { # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichment} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedtTestEnrichment} design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.02, futilityBounds = c(-0.5,0), bindingFutility = TRUE, typeOfDesign = "OF", informationRates = c(0.5,0.7,1)) S1N <- getDataset( sampleSize1 = c( 39, 34, NA), sampleSize2 = c( 33, 45, NA), stDev1 = c(156.5026, 120.084, NA), stDev2 = c(134.0254, 126.502, NA), mean1 = c(131.146, 114.4, NA), mean2 = c(93.191, 85.7, NA)) S2N <- getDataset( sampleSize1 = c( 32, NA, NA), sampleSize2 = c( 35, NA, NA), stDev1 = c(163.645, NA, NA), stDev2 = c(131.888, NA, NA), mean1 = c(123.594, NA, NA), mean2 = c(78.26, NA, NA) ) F <- getDataset( sampleSize1 = c( 69, NA, NA), sampleSize2 = c( 80, NA, NA), stDev1 = c(165.4682, NA, NA), stDev2 = c(143.9796, NA, NA), mean1 = c(129.2957, NA, NA), mean2 = c(82.1875, NA, NA)) dataInput2 <- getDataset(S1 = S1N, S2 = S2N, F = F) ## Comparison of the results of DatasetMeans object 'dataInput2' with expected results expect_equal(dataInput2$overallSampleSizes, c(39, 32, 69, 33, 35, 80, 73, NA_real_, NA_real_, 78, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(dataInput2$overallMeans, c(131.146, 123.594, 129.2957, 93.191, 78.26, 82.1875, 123.34649, NA_real_, NA_real_, 88.869269, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(dataInput2$overallStDevs, c(156.5026, 163.645, 165.4682, 134.0254, 131.888, 143.9796, 140.02459, NA_real_, NA_real_, 128.93165, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(dataInput2), NA))) expect_output(print(dataInput2)$show()) invisible(capture.output(expect_error(summary(dataInput2), NA))) expect_output(summary(dataInput2)$show()) dataInput2CodeBased <- eval(parse(text = getObjectRCode(dataInput2, stringWrapParagraphWidth = NULL))) expect_equal(dataInput2CodeBased$overallSampleSizes, dataInput2$overallSampleSizes, tolerance = 1e-05) expect_equal(dataInput2CodeBased$overallMeans, dataInput2$overallMeans, tolerance = 1e-05) expect_equal(dataInput2CodeBased$overallStDevs, dataInput2$overallStDevs, tolerance = 1e-05) expect_type(names(dataInput2), "character") df <- as.data.frame(dataInput2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(dataInput2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x1 <- getAnalysisResults(design = design1, dataInput = dataInput2, directionUpper = TRUE, normalApproximation = FALSE, varianceOption = "pooled", intersectionTest = "Sidak", stratifiedAnalysis = FALSE, stage = 2, nPlanned = c(80), allocationRatioPlanned = 2 ) ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results expect_equal(x1$thetaH1[1, ], 34.477224, tolerance = 1e-07) expect_equal(x1$thetaH1[2, ], NA_real_) expect_equal(x1$thetaH1[3, ], NA_real_) expect_equal(x1$assumedStDevs[1, ], 134.40636, tolerance = 1e-07) expect_equal(x1$assumedStDevs[2, ], NA_real_) expect_equal(x1$assumedStDevs[3, ], NA_real_) expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.016142454, 0.02613542, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.016142454, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalRejectionProbabilities[3, ], c(0.050007377, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.19507788), tolerance = 1e-07) expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(-81.45856, -34.885408, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(-79.606691, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[3, ], c(-38.192738, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(157.36856, 103.57092, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(170.27469, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[3, ], c(132.40914, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[1, ], c(0.34605439, 0.18712011, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[2, ], c(0.34605439, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[3, ], c(0.22233542, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$thetaH1, x1$thetaH1, tolerance = 1e-05) expect_equal(x1CodeBased$assumedStDevs, x1$assumedStDevs, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } .skipTestIfDisabled() design3 <- getDesignInverseNormal(kMax = 3, alpha = 0.02, futilityBounds = c(-0.5,0), bindingFutility = TRUE, typeOfDesign = "OF", informationRates = c(0.5,0.7,1)) design2 <- getDesignFisher(kMax = 3, alpha = 0.02, alpha0Vec = c(0.7, 0.5), method = "equalAlpha", bindingFutility = TRUE, informationRates = c(0.3, 0.7, 1)) x2 <- getAnalysisResults(design = design3, dataInput = dataInput2, directionUpper = TRUE, normalApproximation = FALSE, varianceOption = "notPooled", intersectionTest = "Simes", stratifiedAnalysis = FALSE, stage = 2, thetaH1 = c(50, 30, NA), assumedStDevs = c(122, 88, NA), nPlanned = 80, allocationRatioPlanned = 0.5 ) ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x2' with expected results expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.03098783, 0.056162964, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.03098783, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalRejectionProbabilities[3, ], c(0.045486533, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, 0.55574729), tolerance = 1e-07) expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(-79.922689, -34.33441, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(-81.369964, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[3, ], c(-39.221831, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(155.83269, 103.18642, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(172.03796, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[3, ], c(133.43823, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[1, ], c(0.27466247, 0.13478543, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[2, ], c(0.27466247, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[3, ], c(0.23257404, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x3 <- getAnalysisResults(design = design2, dataInput = dataInput2, directionUpper = TRUE, normalApproximation = FALSE, varianceOption = "pooled", intersectionTest = "Sidak", stratifiedAnalysis = FALSE, stage = 2, nPlanned = 80, allocationRatioPlanned = 0.5 ) ## Comparison of the results of AnalysisResultsEnrichmentFisher object 'x3' with expected results expect_equal(x3$thetaH1[1, ], 34.477224, tolerance = 1e-07) expect_equal(x3$thetaH1[2, ], NA_real_) expect_equal(x3$thetaH1[3, ], NA_real_) expect_equal(x3$assumedStDevs[1, ], 134.40636, tolerance = 1e-07) expect_equal(x3$assumedStDevs[2, ], NA_real_) expect_equal(x3$assumedStDevs[3, ], NA_real_) expect_equal(x3$conditionalRejectionProbabilities[1, ], c(0.01300837, 0.0063168592, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalRejectionProbabilities[2, ], c(0.01300837, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalRejectionProbabilities[3, ], c(0.024114983, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$conditionalPower[1, ], c(NA_real_, NA_real_, 0.078920631), tolerance = 1e-07) expect_equal(x3$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x3$repeatedConfidenceIntervalLowerBounds[1, ], c(-58.494162, -30.46834, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalLowerBounds[2, ], c(-55.474155, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalLowerBounds[3, ], c(-22.271868, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds[1, ], c(134.40416, 94.713072, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds[2, ], c(146.14216, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedConfidenceIntervalUpperBounds[3, ], c(116.48827, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues[1, ], c(0.29239601, 0.21229229, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues[2, ], c(0.29239601, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x3$repeatedPValues[3, ], c(0.15217469, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x3), NA))) expect_output(print(x3)$show()) invisible(capture.output(expect_error(summary(x3), NA))) expect_output(summary(x3)$show()) x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) expect_equal(x3CodeBased$thetaH1, x3$thetaH1, tolerance = 1e-05) expect_equal(x3CodeBased$assumedStDevs, x3$assumedStDevs, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-05) expect_type(names(x3), "character") df <- as.data.frame(x3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } x4 <- getAnalysisResults(design = design2, dataInput = dataInput2, directionUpper = TRUE, normalApproximation = FALSE, varianceOption = "notPooled", intersectionTest = "Simes", stratifiedAnalysis = FALSE, stage = 2, thetaH1 = c(50, NA, NA), assumedStDevs = c(122, NA, NA), nPlanned = 80, allocationRatioPlanned = 0.5 ) ## Comparison of the results of AnalysisResultsEnrichmentFisher object 'x4' with expected results expect_equal(x4$conditionalRejectionProbabilities[1, ], c(0.018024059, 0.0095704388, NA_real_), tolerance = 1e-07) expect_equal(x4$conditionalRejectionProbabilities[2, ], c(0.018024059, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$conditionalRejectionProbabilities[3, ], c(0.022674244, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$conditionalPower[1, ], c(NA_real_, NA_real_, 0.26935817), tolerance = 1e-07) expect_equal(x4$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x4$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x4$repeatedConfidenceIntervalLowerBounds[1, ], c(-57.292213, -30.050759, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalLowerBounds[2, ], c(-56.802775, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalLowerBounds[3, ], c(-23.100932, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalUpperBounds[1, ], c(133.20221, 94.521132, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalUpperBounds[2, ], c(147.47078, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedConfidenceIntervalUpperBounds[3, ], c(117.31733, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedPValues[1, ], c(0.20840036, 0.16345568, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedPValues[2, ], c(0.20840036, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x4$repeatedPValues[3, ], c(0.16277762, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x4), NA))) expect_output(print(x4)$show()) invisible(capture.output(expect_error(summary(x4), NA))) expect_output(summary(x4)$show()) x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-05) expect_type(names(x4), "character") df <- as.data.frame(x4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) context("Testing Analysis Enrichment Means Function (more sub-populations)") test_that("'getAnalysisResults': select S1 and S2 at first IA, select S1 at second, gMax = 4", { # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichment} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedtTestEnrichment} .skipTestIfDisabled() S1 <- getDataset( sampleSize1 = c( 14, 22, NA), sampleSize2 = c( 11, 18, NA), mean1 = c( 68.3, 107.4, NA), mean2 = c(100.1, 140.9, NA), stDev1 = c(124.0, 134.7, NA), stDev2 = c(116.8, 133.7, NA)) S2 <- getDataset( sampleSize1 = c( 12, NA, NA), sampleSize2 = c( 18, NA, NA), mean1 = c(107.7, NA, NA), mean2 = c(125.6, NA, NA), stDev1 = c(128.5, NA, NA), stDev2 = c(120.1, NA, NA)) S3 <- getDataset( sampleSize1 = c( 17, 24, NA), sampleSize2 = c( 14, 19, NA), mean1 = c( 64.3, 101.4, NA), mean2 = c(103.1, 170.4, NA), stDev1 = c(128.0, 125.3, NA), stDev2 = c(111.8, 143.6, NA)) F <- getDataset( sampleSize1 = c( 83, NA, NA), sampleSize2 = c( 79, NA, NA), mean1 = c( 77.1, NA, NA), mean2 = c(142.4, NA, NA), stDev1 = c(163.5, NA, NA), stDev2 = c(120.6, NA, NA)) dataInput3 <- getDataset(S1 = S1, S2 = S2, S3 = S3, F = F) ## Comparison of the results of DatasetMeans object 'dataInput3' with expected results expect_equal(dataInput3$overallSampleSizes, c(14, 12, 17, 83, 11, 18, 14, 79, 36, NA_real_, 41, NA_real_, 29, NA_real_, 33, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_)) expect_equal(dataInput3$overallMeans, c(68.3, 107.7, 64.3, 77.1, 100.1, 125.6, 103.1, 142.4, 92.194444, NA_real_, 86.017073, NA_real_, 125.42414, NA_real_, 141.84848, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(dataInput3$overallStDevs, c(124, 128.5, 128, 163.5, 116.8, 120.1, 111.8, 120.6, 130.27375, NA_real_, 126.18865, NA_real_, 127.0088, NA_real_, 133.48411, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(dataInput3), NA))) expect_output(print(dataInput3)$show()) invisible(capture.output(expect_error(summary(dataInput3), NA))) expect_output(summary(dataInput3)$show()) dataInput3CodeBased <- eval(parse(text = getObjectRCode(dataInput3, stringWrapParagraphWidth = NULL))) expect_equal(dataInput3CodeBased$overallSampleSizes, dataInput3$overallSampleSizes, tolerance = 1e-05) expect_equal(dataInput3CodeBased$overallMeans, dataInput3$overallMeans, tolerance = 1e-05) expect_equal(dataInput3CodeBased$overallStDevs, dataInput3$overallStDevs, tolerance = 1e-05) expect_type(names(dataInput3), "character") df <- as.data.frame(dataInput3) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(dataInput3) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.025, typeOfDesign = "WT", deltaWT = 0.28, informationRates = c(0.5,0.7,1)) x1 <- getAnalysisResults(design = design1, dataInput = dataInput3, directionUpper = FALSE, normalApproximation = FALSE, varianceOption = "notPooled", intersectionTest = "Simes", stratifiedAnalysis = FALSE, stage = 2 ) ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results expect_equal(x1$thetaH1[1, ], -33.229693, tolerance = 1e-07) expect_equal(x1$thetaH1[2, ], NA_real_) expect_equal(x1$thetaH1[3, ], -55.831412, tolerance = 1e-07) expect_equal(x1$thetaH1[4, ], NA_real_) expect_equal(x1$assumedStDevs[1, ], 128.83288, tolerance = 1e-07) expect_equal(x1$assumedStDevs[2, ], NA_real_) expect_equal(x1$assumedStDevs[3, ], 129.48183, tolerance = 1e-07) expect_equal(x1$assumedStDevs[4, ], NA_real_) expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.0046188669, 0.003141658, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.0046188669, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalRejectionProbabilities[3, ], c(0.0046188669, 0.0093523023, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalRejectionProbabilities[4, ], c(0.41158519, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$conditionalPower[4, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(-189.95235, -137.25075, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(-170.18127, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[3, ], c(-175.96326, -146.15913, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalLowerBounds[4, ], c(-132.10549, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(126.35235, 72.344345, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(134.38127, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[3, ], c(98.363257, 46.507217, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedConfidenceIntervalUpperBounds[4, ], c(1.5054896, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[1, ], c(0.5, 0.35403281, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[3, ], c(0.5, 0.26324129, NA_real_), tolerance = 1e-07) expect_equal(x1$repeatedPValues[4, ], c(0.029329288, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x1), NA))) expect_output(print(x1)$show()) invisible(capture.output(expect_error(summary(x1), NA))) expect_output(summary(x1)$show()) x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) expect_equal(x1CodeBased$thetaH1, x1$thetaH1, tolerance = 1e-05) expect_equal(x1CodeBased$assumedStDevs, x1$assumedStDevs, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-05) expect_type(names(x1), "character") df <- as.data.frame(x1) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x1) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) test_that("'getAnalysisResults': stratified analysis, gMax = 4", { .skipTestIfDisabled() # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichment} # @refFS[Formula]{fs:computeRCIsEnrichment} # @refFS[Formula]{fs:conditionalPowerEnrichment} # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} # @refFS[Formula]{fs:stratifiedtTestEnrichment} S1 <- getDataset( sampleSize1 = c( 14, 22, NA), sampleSize2 = c( 11, 18, NA), mean1 = c( 68.3, 107.4, NA), mean2 = c(100.1, 140.9, NA), stDev1 = c(124.0, 134.7, NA), stDev2 = c(116.8, 133.7, NA)) S2 <- getDataset( sampleSize1 = c( 12, NA, NA), sampleSize2 = c( 18, NA, NA), mean1 = c(107.7, NA, NA), mean2 = c(125.6, NA, NA), stDev1 = c(128.5, NA, NA), stDev2 = c(120.1, NA, NA)) S3 <- getDataset( sampleSize1 = c( 17, 24, NA), sampleSize2 = c( 14, 19, NA), mean1 = c( 64.3, 101.4, NA), mean2 = c(103.1, 170.4, NA), stDev1 = c(128.0, 125.3, NA), stDev2 = c(111.8, 143.6, NA)) S12 <- getDataset( sampleSize1 = c( 21, 12, 33), sampleSize2 = c( 21, 17, 31), mean1 = c( 84.9, 107.7, 77.7), mean2 = c( 135.9, 117.7, 97.7), stDev1 = c( 139.5, 107.7, 77.7), stDev2 = c( 185.0, 92.3, 87.3)) S13 <- getDataset( sampleSize1 = c( 21, 12, 33), sampleSize2 = c( 21, 17, 31), mean1 = c( 84.9, 107.7, 77.7), mean2 = c( 135.9, 117.7, 97.7), stDev1 = c( 139.5, 107.7, 77.7), stDev2 = c( 185.0, 92.3, 87.3)) S23 <- getDataset( sampleSize1 = c( 21, 12, 33), sampleSize2 = c( 21, 17, 31), mean1 = c( 84.9, 107.7, 77.7), mean2 = c( 135.9, 117.7, 97.7), stDev1 = c( 139.5, 107.7, 77.7), stDev2 = c( 185.0, 92.3, 87.3)) S123 <- getDataset( sampleSize1 = c( 21, 12, 33), sampleSize2 = c( 21, 17, 31), mean1 = c( 84.9, 107.7, 77.7), mean2 = c( 135.9, 117.7, 97.7), stDev1 = c( 139.5, 107.7, 77.7), stDev2 = c( 185.0, 92.3, 87.3)) R <- getDataset( sampleSize1 = c( 33, NA, NA), sampleSize2 = c( 19, NA, NA), mean1 = c( 77.1, NA, NA), mean2 = c(142.4, NA, NA), stDev1 = c(163.5, NA, NA), stDev2 = c(120.6, NA, NA)) dataInput4 <- getDataset(S1 = S1, S2 = S2, S3 = S3, S12 = S12, S23 = S23, S13 = S13, S123 = S123, R = R) ## Comparison of the results of DatasetMeans object 'dataInput4' with expected results expect_equal(dataInput4$overallSampleSizes, c(14, 12, 17, 21, 21, 21, 21, 33, 11, 18, 14, 21, 21, 21, 21, 19, 36, NA_real_, 41, 33, 33, 33, 33, NA_real_, 29, NA_real_, 33, 38, 38, 38, 38, NA_real_, NA_real_, NA_real_, NA_real_, 66, 66, 66, 66, NA_real_, NA_real_, NA_real_, NA_real_, 69, 69, 69, 69, NA_real_)) expect_equal(dataInput4$overallMeans, c(68.3, 107.7, 64.3, 84.9, 84.9, 84.9, 84.9, 77.1, 100.1, 125.6, 103.1, 135.9, 135.9, 135.9, 135.9, 142.4, 92.194444, NA_real_, 86.017073, 93.190909, 93.190909, 93.190909, 93.190909, NA_real_, 125.42414, NA_real_, 141.84848, 127.75789, 127.75789, 127.75789, 127.75789, NA_real_, NA_real_, NA_real_, NA_real_, 85.445455, 85.445455, 85.445455, 85.445455, NA_real_, NA_real_, NA_real_, NA_real_, 114.25362, 114.25362, 114.25362, 114.25362, NA_real_), tolerance = 1e-07) expect_equal(dataInput4$overallStDevs, c(124, 128.5, 128, 139.5, 139.5, 139.5, 139.5, 163.5, 116.8, 120.1, 111.8, 185, 185, 185, 185, 120.6, 130.27375, NA_real_, 126.18865, 127.56945, 127.56945, 127.56945, 127.56945, NA_real_, 127.0088, NA_real_, 133.48411, 149.22508, 149.22508, 149.22508, 149.22508, NA_real_, NA_real_, NA_real_, NA_real_, 105.0948, 105.0948, 105.0948, 105.0948, NA_real_, NA_real_, NA_real_, NA_real_, 125.32216, 125.32216, 125.32216, 125.32216, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(dataInput4), NA))) expect_output(print(dataInput4)$show()) invisible(capture.output(expect_error(summary(dataInput4), NA))) expect_output(summary(dataInput4)$show()) dataInput4CodeBased <- eval(parse(text = getObjectRCode(dataInput4, stringWrapParagraphWidth = NULL))) expect_equal(dataInput4CodeBased$overallSampleSizes, dataInput4$overallSampleSizes, tolerance = 1e-05) expect_equal(dataInput4CodeBased$overallMeans, dataInput4$overallMeans, tolerance = 1e-05) expect_equal(dataInput4CodeBased$overallStDevs, dataInput4$overallStDevs, tolerance = 1e-05) expect_type(names(dataInput4), "character") df <- as.data.frame(dataInput4) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(dataInput4) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.025, typeOfDesign = "WT", deltaWT = 0.28, informationRates = c(0.5,0.7,1)) x2 <- getAnalysisResults(design = design1, dataInput = dataInput4, directionUpper = FALSE, normalApproximation = FALSE, varianceOption = "notPooled", intersectionTest = "Simes", stratifiedAnalysis = TRUE, stage = 2 ) ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x2' with expected results expect_equal(x2$thetaH1[1, ], -34.35943, tolerance = 1e-07) expect_equal(x2$thetaH1[2, ], NA_real_) expect_equal(x2$thetaH1[3, ], -39.831088, tolerance = 1e-07) expect_equal(x2$thetaH1[4, ], NA_real_) expect_equal(x2$assumedStDevs[1, ], 135.6664, tolerance = 1e-07) expect_equal(x2$assumedStDevs[2, ], NA_real_) expect_equal(x2$assumedStDevs[3, ], 135.69515, tolerance = 1e-07) expect_equal(x2$assumedStDevs[4, ], NA_real_) expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.14436944, 0.18888867, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.14436944, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalRejectionProbabilities[3, ], c(0.14436944, 0.23567728, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalRejectionProbabilities[4, ], c(0.33356756, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$conditionalPower[4, ], c(NA_real_, NA_real_, NA_real_)) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(-124.13667, -87.790806, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(-119.97906, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[3, ], c(-122.68924, -91.731817, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalLowerBounds[4, ], c(-97.969856, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(28.41771, 15.834301, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(30.295343, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[3, ], c(25.470801, 9.1408918, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedConfidenceIntervalUpperBounds[4, ], c(3.369313, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[1, ], c(0.096549841, 0.052699984, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[2, ], c(0.096549841, NA_real_, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[3, ], c(0.096549841, 0.042135201, NA_real_), tolerance = 1e-07) expect_equal(x2$repeatedPValues[4, ], c(0.039953198, NA_real_, NA_real_), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(x2), NA))) expect_output(print(x2)$show()) invisible(capture.output(expect_error(summary(x2), NA))) expect_output(summary(x2)$show()) x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) expect_equal(x2CodeBased$thetaH1, x2$thetaH1, tolerance = 1e-05) expect_equal(x2CodeBased$assumedStDevs, x2$assumedStDevs, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-05) expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-05) expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-05) expect_type(names(x2), "character") df <- as.data.frame(x2) expect_s3_class(df, "data.frame") expect_true(nrow(df) > 0 && ncol(df) > 0) mtx <- as.matrix(x2) expect_true(is.matrix(mtx)) expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) } }) rpact/tests/testthat/test-f_parameter_set_utilities.R0000644000175000017500000001061214154142422023051 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-f_parameter_set_utilities.R ## | Creation date: 08 December 2021, 09:09:22 ## | File version: $Revision$ ## | Last changed: $Date$ ## | Last changed by: $Author$ ## | context("Testing Parameter Set Utility Functions") test_that("'.getParameterValueFormatted' produce correct results if parameter is an array", { x1 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 2), plannedSubjects = c(30, 60), muMaxVector = 0, seed = 123, maxNumberOfIterations = 50L) y1 <- .getParameterValueFormatted(x1, "sampleSizes") expect_equal("sampleSizes", y1$paramName) expect_equal(c(x1$.design$kMax, length(x1$muMaxVector), x1$activeArms + 1), dim(y1$paramValue)) expect_equal(length(as.vector(y1$paramValue)), length(y1$paramValueFormatted)) expect_equal("character", class(y1$paramValueFormatted)) expect_equal("array", y1$type) x2 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 2), plannedSubjects = c(50, 100), muMaxVector = c(0, 1), seed = 123, maxNumberOfIterations = 50L) #x2$sampleSizes lines2 <- capture.output(print(x2)) lines2 <- lines2[grepl("Sample sizes ", lines2)] expect_match(lines2[1], "^ *Sample sizes \\(1\\) \\[1\\] *: 50.0, 50.0 *$") expect_match(lines2[2], "^ *Sample sizes \\(1\\) \\[2\\] *: 17.0, 0.0 *$") expect_match(lines2[3], "^ *Sample sizes \\(2\\) \\[1\\] *: 50.0, 50.0 *$") expect_match(lines2[4], "^ *Sample sizes \\(2\\) \\[2\\] *: 17.0, 3.3 *$") expect_match(lines2[5], "^ *Sample sizes \\(3\\) \\[1\\] *: 50.0, 50.0 *$") expect_match(lines2[6], "^ *Sample sizes \\(3\\) \\[2\\] *: 16.0, 46.7 *$") expect_match(lines2[7], "^ *Sample sizes \\(4\\) \\[1\\] *: 50.0, 50.0 *$") expect_match(lines2[8], "^ *Sample sizes \\(4\\) \\[2\\] *: 50.0, 50.0 *$") x3 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 1), plannedSubjects = 50, muMaxVector = c(0, 1), seed = 123, maxNumberOfIterations = 50L) y3 <- .getParameterValueFormatted(x3, "sampleSizes") expect_equal("sampleSizes", y3$paramName) expect_equal(c(x3$.design$kMax, length(x3$muMaxVector), x3$activeArms + 1), dim(y3$paramValue)) expect_equal(length(as.vector(y3$paramValue)), length(y3$paramValueFormatted) * 2) expect_equal("character", class(y3$paramValueFormatted)) expect_equal("array", y3$type) #x3$sampleSizes lines3 <- capture.output(print(x3)) lines3 <- lines3[grepl("Sample sizes ", lines3)] expect_match(lines3[1], "^ *Sample sizes \\(1\\) *: 50.0, 50.0 *$") expect_match(lines3[2], "^ *Sample sizes \\(2\\) *: 50.0, 50.0 *$") expect_match(lines3[3], "^ *Sample sizes \\(3\\) *: 50.0, 50.0 *$") expect_match(lines3[4], "^ *Sample sizes \\(4\\) *: 50.0, 50.0 *$") x4 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 2), plannedSubjects = c(50, 100), muMaxVector = 0, seed = 123, maxNumberOfIterations = 50L) y4 <- .getParameterValueFormatted(x4, "sampleSizes") expect_equal("sampleSizes", y4$paramName) expect_equal(c(x4$.design$kMax, length(x4$muMaxVector), x4$activeArms + 1), dim(y4$paramValue)) expect_equal(length(as.vector(y4$paramValue)), length(y4$paramValueFormatted)) expect_equal("character", class(y4$paramValueFormatted)) expect_equal("array", y4$type) #x4$sampleSizes lines4 <- capture.output(print(x4)) lines4 <- lines4[grepl("Sample sizes ", lines4)] expect_match(lines4[1], "^ *Sample sizes \\(1\\) \\[1\\] *: 50.0 *$") expect_match(lines4[2], "^ *Sample sizes \\(1\\) \\[2\\] *: 17.0 *$") expect_match(lines4[3], "^ *Sample sizes \\(2\\) \\[1\\] *: 50.0 *$") expect_match(lines4[4], "^ *Sample sizes \\(2\\) \\[2\\] *: 17.0 *$") expect_match(lines4[5], "^ *Sample sizes \\(3\\) \\[1\\] *: 50.0 *$") expect_match(lines4[6], "^ *Sample sizes \\(3\\) \\[2\\] *: 16.0 *$") expect_match(lines4[7], "^ *Sample sizes \\(4\\) \\[1\\] *: 50.0 *$") expect_match(lines4[8], "^ *Sample sizes \\(4\\) \\[2\\] *: 50.0 *$") }) rpact/tests/testthat.R0000644000175000017500000000007414017174150014643 0ustar nileshnilesh library(testthat) library(rpact) test_check("rpact") rpact/R/0000755000175000017500000000000014165535756011737 5ustar nileshnileshrpact/R/f_core_plot.R0000644000175000017500000015107714150167045014352 0ustar nileshnilesh## | ## | *Plot functions* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5594 $ ## | Last changed: $Date: 2021-11-26 15:24:35 +0100 (Fr, 26 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | .addNumberToPlotCaption <- function(caption, type, numberInCaptionEnabled = FALSE) { if (!numberInCaptionEnabled) { return(caption) } return(paste0(caption, " [", type, "]")) } .getPlotCaption <- function(obj, type, numberInCaptionEnabled = FALSE, ..., stopIfNotFound = FALSE) { if (is.null(obj) || length(type) == 0) { return(NA_character_) } .assertIsSingleInteger(type, "type", validateType = FALSE) if (inherits(obj, "TrialDesignPlan")) { if (type == 1) { if (.isTrialDesignPlanSurvival(obj)) { return(.addNumberToPlotCaption("Boundaries Z Scale", type, numberInCaptionEnabled)) } else { return(.addNumberToPlotCaption("Boundaries", type, numberInCaptionEnabled)) } } else if (type == 2) { return(.addNumberToPlotCaption("Boundaries Effect Scale", type, numberInCaptionEnabled)) } else if (type == 3) { return(.addNumberToPlotCaption("Boundaries p Values Scale", type, numberInCaptionEnabled)) } else if (type == 4) { return(.addNumberToPlotCaption("Error Spending", type, numberInCaptionEnabled)) } } if (.isMultiArmSimulationResults(obj)) { if (type == 1) { # Multi-arm, Overall Success return(.addNumberToPlotCaption("Overall Success", type, numberInCaptionEnabled)) } else if (type == 2) { # Multi-arm, Success per Stage return(.addNumberToPlotCaption("Success per Stage", type, numberInCaptionEnabled)) } else if (type == 3) { # Multi-arm, Selected Arms per Stage return(.addNumberToPlotCaption("Selected Arms per Stage", type, numberInCaptionEnabled)) } else if (type == 4) { # Multi-arm, Rejected Arms per Stage return(.addNumberToPlotCaption(ifelse(obj$.design$kMax > 1, "Rejected Arms per Stage", "Rejected Arms"), type, numberInCaptionEnabled)) } } else if (.isEnrichmentSimulationResults(obj)) { if (type == 1) { # Enrichment, Overall Success return(.addNumberToPlotCaption("Overall Success", type, numberInCaptionEnabled)) } else if (type == 2) { # Enrichment, Success per Stage return(.addNumberToPlotCaption("Success per Stage", type, numberInCaptionEnabled)) } else if (type == 3) { # Enrichment, Selected Populations per Stage return(.addNumberToPlotCaption("Selected Populations per Stage", type, numberInCaptionEnabled)) } else if (type == 4) { # Enrichment, Rejected Populations per Stage return(.addNumberToPlotCaption(ifelse(obj$.design$kMax > 1, "Rejected Populations per Stage", "Rejected Populations"), type, numberInCaptionEnabled)) } } else if (inherits(obj, "SimulationResults") && type == 4) { return(.addNumberToPlotCaption("Reject per Stage", type, numberInCaptionEnabled)) } if (inherits(obj, "TrialDesignPlan") || inherits(obj, "SimulationResults")) { if (type == 5) { if (obj$.isSampleSizeObject()) { return(.addNumberToPlotCaption("Sample Size", type, numberInCaptionEnabled)) } else { return(.addNumberToPlotCaption("Overall Power and Early Stopping", type, numberInCaptionEnabled)) } } else if (type == 6) { return(.addNumberToPlotCaption(ifelse(.isTrialDesignPlanSurvival(obj) || inherits(obj, "SimulationResultsSurvival"), "Number of Events", "Sample Size"), type, numberInCaptionEnabled)) } else if (type == 7) { return(.addNumberToPlotCaption("Overall Power", type, numberInCaptionEnabled)) } else if (type == 8) { return(.addNumberToPlotCaption("Overall Early Stopping", type, numberInCaptionEnabled)) } else if (type == 9) { if (.isTrialDesignPlanSurvival(obj) || inherits(obj, "SimulationResultsSurvival")) { return(.addNumberToPlotCaption("Expected Number of Events", type, numberInCaptionEnabled)) } else { return(.addNumberToPlotCaption("Expected Sample Size", type, numberInCaptionEnabled)) } } else if (type == 10) { return(.addNumberToPlotCaption("Study Duration", type, numberInCaptionEnabled)) } else if (type == 11) { return(.addNumberToPlotCaption("Expected Number of Subjects", type, numberInCaptionEnabled)) } else if (type == 12) { return(.addNumberToPlotCaption("Analysis Time", type, numberInCaptionEnabled)) } else if (type == 13) { return(.addNumberToPlotCaption("Cumulative Distribution Function", type, numberInCaptionEnabled)) } else if (type == 14) { return(.addNumberToPlotCaption("Survival Function", type, numberInCaptionEnabled)) } } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignSet")) { if (type == 1) { return(.addNumberToPlotCaption("Boundaries", type, numberInCaptionEnabled)) } else if (type == 3) { return(.addNumberToPlotCaption("Stage Levels", type, numberInCaptionEnabled)) } else if (type == 4) { return(.addNumberToPlotCaption("Error Spending", type, numberInCaptionEnabled)) } else if (type == 5) { return(.addNumberToPlotCaption('Power and Early Stopping', type, numberInCaptionEnabled)) } else if (type == 6) { return(.addNumberToPlotCaption('Average Sample Size and Power / Early Stop', type, numberInCaptionEnabled)) } else if (type == 7) { return(.addNumberToPlotCaption('Power', type, numberInCaptionEnabled)) } else if (type == 8) { return(.addNumberToPlotCaption('Early Stopping', type, numberInCaptionEnabled)) } else if (type == 9) { return(.addNumberToPlotCaption('Average Sample Size', type, numberInCaptionEnabled)) } } else if (inherits(obj, "AnalysisResults")) { if (type == 1) { return(.addNumberToPlotCaption(C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, type, numberInCaptionEnabled)) } else if (type == 2) { return(.addNumberToPlotCaption("Repeated Confidence Intervals", type, numberInCaptionEnabled)) } } else if (inherits(obj, "StageResults")) { return(.addNumberToPlotCaption(C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, type, numberInCaptionEnabled)) } if (stopIfNotFound) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "could not find plot caption for ", class(obj), " and type ", type) } return(NA_character_) } .getPlotTypeNumber <- function(type, x) { if (missing(type) || is.null(type) || length(type) == 0 || all(is.na(type))) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'type' must be defined") } if (!is.numeric(type) && !is.character(type)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'type' must be an integer or character value or vector (is ", class(type), ")") } if (is.numeric(type)) { .assertIsIntegerVector(type, "type", naAllowed = FALSE, validateType = FALSE) } if (is.character(type)) { if (length(type) == 1 && type == "all") { availablePlotTypes <- getAvailablePlotTypes(x) if (is.null(availablePlotTypes)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "function 'getAvailablePlotTypes' not implemented for ", class(x)) } return(availablePlotTypes) } types <- getAvailablePlotTypes(x, output = "numeric") captions <- tolower(getAvailablePlotTypes(x, output = "caption")) typeNumbers <- c() for (typeStr in type) { if (grepl("^\\d+$", typeStr)) { typeNumbers <- c(typeNumbers, as.integer(typeStr)) } else { index <- pmatch(tolower(typeStr), captions) if (!is.na(index)) { typeNumbers <- c(typeNumbers, types[index]) } else { index <- grep(tolower(typeStr), captions) if (length(index) > 0) { for (i in index) { typeNumbers <- c(typeNumbers, types[i]) } } } } } if (length(typeNumbers) > 0) { return(unique(typeNumbers)) } message("Available plot types: ", .arrayToString(tolower( getAvailablePlotTypes(x, output = "caption")), encapsulate = TRUE)) stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", .arrayToString(type), ") could not be identified") } return(type) } .createPlotResultObject <- function(plotList, grid = 1) { .assertIsSingleInteger(grid, "grid", naAllowed = FALSE, validateType = FALSE) .assertIsInClosedInterval(grid, "grid", lower = 0, upper = 100) if (length(plotList) == 0) { if (grid == 0) { return(invisible(plotList)) } return(plotList) } if (!inherits(plotList[[1]], "ggplot") || grid == 1) { return(plotList) } if (grid == 0) { for (p in plotList) { suppressMessages(print(p)) } return(invisible(plotList)) } if (length(plotList) > grid) { return(plotList) } plotCmd <- NA_character_ if (grid > 1) { if ("ggpubr" %in% rownames(installed.packages())) { if (length(plotList) < 8 && length(plotList) %% 2 == 1) { plotCmd <- paste0("ggpubr::ggarrange(plotList[[1]], ", "ggpubr::ggarrange(plotlist = plotList[2:", length(plotList), "]), ncol = 1)") } else if (length(plotList) == 2) { plotCmd <- paste0("ggpubr::ggarrange(plotlist = plotList, ncol = 1)") } else { plotCmd <- paste0("ggpubr::ggarrange(plotlist = plotList)") } } else if ("gridExtra" %in% rownames(installed.packages())) { ncol <- ifelse(length(plotList) == 2, 1, 2) plotCmd <- paste0("gridExtra::grid.arrange(grobs = plotList, ncol = ", ncol, ")") } else if ("cowplot" %in% rownames(installed.packages())) { plotCmd <- "cowplot::plot_grid(plotlist = plotList)" } else { message("Unable to create grid plot because neither 'ggpubr', 'gridExtra', nor 'cowplot' are installed. ", "Install one of these packages to enable grid plots") } } if (!is.na(plotCmd)) { tryCatch({ return(eval(parse(text = plotCmd))) }, error = function(e) { warning("Failed to create grid plot using command '", plotCmd, "': ", e$message) }) } return(plotList) } .printPlotShowSourceSeparator <- function(showSource, typeNumber, typeNumbers) { if (is.logical(showSource) && !showSource) { return(invisible()) } if (length(typeNumbers) == 1) { return(invisible()) } if (typeNumber == typeNumbers[length(typeNumbers)]) { return(invisible()) } cat("--\n") } #' @rdname getAvailablePlotTypes #' @export plotTypes <- function(obj, output = c("numeric", "caption", "numcap", "capnum"), numberInCaptionEnabled = FALSE) { return(getAvailablePlotTypes(obj = obj, output = output, numberInCaptionEnabled = numberInCaptionEnabled)) } .isValidVariedParameterVectorForPlotting <- function(resultObject, plotType) { if (plotType > 12) { return(TRUE) } # if (inherits(resultObject, "TrialDesignPlan") && plotType %in% c(1:4)) { # return(TRUE) # } for (param in c("alternative", "pi1", "hazardRatio")) { if (!is.null(resultObject[[param]]) && resultObject$.getParameterType(param) != C_PARAM_NOT_APPLICABLE && (any(is.na(resultObject[[param]])) || length(resultObject[[param]]) <= 1)) { return(FALSE) } } if (!is.null(resultObject[["hazardRatio"]]) && !is.null(resultObject[["overallReject"]]) && resultObject$.getParameterType("hazardRatio") != C_PARAM_NOT_APPLICABLE && resultObject$.getParameterType("overallReject") != C_PARAM_NOT_APPLICABLE && length(resultObject$hazardRatio) > 0 && length(resultObject$hazardRatio) != length(resultObject$overallReject)) { return(FALSE) } return(TRUE) } .removeInvalidPlotTypes <- function(resultObject, plotTypes, plotTypesToCheck) { if (is.null(plotTypes) || length(plotTypes) == 0) { return(integer(0)) } validPlotTypes <- integer(0) for (plotType in plotTypes) { if (!(plotType %in% plotTypesToCheck)) { validPlotTypes <- c(validPlotTypes, plotType) } else if (.isValidVariedParameterVectorForPlotting(resultObject, plotType)) { validPlotTypes <- c(validPlotTypes, plotType) } } return(validPlotTypes) } #' #' @title #' Get Available Plot Types #' #' @description #' Function to identify the available plot types of an object. #' #' @param obj The object for which the plot types shall be identified, e.g. produced by #' \code{\link{getDesignGroupSequential}} or \code{\link{getSampleSizeMeans}}. #' @param output The output type. Can be one of \code{c("numeric", "caption", "numcap", "capnum")}. #' @param numberInCaptionEnabled If \code{TRUE}, the number will be added to the #' caption, default is \code{FALSE}. #' #' @details #' \code{plotTypes} and \code{getAvailablePlotTypes} are equivalent, i.e., #' \code{plotTypes} is a short form of \code{getAvailablePlotTypes}. #' #' \code{output}: #' \enumerate{ #' \item \code{numeric}: numeric output #' \item \code{caption}: caption as character output #' \item \code{numcap}: list with number and caption #' \item \code{capnum}: list with caption and number #' } #' #' @return Depending on how the \code{output} is specified, #' a numeric vector, a character vector, or a list will be returned. #' #' @examples #' design <- getDesignInverseNormal(kMax = 2) #' getAvailablePlotTypes(design, "numeric") #' plotTypes(design, "caption") #' getAvailablePlotTypes(design, "numcap") #' plotTypes(design, "capnum") #' #' @export #' getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap", "capnum"), numberInCaptionEnabled = FALSE) { output <- match.arg(output) if (is.null(obj)) { if (output == "numeric") { return(NA_real_) } if (output == "caption") { return(NA_character_) } return(list()) } types <- integer(0) if (inherits(obj, "TrialDesignPlan")) { if (obj$.design$kMax > 1) { types <- c(types, 1:4) } types <- c(types, 5) if (obj$.isSampleSizeObject()) { if (.isTrialDesignPlanSurvival(obj)) { types <- c(types, 13, 14) } } else { types <- c(types, 6:9) if (.isTrialDesignPlanSurvival(obj)) { types <- c(types, 10:14) } } types <- .removeInvalidPlotTypes(obj, types, c(5:14)) } else if (inherits(obj, "SimulationResults")) { if (grepl("Enrichment", class(obj)) && !.getSimulationEnrichmentEffectData( obj, validatePlotCapability = FALSE)$valid) { if (output == "numeric") { return(NA_real_) } if (output == "caption") { return(NA_character_) } return(list()) } if (grepl("MultiArm|Enrichment", class(obj))) { types <- c(types, 1) if (obj$.design$kMax > 1) { types <- c(types, 2:3) } } types <- c(types, 4) if (!grepl("MultiArm", class(obj)) || obj$.design$kMax > 1) { types <- c(types, 5:6) } types <- c(types, 7) if (obj$.design$kMax > 1) { types <- c(types, 8) } if (!grepl("MultiArm", class(obj)) || obj$.design$kMax > 1) { types <- c(types, 9) } if (inherits(obj, "SimulationResultsSurvival")) { types <- c(types, 10:14) } types <- .removeInvalidPlotTypes(obj, types, c(4:14)) } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignSet")) { design <- obj if (inherits(obj, "TrialDesignSet")) { design <- obj$getDesignMaster() } if (design$kMax > 1) { types <- c(types, 1, 3) } if (inherits(design, "TrialDesignFisher")) { types <- c(types, 4) } else { types <- c(types, 4:9) } } else if (inherits(obj, "AnalysisResults")) { types <- integer(0) if (.isConditionalPowerEnabled(obj$nPlanned)) { types <- c(1) } types <- c(types, 2) } else if (inherits(obj, "StageResults")) { types <- c(1) } if (output == "numeric") { return(types) } if (output == "caption") { captions <- character(0) for (type in types) { captions <- c(captions, .getPlotCaption(obj, type = type, numberInCaptionEnabled = numberInCaptionEnabled)) } return(captions) } if (output == "numcap") { numcap <- list() for (type in types) { numcap[[as.character(type)]] <- .getPlotCaption(obj, type = type, numberInCaptionEnabled = numberInCaptionEnabled) } return(numcap) } capnum <- list() for (type in types) { capnum[[.getPlotCaption(obj, type = type, numberInCaptionEnabled = numberInCaptionEnabled)]] <- type } return(capnum) } .getVariedParameterHint <- function(variedParameter, variedParameterName) { return(paste0("Note: interim values between ", round(variedParameter[1], 4), " and ", round(variedParameter[2], 4), " were calculated to get smoother lines; use, e.g., '", variedParameterName, " = ", .getVariedParameterVectorSeqCommand(variedParameter), "' to get all interim values")) } .reconstructSequenceCommand <- function(values) { if (length(values) == 0 || all(is.na(values))) { return(NA_character_) } if (length(values) <= 3) { return(.arrayToString(values, vectorLookAndFeelEnabled = (length(values) != 1))) } minValue <- min(values) maxValue <- max(values) by <- (maxValue - minValue) / (length(values) - 1) valuesTemp <- seq(minValue, maxValue, by) if (identical(values, valuesTemp)) { return(paste0("seq(", minValue, ", ", maxValue, ", ", by, ")")) } return(.arrayToString(values, vectorLookAndFeelEnabled = TRUE, maxLength = 10)) } .getRexepSaveCharacter <- function(x) { x <- gsub("\\$", "\\\\$", x) x <- gsub("\\.", "\\\\.", x) return(x) } .createValidParameterName <- function(objectName, parameterName) { if (grepl(paste0(.getRexepSaveCharacter(objectName), "\\$"), parameterName) && !grepl("^\\.design", parameterName)) { return(parameterName) } if (is.null(objectName) || length(objectName) == 0 || is.na(objectName)) { return(parameterName) } if (grepl("^-?\\.?get[A-Z]{1}", parameterName)) { return(parameterName) } return(paste0(objectName, "$", parameterName)) } .showPlotSourceInformation <- function(objectName, ..., xParameterName, yParameterNames, hint = NA_character_, nMax = NA_integer_, type = NA_integer_, showSource = FALSE, xValues = NA_real_) { if (is.character(showSource)) { if (length(showSource) != 1 || trimws(showSource) == "") { return(invisible(NULL)) } if (!(showSource %in% C_PLOT_SHOW_SOURCE_ARGUMENTS)) { warning("'showSource' (", showSource, ") is not allowed and will be ignored", call. = FALSE) return(invisible()) } } else if (!isTRUE(showSource)) { return(invisible(NULL)) } .assertIsSingleCharacter(xParameterName, "xParameterName") if (length(yParameterNames) == 0 || !all(is.character(yParameterNames)) || all(is.na(yParameterNames))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'yParameterNames' (", .arrayToString(yParameterNames), ") must be a valid character vector") } .assertIsSingleCharacter(hint, "hint", naAllowed = TRUE) .assertIsSingleNumber(nMax, "nMax", naAllowed = TRUE) .assertIsNumericVector(xValues, "xValues", naAllowed = TRUE) cat("Source data of the plot", ifelse(!is.na(type), paste0(" (type ", type, ")"), ""), ":\n", sep = "") xAxisCmd <- .reconstructSequenceCommand(xValues) if (is.na(xAxisCmd)) { if (!grepl("(\\$)|(^c\\()", xParameterName) || grepl("^\\.design", xParameterName)) { if (length(objectName) == 0 || is.na(objectName)) { objectName <- "x" } xAxisCmd <- paste0(objectName, "$", xParameterName) } else { xAxisCmd <- xParameterName } } if (!is.na(nMax) && length(yParameterNames) < 3 && xParameterName == "informationRates") { xAxisCmd <- paste0(xAxisCmd, " * ", round(nMax, 1)) } cat(" x-axis: ", xAxisCmd, "\n", sep = "") if (identical(yParameterNames, c("futilityBounds", "criticalValues"))) { yParameterNames[1] <- paste0("c(", objectName, "$futilityBounds, ", objectName, "$criticalValues[length(", objectName, "$criticalValues)])") } else if (identical(yParameterNames, c("futilityBoundsEffectScale", "criticalValuesEffectScale"))) { yParameterNames[1] <- paste0("c(", objectName, "$futilityBoundsEffectScale, ", objectName, "$criticalValuesEffectScale[length(", objectName, "$criticalValuesEffectScale)])") } yAxisCmds <- c() if (length(yParameterNames) == 1) { yAxisCmds <- .createValidParameterName(objectName, yParameterNames) } else { for (yParameterName in yParameterNames) { yAxisCmds <- c(yAxisCmds, .createValidParameterName(objectName, yParameterName)) } } if (length(yAxisCmds) == 1) { cat(" y-axis: ", yAxisCmds, "\n", sep = "") } else { cat(" y-axes:\n") for (i in 1:length(yAxisCmds)) { cat(" y", i, ": ", yAxisCmds[i], "\n", sep = "") } } if (!is.na(hint) && is.character(hint) && nchar(hint) > 0) { cat(hint, "\n", sep = "") } # add simple plot command examples cat("Simple plot command example", ifelse(length(yAxisCmds) == 1, "", "s"), ":\n", sep = "") plotCmds <- c() for (yAxisCmd in yAxisCmds) { plotCmd <- paste0("plot(", xAxisCmd, ", ", yAxisCmd, ", type = \"l\")") plotCmds <- c(plotCmds, plotCmd) cat(" ", plotCmd, "\n", sep = "") } if (showSource == "commands") { return(invisible(plotCmds)) } else if (showSource == "axes") { return(invisible(list(x = xAxisCmd, y = yAxisCmds))) } else if (showSource == "test") { success <- TRUE for (plotCmd in plotCmds) { if (!.testPlotCommand(plotCmd)) { success <- FALSE } } if (success) { cat("All plot commands are valid\n") } else { cat("One ore more plot commands are invalid\n") } return(invisible(plotCmds)) } else if (showSource == "validate") { for (plotCmd in plotCmds) { .testPlotCommand(plotCmd, silent = FALSE) } return(invisible(plotCmds)) } return(invisible(NULL)) } .testPlotCommand <- function(plotCmd, silent = TRUE) { tryCatch({ eval(parse(text = plotCmd)) return(invisible(TRUE)) }, error = function(e) { msg <- paste0("failed to evaluate plot command \"", plotCmd, "\" ", "('", as.character(e$call), "'): ", e$message) if (!silent) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, msg[1]) } cat(.firstCharacterToUpperCase(msg), "\n") }) return(invisible(FALSE)) } .getParameterSetAsDataFrame <- function(parameterSet, designMaster, addPowerAndAverageSampleNumber = FALSE, theta = seq(-1, 1, 0.02), nMax = NA_integer_) { if (.isTrialDesignSet(parameterSet) && parameterSet$getSize() > 1 && (is.null(parameterSet$variedParameters) || length(parameterSet$variedParameters) == 0)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'variedParameters' must be not empty; ", "use 'DesignSet$addVariedParameters(character)' to add one or more varied parameters") } # simulationEnrichmentEnmabled <- grepl("SimulationResultsEnrichment", class(parameterSet)) if (inherits(parameterSet, "TrialDesignSet")) { data <- as.data.frame(parameterSet, niceColumnNamesEnabled = FALSE, includeAllParameters = TRUE, addPowerAndAverageSampleNumber = addPowerAndAverageSampleNumber, theta = theta, nMax = nMax) } else { data <- as.data.frame(parameterSet, niceColumnNamesEnabled = FALSE, includeAllParameters = TRUE) } if (!.isTrialDesignSet(parameterSet)) { variedParameters <- logical(0) if ("stages" %in% colnames(data)) { variedParameters <- "stages" names(variedParameters) <- "Stage" } return(list(data = data, variedParameters = variedParameters)) } if (parameterSet$getSize() <= 1) { return(list(data = data, variedParameters = parameterSet$variedParameters)) } variedParameters <- parameterSet$variedParameters if (nrow(data) > 1) { for (variedParameter in variedParameters) { column <- data[[variedParameter]] if (length(column) <= 1) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "varied parameter '", variedParameter, "' has length ", length(column)) } valueBefore <- column[1] for (i in 2:length(column)) { if (is.na(column[i])) { column[i] <- valueBefore } else { valueBefore <- column[i] } } data[[variedParameter]] <- column } } variedParameterNames <- c() for (variedParameter in variedParameters) { variedParameterNames <- c(variedParameterNames, .getTableColumnNames(design = designMaster)[[variedParameter]]) } names(variedParameters) <- variedParameterNames return(list(data = data, variedParameters = variedParameters)) } .getCategories <- function(data, yParameterName, tableColumnNames) { if (is.null(data$categories) || sum(is.na(data$categories)) > 0) { return(rep(.getAxisLabel(yParameterName, tableColumnNames), nrow(data))) } return(paste(data$categories, .getAxisLabel(yParameterName, tableColumnNames), sep = ", ")) } .getAxisLabel <- function(parameterName, tableColumnNames) { axisLabel <- tableColumnNames[[parameterName]] if (is.null(axisLabel)) { return(paste0("%", parameterName, "%")) } return(axisLabel) } .allGroupValuesEqual <- function(data, parameterName, groupName) { groupedValues <- base::by(data[[parameterName]], data[[groupName]], paste, collapse = ",") groupedValues <- groupedValues[!grepl("^NA(,NA)*$", groupedValues)] if (length(groupedValues) <= 1) { return(TRUE) } for (i in 1:(length(groupedValues) - 1)) { for (j in (i + 1):length(groupedValues)) { if (!is.na(groupedValues[i]) && !is.na(groupedValues[j]) && groupedValues[i] != groupedValues[j]) { return(FALSE) } } } return(TRUE) } .plotParameterSet <- function(..., parameterSet, designMaster, xParameterName, yParameterNames, mainTitle = NA_character_, xlab = NA_character_, ylab = NA_character_, palette = "Set1", theta = seq(-1, 1, 0.02), nMax = NA_integer_, plotPointsEnabled = NA, legendPosition = NA_integer_, variedParameters = logical(0), qnormAlphaLineEnabled = TRUE, yAxisScalingEnabled = TRUE, ratioEnabled = NA, plotSettings = NULL) { simulationEnrichmentEnmabled <- grepl("SimulationResultsEnrichment", class(parameterSet)) if (.isParameterSet(parameterSet) || .isTrialDesignSet(parameterSet)) { parameterNames <- c(xParameterName, yParameterNames) parameterNames <- parameterNames[!(parameterNames %in% c("theta", "averageSampleNumber", "overallEarlyStop", "calculatedPower"))] fieldNames <- c(names(parameterSet$getRefClass()$fields()), names(designMaster$getRefClass()$fields())) if (simulationEnrichmentEnmabled) { fieldNames <- c(fieldNames, gsub("s$", "", names(parameterSet$effectList)), "situation") } for (parameterName in parameterNames) { if (!is.na(parameterName) && !(parameterName %in% fieldNames)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", class(parameterSet), "' and '", class(designMaster), "' ", "do not contain a field with name '", parameterName, "'") } } if (is.null(plotSettings) || !inherits(plotSettings, "PlotSettings")) { plotSettings <- parameterSet$getPlotSettings() } } else { if (is.null(plotSettings) || !inherits(plotSettings, "PlotSettings")) { plotSettings <- PlotSettings() } } if (.isTrialDesignSet(parameterSet)) { parameterSet$assertHaveEqualSidedValues() } addPowerAndAverageSampleNumber <- xParameterName == "theta" && yParameterNames[1] %in% c("averageSampleNumber", "calculatedPower", "overallEarlyStop", "overallReject", "overallFutility") if (!addPowerAndAverageSampleNumber) { addPowerAndAverageSampleNumber <- xParameterName %in% c("effect", "effectMatrix") && yParameterNames[1] %in% c("overallReject", "futilityStop", "earlyStop", "expectedNumberOfSubjects", "expectedNumberOfEvents") } if (addPowerAndAverageSampleNumber && .isMultiArmSimulationResults(parameterSet)) { addPowerAndAverageSampleNumber <- FALSE } if (.isParameterSet(parameterSet) || .isTrialDesignSet(parameterSet)) { df <- .getParameterSetAsDataFrame(parameterSet, designMaster, addPowerAndAverageSampleNumber = addPowerAndAverageSampleNumber, theta = theta, nMax = nMax) data <- df$data variedParameters <- df$variedParameters variedParameters <- na.omit(variedParameters) variedParameters <- variedParameters[variedParameters != "NA"] if (length(variedParameters) == 1 && length(yParameterNames) == 1) { if (.allGroupValuesEqual(data, parameterName = yParameterNames, groupName = variedParameters)) { variedParameters <- logical(0) } } } else if (is.data.frame(parameterSet)) { data <- parameterSet } else { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'parameterSet' (", class(parameterSet), ") must be a data.frame, a 'TrialDesignSet' ", "or an object that inherits from 'ParameterSet'") } if (length(variedParameters) > 0) { legendTitle <- .firstCharacterToUpperCase(paste(names(variedParameters), collapse = "\n")) categoryParameterName <- variedParameters[1] } else { legendTitle <- NA_character_ categoryParameterName <- NA_character_ } yParameterName1 <- yParameterNames[1] yParameterName2 <- NULL yParameterName3 <- NULL if (length(yParameterNames) >= 2) { yParameterName2 <- yParameterNames[2] } if (length(yParameterNames) >= 3) { yParameterName3 <- yParameterNames[3] } mirrorModeEnabled <- any(grepl("Mirrored$", yParameterNames)) tableColumnNames <- .getTableColumnNames(design = designMaster) xAxisLabel <- .getAxisLabel(xParameterName, tableColumnNames) yAxisLabel1 <- .getAxisLabel(yParameterName1, tableColumnNames) yAxisLabel2 <- NULL if (!is.null(yParameterName2) && !is.null(yParameterName3)) { if (!is.na(yParameterName2)) { pn2 <- .getAxisLabel(yParameterName2, tableColumnNames) if (yParameterName2 == "overallEarlyStop") { pn2 <- "Stopping Probability" } yAxisLabel2 <- paste(pn2, .getAxisLabel(yParameterName3, tableColumnNames), sep = " and ") } else { yAxisLabel2 <- .getAxisLabel(yParameterName3, tableColumnNames) } } else if (xParameterName == "effectMatrix" && !is.null(yParameterName2) && !is.na(yParameterName2) && yParameterName1 %in% c("expectedNumberOfEvents", "expectedNumberOfSubjects") && yParameterName2 == "rejectAtLeastOne") { # special case: simulation results, plot type 6 (expected number of subjects and power) yAxisLabel2 <- .getAxisLabel(yParameterName2, tableColumnNames) yParameterName3 <- yParameterName2 yParameterName2 <- NA_character_ } else if (!is.null(yParameterName2) && !mirrorModeEnabled) { yAxisLabel1 <- paste(yAxisLabel1, .getAxisLabel(yParameterName2, tableColumnNames), sep = " and ") } if (yParameterName1 %in% c("alphaSpent", "betaSpent")) { yAxisLabel1 <- "Cumulative Error" if (is.null(yParameterName2)) { yAxisLabel1 <- paste0(yAxisLabel1, " (", .getAxisLabel(yParameterName1, tableColumnNames), ")") } } if (!("xValues" %in% colnames(data)) || !("yValues" %in% colnames(data))) { data$xValues <- data[[xParameterName]] data$yValues <- data[[yParameterName1]] if (yParameterName1 == "futilityBounds") { data$yValues[!is.na(data$yValues) & (is.infinite(data$yValues) | data$yValues == C_FUTILITY_BOUNDS_DEFAULT)] <- NA_real_ } else if (yParameterName1 == "alpha0Vec") { data$yValues[!is.na(data$yValues) & data$yValues == C_ALPHA_0_VEC_DEFAULT] <- NA_real_ } if (is.null(yParameterName2) || is.na(yParameterName2)) { data$yValues2 <- rep(NA_real_, nrow(data)) } else { data$yValues2 <- data[[yParameterName2]] } if (is.null(yParameterName3)) { data$yValues3 <- rep(NA_real_, nrow(data)) } else { data$yValues3 <- data[[yParameterName3]] } if (!is.na(categoryParameterName)) { data$categories <- data[[categoryParameterName]] if (length(variedParameters) > 1) { data$categories <- paste0(variedParameters[1], " = ", data$categories, ", ", variedParameters[2], " = ", data[[variedParameters[2]]]) } } else { data$categories <- rep(NA_character_, nrow(data)) } } if (!is.na(nMax) && is.null(yParameterName3) && xParameterName == "informationRates") { xAxisLabel <- "Sample Size" data$xValues <- data$xValues * nMax tryCatch({ data$xValues <- as.numeric(.formatSampleSizes(data$xValues)) }, error = function(e) { warning("Failed to format sample sizes on x-axis: ", e$message) }) } # add zero point to data if (yParameterName1 %in% c("alphaSpent", "betaSpent")) { data <- data[, c("xValues", "yValues", "yValues2", "categories")] uc <- unique(data$categories) data <- rbind(data.frame( xValues = rep(-0.00001, length(uc)), yValues = rep(0, length(uc)), yValues2 = rep(0, length(uc)), categories = uc ), data) } scalingFactor1 <- 1 scalingFactor2 <- 1 if (!is.null(yParameterName2) && "yValues2" %in% colnames(data) && "yValues3" %in% colnames(data)) { if (yAxisScalingEnabled && !is.null(yParameterName3)) { if (is.na(yParameterName2)) { scalingFactors <- .getScalingFactors(data$yValues, data$yValues3) } else { scalingFactors <- .getScalingFactors(data$yValues, c(data$yValues2, data$yValues3)) } scalingFactor1 <- scalingFactors$scalingFactor1 scalingFactor2 <- scalingFactors$scalingFactor2 } df1 <- data.frame( xValues = data$xValues, yValues = data$yValues * scalingFactor1, categories = .getCategories(data, yParameterName1, tableColumnNames) ) if (!is.na(yParameterName2)) { df2 <- data.frame( xValues = data$xValues, yValues = data$yValues2 * scalingFactor2, categories = .getCategories(data, yParameterName2, tableColumnNames) ) } if (!is.null(yParameterName3)) { df3 <- data.frame( xValues = data$xValues, yValues = data$yValues3 * scalingFactor2, categories = .getCategories(data, yParameterName3, tableColumnNames) ) if (is.na(yParameterName2)) { data <- rbind(df1, df3) } else { data <- rbind(df1, df2, df3) } } else { data <- rbind(df1, df2) } # sort categories for pairwise printing of the legend unqiueValues <- unique(as.character(data$categories)) decreasing <- addPowerAndAverageSampleNumber && xParameterName %in% c("effect", "effectMatrix") data$categories <- factor(data$categories, levels = unqiueValues[order(unqiueValues, decreasing = decreasing)]) if (!is.na(legendTitle) && yParameterName1 == "alphaSpent" && yParameterName2 == "betaSpent") { sep <- ifelse(length(legendTitle) > 0 && nchar(legendTitle) > 0, "\n", "") legendTitle <- paste(legendTitle, "Type of error", sep = sep) } } if (is.na(legendPosition)) { legendPosition <- .getLegendPosition(plotSettings, designMaster, data, yParameterName1, yParameterName2, addPowerAndAverageSampleNumber) } if (is.na(ratioEnabled)) { ratioEnabled <- .isTrialDesignPlanSurvival(parameterSet) || (.isTrialDesignPlanMeans(parameterSet) && parameterSet$meanRatio) || (.isTrialDesignPlanRates(parameterSet) && parameterSet$riskRatio) } plotDashedHorizontalLine <- "criticalValuesEffectScale" %in% yParameterNames && designMaster$sided == 2 p <- .plotDataFrame(data, mainTitle = mainTitle, xlab = xlab, ylab = ylab, xAxisLabel = xAxisLabel, yAxisLabel1 = yAxisLabel1, yAxisLabel2 = yAxisLabel2, palette = palette, plotPointsEnabled = plotPointsEnabled, legendTitle = legendTitle, legendPosition = legendPosition, scalingFactor1 = scalingFactor1, scalingFactor2 = scalingFactor2, addPowerAndAverageSampleNumber = addPowerAndAverageSampleNumber, mirrorModeEnabled = mirrorModeEnabled, plotDashedHorizontalLine = plotDashedHorizontalLine, ratioEnabled = ratioEnabled, plotSettings = plotSettings, sided = designMaster$sided, ...) if (xParameterName == "informationRates") { p <- p + ggplot2::scale_x_continuous(breaks = c(0, round(data$xValues, 3))) } else if (xParameterName == "situation") { # simulation enrichment p <- p + ggplot2::scale_x_continuous(breaks = round(data$xValues)) } # add mirrored lines if (!is.data.frame(parameterSet) && designMaster$sided == 2 && ((yParameterName1 == "criticalValues" || yParameterName1 == "criticalValuesEffectScale") || (!is.null(yParameterName2) && !is.na(yParameterName2) && (yParameterName2 == "criticalValues" || yParameterName2 == "criticalValuesEffectScale")))) { p <- plotSettings$mirrorYValues(p, yValues = data$yValues, plotPointsEnabled = !addPowerAndAverageSampleNumber, pointBorder = .getPointBorder(data, plotSettings)) # add zero line for Pampallona Tsiatis design p <- p + ggplot2::geom_hline(yintercept = 0, linetype = "solid") # longdash } if (!.isTrialDesignFisher(designMaster) && qnormAlphaLineEnabled && ( ( !is.data.frame(parameterSet) && ( yParameterName1 == "criticalValues" || ( yParameterName1 == "futilityBounds" && !is.null(yParameterName2) && yParameterName2 == "criticalValues" ) ) ) || ( !is.null(yParameterName2) && grepl("futilityBounds|criticalValues", yParameterName1) && grepl("criticalValues", yParameterName2) ) ) ) { p <- .addQnormAlphaLine(p, designMaster, plotSettings, data) } if (!.isTrialDesignFisher(designMaster) && (xParameterName == "informationRates" || xParameterName == "eventsPerStage") && yParameterName1 == "stageLevels") { yValue <- designMaster$alpha if (designMaster$sided == 2) { yValue <- yValue / 2 } p <- p + ggplot2::geom_hline(yintercept = yValue, linetype = "dashed") yValueLabel <- paste0("alpha == ", round(yValue, 4)) hjust <- plotSettings$scaleSize(-0.2) p <- p + ggplot2::annotate("label", x = -Inf, hjust = hjust, y = yValue, label = yValueLabel, size = plotSettings$scaleSize(2.5), parse = TRUE, colour = "white", fill = "white") p <- p + ggplot2::annotate("text", x = -Inf, hjust = hjust - plotSettings$scaleSize(0.15), y = yValue, label = yValueLabel, size = plotSettings$scaleSize(2.5), parse = TRUE) } return(p) } .isPampallonaTsiatisDesign <- function(x) { design <- NULL if (inherits(x, "TrialDesign")) { design <- x } if (inherits(x, "TrialDesignSet")) { design <- x$getDesignMaster() } if (is.null(design)) { return(FALSE) } return(design$typeOfDesign == C_TYPE_OF_DESIGN_PT) } .naAndNaNOmit <- function(x) { if (is.null(x) || length(x) == 0) { return(x) } x <- na.omit(x) return(x[!is.nan(x)]) } .getScalingFactors <- function(leftAxisValues, rightAxisValues) { m1 <- ifelse(length(.naAndNaNOmit(leftAxisValues)) == 0, 1, max(.naAndNaNOmit(leftAxisValues))) m2 <- ifelse(length(.naAndNaNOmit(rightAxisValues)) == 0, 1, max(.naAndNaNOmit(rightAxisValues))) if (is.na(m1)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "y-values, left (", .arrayToString(leftAxisValues), ") are not specified correctly") } if (is.na(m2)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "y-values, right (", .arrayToString(rightAxisValues), ") are not specified correctly") } if (m1 > m2) { scalingFactor1 <- 1 scalingFactor2 <- ifelse(m2 == 0, m1, m1 / m2) } else if (m1 < m2) { scalingFactor1 <- ifelse(m1 == 0, m2, m2 / m1) scalingFactor2 <- 1 } else { scalingFactor1 <- 1 scalingFactor2 <- 1 } if (is.infinite(scalingFactor2)) { stop("Failed to calculate 'scalingFactor2' (", scalingFactor2, ") for ", .arrayToString(leftAxisValues, maxLength = 15), " and ", .arrayToString(rightAxisValues, maxLength = 15)) } return(list(scalingFactor1 = scalingFactor1, scalingFactor2 = scalingFactor2)) } .plotDataFrame <- function(data, ..., mainTitle = NA_character_, xlab = NA_character_, ylab = NA_character_, xAxisLabel = NA_character_, yAxisLabel1 = NA_character_, yAxisLabel2 = NA_character_, palette = "Set1", plotPointsEnabled = NA, legendTitle = NA_character_, legendPosition = NA_integer_, scalingFactor1 = 1, scalingFactor2 = 1, addPowerAndAverageSampleNumber = FALSE, mirrorModeEnabled = FALSE, plotDashedHorizontalLine = FALSE, ratioEnabled = FALSE, plotSettings = NULL, sided = 1, discreteXAxis = FALSE) { if (!is.data.frame(data)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'data' must be a data.frame (is ", class(data), ")") } if (is.null(plotSettings)) { plotSettings <- PlotSettings() } nRow <- nrow(data) data <- data[!(data$xValues == 0 & data$xValues == data$yValues), ] removedRows1 <- nRow - nrow(data) nRow <- nrow(data) data <- data[!is.na(data$yValues), ] removedRows2 <- nRow - nrow(data) if (getLogLevel() == C_LOG_LEVEL_WARN && (removedRows1 > 0 || removedRows2 > 0)) { warning(sprintf("Removed %s rows containing (0, 0)-points and %s rows containing missing values", removedRows1, removedRows2), call. = FALSE) } categoryEnabled <- !is.null(data[["categories"]]) && !all(is.na(data$categories)) groupEnabled <- !is.null(data[["groups"]]) && !all(is.na(data$groups)) if (categoryEnabled && groupEnabled) { data <- data[, c("xValues", "yValues", "categories", "groups")] } else if (categoryEnabled) { data <- data[, c("xValues", "yValues", "categories")] } else if (groupEnabled) { data <- data[, c("xValues", "yValues", "groups")] } else { data <- data[, c("xValues", "yValues")] } data$yValues[!is.na(data$yValues) & is.infinite(data$yValues)] <- NA_real_ data <- data[!is.na(data$yValues), ] if (categoryEnabled && groupEnabled) { p <- ggplot2::ggplot(data, ggplot2::aes(x = .data[["xValues"]], y = .data[["yValues"]], colour = factor(.data[["groups"]]), fill = factor(.data[["categories"]]))) } else if (mirrorModeEnabled) { p <- ggplot2::ggplot(data, ggplot2::aes(x = .data[["xValues"]], y = .data[["yValues"]], fill = factor(.data[["categories"]]))) } else if (categoryEnabled) { p <- ggplot2::ggplot(data, ggplot2::aes(x = .data[["xValues"]], y = .data[["yValues"]], colour = factor(.data[["categories"]]))) } else { p <- ggplot2::ggplot(data, ggplot2::aes(x = .data[["xValues"]], y = .data[["yValues"]])) } p <- plotSettings$setTheme(p) p <- plotSettings$hideGridLines(p) if (discreteXAxis) { p <- p + ggplot2::scale_x_continuous(breaks = round(data$xValues)) } # set main title p <- plotSettings$setMainTitle(p, mainTitle) # set legend if (!categoryEnabled || mirrorModeEnabled || (!is.na(legendPosition) && legendPosition == -1)) { p <- p + ggplot2::theme(legend.position = "none") } else { p <- plotSettings$setLegendPosition(p, legendPosition = legendPosition) p <- plotSettings$setLegendBorder(p) p <- plotSettings$setLegendTitle(p, legendTitle) p <- plotSettings$setLegendLabelSize(p) } # set optional scale limits xLim <- .getOptionalArgument("xlim", ...) yLim <- .getOptionalArgument("ylim", ...) if (is.null(yLim) && !missing(yAxisLabel1) && !is.na(yAxisLabel1) && yAxisLabel1 == "Critical value") { yMax <- max(na.omit(data$yValues)) if (length(yMax) == 1 && yMax < 0.1) { yLim <- c(0, 2 * yMax) } } if ((!is.null(xLim) && is.numeric(xLim) && length(xLim) == 2) || (!is.null(yLim) && is.numeric(yLim) && length(yLim) == 2)) { p <- p + ggplot2::coord_cartesian(xlim = xLim, ylim = yLim, expand = TRUE, default = FALSE, clip = "on") } # add dashed line to y = 0 or y = 1 if (mirrorModeEnabled || plotDashedHorizontalLine) { p <- p + ggplot2::geom_hline(yintercept = ifelse(ratioEnabled, 1, 0), linetype = "dashed") } xAxisLabel <- .toCapitalized(xAxisLabel) yAxisLabel1 <- .toCapitalized(yAxisLabel1) yAxisLabel2 <- .toCapitalized(yAxisLabel2) p <- plotSettings$setAxesLabels(p, xAxisLabel = xAxisLabel, yAxisLabel1 = yAxisLabel1, yAxisLabel2 = yAxisLabel2, xlab = xlab, ylab = ylab, scalingFactor1 = scalingFactor1, scalingFactor2 = scalingFactor2) # plot lines and points plotPointsEnabled <- ifelse(is.na(plotPointsEnabled), !addPowerAndAverageSampleNumber, plotPointsEnabled) if (length(unique(data$xValues)) > 20) { plotPointsEnabled <- FALSE } p <- plotSettings$plotValues(p, plotPointsEnabled = plotPointsEnabled, pointBorder = .getPointBorder(data, plotSettings)) p <- plotSettings$setAxesAppearance(p) p <- plotSettings$setColorPalette(p, palette) p <- plotSettings$enlargeAxisTicks(p) companyAnnotationEnabled <- .getOptionalArgument("companyAnnotationEnabled", ...) if (is.null(companyAnnotationEnabled) || !is.logical(companyAnnotationEnabled)) { companyAnnotationEnabled <- FALSE } p <- plotSettings$addCompanyAnnotation(p, enabled = companyAnnotationEnabled) # start plot generation return(p) } .getPointBorder <- function(data, plotSettings) { numberOfCategories <- 1 if (sum(is.na(data$categories)) < length(data$categories)) { numberOfCategories <- length(unique(as.character(data$categories))) } pointBorder <- 4 if (length(unique(data$xValues)) / numberOfCategories > 10) { pointBorder <- 1 plotSettings$adjustPointSize(0.333) } else if (numberOfCategories > 8) { pointBorder <- 1 } else if (numberOfCategories > 6) { pointBorder <- 2 } else if (numberOfCategories > 4) { pointBorder <- 3 } return(pointBorder) } .getLegendPosition <- function(plotSettings, designMaster, data, yParameterName1, yParameterName2, addPowerAndAverageSampleNumber) { if (length(unique(data$categories)) > 6) { plotSettings$adjustPointSize(0.8) plotSettings$adjustLegendFontSize(0.8) return(C_POSITION_OUTSIDE_PLOT) } if (.isTrialDesignWithValidFutilityBounds(designMaster) && yParameterName1 == "futilityBounds" && yParameterName2 == "criticalValues") { return(C_POSITION_RIGHT_BOTTOM) } if (.isTrialDesignWithValidAlpha0Vec(designMaster) && yParameterName1 == "alpha0Vec" && yParameterName2 == "criticalValues") { return(C_POSITION_RIGHT_TOP) } if (yParameterName1 == "criticalValues") { return(C_POSITION_RIGHT_TOP) } if (yParameterName1 %in% c("stageLevels", "alphaSpent", "betaSpent")) { return(C_POSITION_LEFT_TOP) } if (addPowerAndAverageSampleNumber) { return(C_POSITION_LEFT_CENTER) } return(C_POSITION_OUTSIDE_PLOT) } .addQnormAlphaLine <- function(p, designMaster, plotSettings, data, annotationEnabled = TRUE) { alpha <- designMaster$alpha if (designMaster$sided == 2) { alpha <- alpha / 2 } yValue <- .getOneMinusQNorm(alpha) yValueLabel <- paste0("qnorm(1 - ", alpha, " ) == ", round(yValue, 4)) if (designMaster$sided == 1) { p <- p + ggplot2::geom_hline(yintercept = yValue, linetype = "dashed") } else { p <- p + ggplot2::geom_hline(yintercept = yValue, linetype = "dashed") p <- p + ggplot2::geom_hline(yintercept = -yValue, linetype = "dashed") } if (annotationEnabled) { p <- p + ggplot2::annotate("label", x = -Inf, hjust = plotSettings$scaleSize(-0.1), y = yValue, label = yValueLabel, size = plotSettings$scaleSize(2.5), parse = TRUE, colour = "white", fill = "white") p <- p + ggplot2::annotate("text", x = -Inf, hjust = plotSettings$scaleSize(-0.15), y = yValue, label = yValueLabel, size = plotSettings$scaleSize(2.5), parse = TRUE) } # expand y-axis range if (designMaster$sided == 1) { yMax <- max(stats::na.omit(data$yValues)) if (!is.null(data$yValues2) && length(data$yValues2) > 0) { yMax <- max(yMax, stats::na.omit(data$yValues2)) } eps <- (yMax - yValue) * 0.15 p <- plotSettings$expandAxesRange(p, y = yValue - eps) } return(p) } .getLambdaStepFunctionByTime <- function(time, piecewiseSurvivalTime, lambda2) { if (length(piecewiseSurvivalTime) == 0 || any(is.na(piecewiseSurvivalTime))) { return(lambda2[1]) } for (i in 1:length(piecewiseSurvivalTime)) { if (time <= piecewiseSurvivalTime[i]) { return(lambda2[i]) } } return(lambda2[length(lambda2)]) } .getLambdaStepFunction <- function(timeValues, piecewiseSurvivalTime, piecewiseLambda) { if (length(piecewiseSurvivalTime) != length(piecewiseLambda)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'piecewiseSurvivalTime' (", length(piecewiseSurvivalTime), ") must be equal to length of 'piecewiseLambda' (", length(piecewiseLambda), ") - 1") } piecewiseSurvivalTime <- .getPiecewiseExpStartTimesWithoutLeadingZero(piecewiseSurvivalTime) if (length(piecewiseSurvivalTime) == 0) { return(piecewiseLambda[1]) } lambdaValues <- c() for (time in timeValues) { lambdaValues <- c(lambdaValues, .getLambdaStepFunctionByTime(time, piecewiseSurvivalTime, piecewiseLambda)) } return(lambdaValues) } #' #' @title #' Get Lambda Step Function #' #' @description #' Calculates the lambda step values for a given time vector. #' #' @param timeValues A numeric vector that specifies the time values for which the lambda step values shall be calculated. #' @param piecewiseSurvivalTime A numeric vector that specifies the time intervals for the piecewise #' definition of the exponential survival time cumulative distribution function (see details). #' @param piecewiseLambda A numeric vector that specifies the assumed hazard rate in the treatment group. #' @inheritParams param_three_dots #' #' @details #' The first element of the vector \code{piecewiseSurvivalTime} must be equal to \code{0}. #' This function is used for plotting of sample size survival results #' (cf., \code{\link[=plot.TrialDesignPlan]{plot}}, \code{type = 13} and \code{type = 14}). #' #' @return A numeric vector containing the lambda step values that corresponds to the specified time values. #' #' @export #' #' @keywords internal #' getLambdaStepFunction <- function(timeValues, ..., piecewiseSurvivalTime, piecewiseLambda) { .assertIsNumericVector(timeValues, "timeValues") .assertIsNumericVector(piecewiseSurvivalTime, "piecewiseSurvivalTime") .assertIsNumericVector(piecewiseLambda, "piecewiseLambda") .warnInCaseOfUnknownArguments(functionName = "getLambdaStepFunction", ...) .getLambdaStepFunction(timeValues = timeValues, piecewiseSurvivalTime = piecewiseSurvivalTime, piecewiseLambda = piecewiseLambda) } .getRelativeFigureOutputPath <- function(subDir = NULL) { if (is.null(subDir)) { subDir <- format(Sys.Date(), format="%Y-%m-%d") } figPath <- file.path(getwd(), "_examples", "output", "figures", subDir) if (!dir.exists(figPath)) { dir.create(figPath, showWarnings = FALSE, recursive = TRUE) } return(figPath) } # @title # Save Last Plot # # @description # Saves the last plot to a PNG file located in # '[getwd()]/_examples/output/figures/[current date]/[filename].png'. # # @param filename The filename (without extension!). # # @details # This is a wrapper function that creates a output path and uses \code{ggsave} to save the last plot. # # @examples # # # saveLastPlot('my_plot') # # @keywords internal # saveLastPlot <- function(filename, outputPath = .getRelativeFigureOutputPath()) { .assertGgplotIsInstalled() if (grepl("\\\\|/", filename)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'filename' seems to be a path. ", "Please specify 'outputPath' separately") } if (!grepl("\\.png$", filename)) { filename <- paste0(filename, ".png") } path <- file.path(outputPath, filename) ggplot2::ggsave(filename = path, plot = ggplot2::last_plot(), device = NULL, path = NULL, scale = 1.2, width = 16, height = 15, units = "cm", dpi = 600, limitsize = TRUE) cat("Last plot was saved to '", path, "'\n") } .getGridPlotSettings <- function(x, typeNumbers, grid) { if (length(typeNumbers) <= 3 || grid <= 1) { return(NULL) } if (is.null(x[[".plotSettings"]])) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'x' (", class(x), ") does not contain field .plotSettings") } plotSettings <- x$.plotSettings if (is.null(plotSettings)) { plotSettings <- PlotSettings() } else { plotSettings <- plotSettings$clone() } if (plotSettings$scalingFactor == 1) { plotSettings$scalingFactor <- 0.6 } return(plotSettings) } .getGridLegendPosition <- function(legendPosition, typeNumbers, grid) { if (length(typeNumbers) <= 3 || grid <= 1) { return(NA_integer_) } if (is.na(legendPosition)) { return(-1L) # hide legend } return(legendPosition) } .formatSubTitleValue <- function(value, paramName) { if (paramName == "allocationRatioPlanned") { return(round(value, 2)) } if (paramName %in% c("assumedStDev", "assumedStDevs")) { if (length(value) > 1) { return(paste0("(", .arrayToString(round(value, 1), encapsulate = FALSE), ")")) } return(round(value, 2)) } if (paramName %in% c("piControls", "pi2")) { if (length(value) > 1) { return(paste0("(", .arrayToString(round(value, 3), encapsulate = FALSE), ")")) } return(round(value, 3)) } return(.arrayToString(round(value, 2))) } rpact/R/f_analysis_base_survival.R0000644000175000017500000016311414165522313017126 0ustar nileshnilesh## | ## | *Analysis of survival data with group sequential and combination test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5684 $ ## | Last changed: $Date: 2022-01-05 12:27:24 +0100 (Mi, 05 Jan 2022) $ ## | Last changed by: $Author: wassmer $ ## | .getAnalysisResultsSurvival <- function(..., design, dataInput) { if (.isTrialDesignGroupSequential(design)) { return(.getAnalysisResultsSurvivalGroupSequential( design = design, dataInput = dataInput, ... )) } if (.isTrialDesignInverseNormal(design)) { return(.getAnalysisResultsSurvivalInverseNormal( design = design, dataInput = dataInput, ... )) } if (.isTrialDesignFisher(design)) { return(.getAnalysisResultsSurvivalFisher( design = design, dataInput = dataInput, ... )) } .stopWithWrongDesignMessage(design) } .getAnalysisResultsSurvivalInverseNormal <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, thetaH0 = C_THETA_H0_SURVIVAL_DEFAULT, thetaH1 = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .assertIsTrialDesignInverseNormal(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsSurvivalInverseNormal", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsInverseNormal(design = design, dataInput = dataInput) .getAnalysisResultsSurvivalAll( results = results, design = design, dataInput = dataInput, stage = stage, directionUpper = directionUpper, thetaH0 = thetaH0, thetaH1 = thetaH1, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance ) return(results) } .getAnalysisResultsSurvivalGroupSequential <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, thetaH0 = C_THETA_H0_SURVIVAL_DEFAULT, thetaH1 = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .assertIsTrialDesignGroupSequential(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsSurvivalGroupSequential", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsGroupSequential(design = design, dataInput = dataInput) .getAnalysisResultsSurvivalAll( results = results, design = design, dataInput = dataInput, stage = stage, directionUpper = directionUpper, thetaH0 = thetaH0, thetaH1 = thetaH1, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance ) return(results) } .getAnalysisResultsSurvivalFisher <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, thetaH0 = C_THETA_H0_SURVIVAL_DEFAULT, thetaH1 = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsSurvivalFisher", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsFisher(design = design, dataInput = dataInput) .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) .getAnalysisResultsSurvivalAll( results = results, design = design, dataInput = dataInput, stage = stage, directionUpper = directionUpper, thetaH0 = thetaH0, thetaH1 = thetaH1, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance, iterations = iterations, seed = seed ) return(results) } # # The following parameters will be taken from 'design': # stages, informationRate, criticalValues, futilityBounds, alphaSpent, stageLevels # .getAnalysisResultsSurvivalAll <- function(..., results, design, dataInput, stage, directionUpper, thetaH0, thetaH1, nPlanned, allocationRatioPlanned, tolerance, iterations, seed) { startTime <- Sys.time() stageResults <- .getStageResultsSurvival( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper ) results$.setStageResults(stageResults) .logProgress("Stage results calculated", startTime = startTime) thetaH1User <- thetaH1 thetaH1 <- .assertIsValidThetaH1(thetaH1, stageResults, stage) .assertIsInOpenInterval(thetaH1, "thetaH1", 0, Inf) if (identical(thetaH1, thetaH1User)) { .setValueAndParameterType(results, "thetaH1", thetaH1, NA_real_) } else { results$thetaH1 <- thetaH1 results$.setParameterType("thetaH1", C_PARAM_GENERATED) } .warnInCaseOfUnusedConditionalPowerArgument(results, nPlanned, "thetaH1", thetaH1) .setValueAndParameterType(results, "directionUpper", directionUpper, C_DIRECTION_UPPER_DEFAULT) .setValueAndParameterType(results, "normalApproximation", TRUE, TRUE) .setValueAndParameterType(results, "thetaH0", thetaH0, C_THETA_H0_SURVIVAL_DEFAULT) .setConditionalPowerArguments(results, dataInput, nPlanned, allocationRatioPlanned) # test actions results$testActions <- getTestActions(stageResults = stageResults) results$.setParameterType("testActions", C_PARAM_GENERATED) if (design$kMax > 1) { # conditional power startTime <- Sys.time() if (.isTrialDesignFisher(design)) { results$.conditionalPowerResults <- .getConditionalPowerSurvival( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, iterations = iterations, seed = seed ) if (results$.conditionalPowerResults$simulated) { results$conditionalPowerSimulated <- results$.conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalPowerSimulated", C_PARAM_GENERATED) results$.setParameterType("seed", results$.conditionalPowerResults$.getParameterType("seed")) results$seed <- results$.conditionalPowerResults$seed results$.setParameterType( "iterations", results$.conditionalPowerResults$.getParameterType("iterations") ) results$iterations <- results$.conditionalPowerResults$iterations } else { results$conditionalPower <- results$.conditionalPowerResults$conditionalPower results$conditionalPowerSimulated <- numeric(0) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$.setParameterType("conditionalPowerSimulated", C_PARAM_NOT_APPLICABLE) } } else { results$.conditionalPowerResults <- .getConditionalPowerSurvival( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1 ) results$conditionalPower <- results$.conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_GENERATED) } .logProgress("Conditional power calculated", startTime = startTime) # CRP - conditional rejection probabilities startTime <- Sys.time() if (.isTrialDesignFisher(design) && isTRUE(.getOptionalArgument("simulateCRP", ...))) { results$.setParameterType("seed", ifelse(is.na(seed), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) seed <- results$.conditionalPowerResults$seed crp <- getConditionalRejectionProbabilities( stageResults = stageResults, iterations = iterations, seed = seed ) results$conditionalRejectionProbabilities <- crp$crpFisherSimulated paramTypeSeed <- results$.conditionalPowerResults$.getParameterType("seed") if (paramTypeSeed != C_PARAM_TYPE_UNKNOWN) { results$.setParameterType("seed", paramTypeSeed) } results$seed <- seed } else { results$conditionalRejectionProbabilities <- getConditionalRejectionProbabilities(stageResults = stageResults) } results$.setParameterType("conditionalRejectionProbabilities", C_PARAM_GENERATED) .logProgress("Conditional rejection probabilities (CRP) calculated", startTime = startTime) } # RCI - repeated confidence interval startTime <- Sys.time() repeatedConfidenceIntervals <- .getRepeatedConfidenceIntervalsSurvival( design = design, dataInput = dataInput, stage = stage, tolerance = tolerance ) results$repeatedConfidenceIntervalLowerBounds <- repeatedConfidenceIntervals[1, ] results$repeatedConfidenceIntervalUpperBounds <- repeatedConfidenceIntervals[2, ] results$.setParameterType("repeatedConfidenceIntervalLowerBounds", C_PARAM_GENERATED) results$.setParameterType("repeatedConfidenceIntervalUpperBounds", C_PARAM_GENERATED) .logProgress("Repeated confidence interval calculated", startTime = startTime) # repeated p-value startTime <- Sys.time() results$repeatedPValues <- getRepeatedPValues( stageResults = stageResults, tolerance = tolerance ) results$.setParameterType("repeatedPValues", C_PARAM_GENERATED) .logProgress("Repeated p-values calculated", startTime = startTime) if (design$kMax > 1) { # final p-value startTime <- Sys.time() finalPValue <- getFinalPValue(stageResults) results$finalPValues <- .getVectorWithFinalValueAtFinalStage( kMax = design$kMax, finalValue = finalPValue$pFinal, finalStage = finalPValue$finalStage ) results$finalStage <- finalPValue$finalStage results$.setParameterType("finalPValues", C_PARAM_GENERATED) results$.setParameterType("finalStage", C_PARAM_GENERATED) .logProgress("Final p-value calculated", startTime = startTime) # final confidence interval & median unbiased estimate startTime <- Sys.time() finalConfidenceIntervals <- .getFinalConfidenceIntervalSurvival( design = design, dataInput = dataInput, thetaH0 = thetaH0, stage = stage, directionUpper = directionUpper, tolerance = tolerance ) if (!is.null(finalConfidenceIntervals)) { finalStage <- finalConfidenceIntervals$finalStage results$finalConfidenceIntervalLowerBounds <- .getVectorWithFinalValueAtFinalStage( kMax = design$kMax, finalValue = finalConfidenceIntervals$finalConfidenceInterval[1], finalStage = finalStage ) results$finalConfidenceIntervalUpperBounds <- .getVectorWithFinalValueAtFinalStage( kMax = design$kMax, finalValue = finalConfidenceIntervals$finalConfidenceInterval[2], finalStage = finalStage ) results$medianUnbiasedEstimates <- .getVectorWithFinalValueAtFinalStage( kMax = design$kMax, finalValue = finalConfidenceIntervals$medianUnbiased, finalStage = finalStage ) results$.setParameterType("finalConfidenceIntervalLowerBounds", C_PARAM_GENERATED) results$.setParameterType("finalConfidenceIntervalUpperBounds", C_PARAM_GENERATED) results$.setParameterType("medianUnbiasedEstimates", C_PARAM_GENERATED) .logProgress("Final confidence interval calculated", startTime = startTime) } } return(results) } # @title # Get Stage Results Survival # # @description # Returns a stage results object # # @param design the trial design. # # @return Returns a \code{StageResultsSurvival} object. # # @keywords internal # .getStageResultsSurvival <- function(..., design, dataInput, thetaH0 = C_THETA_H0_SURVIVAL_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, stage = NA_integer_, userFunctionCallEnabled = FALSE) { .assertIsDatasetSurvival(dataInput) .assertIsValidThetaH0DataInput(thetaH0, dataInput) .assertIsValidDirectionUpper(directionUpper, design$sided, userFunctionCallEnabled = userFunctionCallEnabled) .warnInCaseOfUnknownArguments( functionName = "getStageResultsSurvival", ignore = .getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), ... ) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design, stage = stage) overallEvents <- dataInput$getOverallEventsUpTo(stage, group = 1) overallAllocationRatios <- dataInput$getOverallAllocationRatiosUpTo(stage, group = 1) # Calculation of overall log-ranks for specified hypothesis overallLogRankTestStatistics <- dataInput$getOverallLogRanksUpTo(stage, group = 1) - sqrt(overallEvents) * sqrt(overallAllocationRatios) / (1 + overallAllocationRatios) * log(thetaH0) effectSizes <- exp(dataInput$getOverallLogRanksUpTo(stage, group = 1) * (1 + overallAllocationRatios[1:stage]) / sqrt(overallAllocationRatios[1:stage] * overallEvents[1:stage])) events <- dataInput$getEventsUpTo(stage, group = 1) allocationRatios <- dataInput$getAllocationRatiosUpTo(stage, group = 1) # Calculation of log-ranks for specified hypothesis logRankTestStatistics <- dataInput$getLogRanksUpTo(stage, group = 1) - sqrt(events) * sqrt(allocationRatios) / (1 + allocationRatios) * log(thetaH0) # Calculation of stage-wise test statistics and combination tests pValues <- rep(NA_real_, design$kMax) combInverseNormal <- rep(NA_real_, design$kMax) combFisher <- rep(NA_real_, design$kMax) weightsInverseNormal <- .getWeightsInverseNormal(design) weightsFisher <- .getWeightsFisher(design) if (directionUpper) { pValues <- 1 - stats::pnorm(logRankTestStatistics) overallPValues <- 1 - stats::pnorm(overallLogRankTestStatistics) } else { pValues <- stats::pnorm(logRankTestStatistics) overallPValues <- stats::pnorm(overallLogRankTestStatistics) } for (k in 1:stage) { # Inverse normal test combInverseNormal[k] <- (weightsInverseNormal[1:k] %*% .getOneMinusQNorm(pValues[1:k])) / sqrt(sum(weightsInverseNormal[1:k]^2)) # Fisher combination test combFisher[k] <- prod(pValues[1:k]^weightsFisher[1:k]) } stageResults <- StageResultsSurvival( design = design, dataInput = dataInput, stage = as.integer(stage), overallTestStatistics = .fillWithNAs(overallLogRankTestStatistics, design$kMax), overallPValues = .fillWithNAs(overallPValues, design$kMax), overallEvents = .fillWithNAs(overallEvents, design$kMax), overallAllocationRatios = .fillWithNAs(overallAllocationRatios, design$kMax), events = .fillWithNAs(events, design$kMax), allocationRatios = .fillWithNAs(allocationRatios, design$kMax), testStatistics = .fillWithNAs(logRankTestStatistics, design$kMax), pValues = .fillWithNAs(pValues, design$kMax), effectSizes = .fillWithNAs(effectSizes, design$kMax), combInverseNormal = combInverseNormal, combFisher = combFisher, weightsFisher = weightsFisher, weightsInverseNormal = weightsInverseNormal, thetaH0 = thetaH0, direction = ifelse(directionUpper, C_DIRECTION_UPPER, C_DIRECTION_LOWER) ) if (.isTrialDesignFisher(design)) { stageResults$.setParameterType("combFisher", C_PARAM_GENERATED) stageResults$.setParameterType("weightsFisher", C_PARAM_GENERATED) } else if (.isTrialDesignInverseNormal(design)) { stageResults$.setParameterType("combInverseNormal", C_PARAM_GENERATED) stageResults$.setParameterType("weightsInverseNormal", C_PARAM_GENERATED) } return(stageResults) } # # Calculation of lower and upper limits of repeated confidence intervals (RCIs) for Survival # .getRepeatedConfidenceIntervalsSurvival <- function(..., design) { if (.isTrialDesignGroupSequential(design)) { return(.getRepeatedConfidenceIntervalsSurvivalGroupSequential(design = design, ...)) } if (.isTrialDesignInverseNormal(design)) { return(.getRepeatedConfidenceIntervalsSurvivalInverseNormal(design = design, ...)) } if (.isTrialDesignFisher(design)) { return(.getRepeatedConfidenceIntervalsSurvivalFisher(design = design, ...)) } .stopWithWrongDesignMessage(design) } .getRootThetaSurvival <- function(..., design, dataInput, stage, directionUpper, thetaLow, thetaUp, firstParameterName, secondValue, tolerance, callingFunctionInformation) { result <- .getOneDimensionalRoot( function(theta) { stageResults <- .getStageResultsSurvival( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper ) firstValue <- stageResults[[firstParameterName]][stage] if (.isTrialDesignGroupSequential(design)) { firstValue <- .getOneMinusQNorm(firstValue) } return(firstValue - secondValue) }, lower = thetaLow, upper = thetaUp, tolerance = tolerance, callingFunctionInformation = callingFunctionInformation ) return(result) } .getUpperLowerThetaSurvival <- function(..., design, dataInput, theta, stage, directionUpper, conditionFunction, firstParameterName, secondValue) { stageResults <- .getStageResultsSurvival( design = design, dataInput = dataInput, stage = stage, thetaH0 = exp(theta), directionUpper = directionUpper ) firstValue <- stageResults[[firstParameterName]][stage] if (.isTrialDesignGroupSequential(design)) { firstValue <- .getOneMinusQNorm(firstValue) } maxSearchIterations <- 30 while (conditionFunction(secondValue, firstValue)) { theta <- 2 * theta stageResults <- .getStageResultsSurvival( design = design, dataInput = dataInput, stage = stage, thetaH0 = exp(theta), directionUpper = directionUpper ) firstValue <- stageResults[[firstParameterName]][stage] if (.isTrialDesignGroupSequential(design)) { firstValue <- .getOneMinusQNorm(firstValue) } maxSearchIterations <- maxSearchIterations - 1 if (maxSearchIterations < 0) { stop(sprintf( paste0( "Failed to find theta (k = %s, firstValue = %s, ", "secondValue = %s, levels(firstValue) = %s, theta = %s)" ), stage, stageResults[[firstParameterName]][stage], secondValue, firstValue, theta )) } } return(theta) } .getRepeatedConfidenceIntervalsSurvivalAll <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, firstParameterName) { stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) # necessary for adjustment for binding futility boundaries futilityCorr <- rep(NA_real_, design$kMax) criticalValues <- design$criticalValues if (.isTrialDesignFisher(design)) { bounds <- design$alpha0Vec border <- C_ALPHA_0_VEC_DEFAULT conditionFunction <- .isFirstValueSmallerThanSecondValue } else { bounds <- design$futilityBounds criticalValues[is.infinite(criticalValues) & criticalValues > 0] <- C_QNORM_MAXIMUM criticalValues[is.infinite(criticalValues) & criticalValues < 0] <- C_QNORM_MINIMUM border <- C_FUTILITY_BOUNDS_DEFAULT conditionFunction <- .isFirstValueGreaterThanSecondValue } repeatedConfidenceIntervals <- matrix(NA_real_, 2, design$kMax) for (k in (1:stage)) { startTime <- Sys.time() # Finding maximum upper and minimum lower bounds for RCIs thetaLow <- exp(.getUpperLowerThetaSurvival( design = design, dataInput = dataInput, theta = -1, stage = k, directionUpper = TRUE, conditionFunction = conditionFunction, firstParameterName = firstParameterName, secondValue = criticalValues[k] )) thetaUp <- exp(.getUpperLowerThetaSurvival( design = design, dataInput = dataInput, theta = 1, stage = k, directionUpper = FALSE, conditionFunction = conditionFunction, firstParameterName = firstParameterName, secondValue = criticalValues[k] )) # Finding upper and lower RCI limits through root function repeatedConfidenceIntervals[1, k] <- .getRootThetaSurvival( design = design, dataInput = dataInput, stage = k, directionUpper = C_DIRECTION_UPPER_DEFAULT, thetaLow = thetaLow, thetaUp = thetaUp, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance, callingFunctionInformation = paste0("Repeated confidence interval [1, ", k, "]") ) repeatedConfidenceIntervals[2, k] <- .getRootThetaSurvival( design = design, dataInput = dataInput, stage = k, directionUpper = FALSE, thetaLow = thetaLow, thetaUp = thetaUp, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance, callingFunctionInformation = paste0("Repeated confidence interval [2, ", k, "]") ) # Adjustment for binding futility bounds if (k > 1 && conditionFunction(bounds[k - 1], border) & design$bindingFutility) { parameterName <- ifelse(.isTrialDesignFisher(design), "pValues", firstParameterName) futilityCorr[k] <- .getRootThetaSurvival( design = design, dataInput = dataInput, stage = k - 1, directionUpper = directionUpper, thetaLow = thetaLow, thetaUp = thetaUp, firstParameterName = parameterName, secondValue = bounds[k - 1], tolerance = tolerance, callingFunctionInformation = paste0("Repeated confidence interval, futility correction [", k, "]") ) if (directionUpper) { repeatedConfidenceIntervals[1, k] <- min(min(futilityCorr[2:k]), repeatedConfidenceIntervals[1, k]) } else { repeatedConfidenceIntervals[2, k] <- max(max(futilityCorr[2:k]), repeatedConfidenceIntervals[2, k]) } } .logProgress("Repeated confidence interval of stage %s calculated", startTime = startTime, k) if (!is.na(repeatedConfidenceIntervals[1, k]) && !is.na(repeatedConfidenceIntervals[2, k]) && repeatedConfidenceIntervals[1, k] > repeatedConfidenceIntervals[2, k]) { repeatedConfidenceIntervals[, k] <- rep(NA_real_, 2) } } return(repeatedConfidenceIntervals) } # # RCIs based on group sequential method # .getRepeatedConfidenceIntervalsSurvivalGroupSequential <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsSurvivalGroupSequential", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) return(.getRepeatedConfidenceIntervalsSurvivalAll( design = design, dataInput = dataInput, firstParameterName = "overallPValues", directionUpper = directionUpper, tolerance = tolerance, ... )) } # # RCIs based on inverse normal combination test # .getRepeatedConfidenceIntervalsSurvivalInverseNormal <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsSurvivalInverseNormal", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) return(.getRepeatedConfidenceIntervalsSurvivalAll( design = design, dataInput = dataInput, firstParameterName = "combInverseNormal", directionUpper = directionUpper, tolerance = tolerance, ... )) } # # RCIs based on Fisher's combination test # .getRepeatedConfidenceIntervalsSurvivalFisher <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsSurvivalFisher", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) return(.getRepeatedConfidenceIntervalsSurvivalAll( design = design, dataInput = dataInput, firstParameterName = "combFisher", directionUpper = directionUpper, tolerance = tolerance, ... )) } # # Calculation of conditional power based on group sequential method # .getConditionalPowerSurvivalGroupSequential <- function(..., stageResults, stage = stageResults$stage, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, nPlanned = NA_real_, thetaH1 = NA_real_) { design <- stageResults$.design .assertIsTrialDesignGroupSequential(design) .assertIsValidStage(stage, design$kMax) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerSurvivalGroupSequential", ignore = c("design", "stageResultsName"), ... ) kMax <- design$kMax conditionalPower <- rep(NA_real_, kMax) weights <- stageResults$weightsInverseNormal informationRates <- design$informationRates nPlanned <- c(rep(NA, stageResults$stage), nPlanned) if (stageResults$stage == kMax) { .logDebug( "Conditional power will be calculated only for subsequent stages ", "(stage = ", stageResults$stage, ", kMax = ", design$kMax, ")" ) return(list( nPlanned = nPlanned, conditionalPower = conditionalPower )) } criticalValuesInverseNormal <- design$criticalValues .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned if (stageResults$direction == "upper") { thetaH1 <- log(thetaH1 / stageResults$thetaH0) } else { thetaH1 <- -log(thetaH1 / stageResults$thetaH0) } # Shifted decision region for use in getGroupSeqProbs # Group sequential method shiftedDecisionRegionUpper <- criticalValuesInverseNormal[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - c(weights[1:stage] %*% .getOneMinusQNorm(stageResults$pValues[1:stage])) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - thetaH1 * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) if (design$sided == 2) { shiftedDecisionRegionLower <- -criticalValuesInverseNormal[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - .getOneMinusQNorm(stageResults$overallPValues[stage]) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - thetaH1 * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) } if (stage == kMax - 1) { shiftedFutilityBounds <- c() } else { shiftedFutilityBounds <- design$futilityBounds[(stage + 1):(kMax - 1)] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):(kMax - 1)]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - c(weights[1:stage] %*% .getOneMinusQNorm(stageResults$pValues[1:stage])) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - thetaH1 * cumsum(sqrt(nPlanned[(stage + 1):(kMax - 1)]) * weights[(stage + 1):(kMax - 1)]) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) } # Scaled information for use in getGroupSeqProbs scaledInformation <- (informationRates[(stage + 1):kMax] - informationRates[stage]) / (1 - informationRates[stage]) if (design$sided == 2) { decisionMatrix <- matrix(c(shiftedDecisionRegionLower, shiftedDecisionRegionUpper), nrow = 2, byrow = TRUE) } else { decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, shiftedDecisionRegionUpper ), nrow = 2, byrow = TRUE) } probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = scaledInformation ) if (design$twoSidedPower) { conditionalPower[(stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ] + probs[1, ]) } else { conditionalPower[(stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ]) } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned return(list( nPlanned = nPlanned, conditionalPower = conditionalPower )) } # # Calculation of conditional power based on inverse normal method # .getConditionalPowerSurvivalInverseNormal <- function(..., stageResults, stage = stageResults$stage, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, nPlanned = NA_real_, thetaH1 = NA_real_) { design <- stageResults$.design .assertIsTrialDesignInverseNormal(design) .assertIsValidStage(stage, design$kMax) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerSurvivalInverseNormal", ignore = c("design", "stageResultsName"), ... ) kMax <- design$kMax conditionalPower <- rep(NA_real_, kMax) weights <- stageResults$weightsInverseNormal informationRates <- design$informationRates nPlanned <- c(rep(NA, stageResults$stage), nPlanned) if (stageResults$stage == kMax) { .logDebug( "Conditional power will be calculated only for subsequent stages ", "(stage = ", stageResults$stage, ", kMax = ", design$kMax, ")" ) return(list( nPlanned = nPlanned, conditionalPower = conditionalPower )) } criticalValuesInverseNormal <- design$criticalValues .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned if (stageResults$direction == "upper") { thetaH1 <- log(thetaH1 / stageResults$thetaH0) } else { thetaH1 <- -log(thetaH1 / stageResults$thetaH0) } # Shifted decision region for use in getGroupSeqProbs # Inverse normal method shiftedDecisionRegionUpper <- criticalValuesInverseNormal[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - c(weights[1:stage] %*% .getOneMinusQNorm(stageResults$pValues[1:stage])) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - thetaH1 * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) if (design$sided == 2) { shiftedDecisionRegionLower <- -criticalValuesInverseNormal[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - .getOneMinusQNorm(stageResults$overallPValues[stage]) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - thetaH1 * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) } if (stage == kMax - 1) { shiftedFutilityBounds <- c() } else { shiftedFutilityBounds <- design$futilityBounds[(stage + 1):(kMax - 1)] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):(kMax - 1)]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - c(weights[1:stage] %*% .getOneMinusQNorm(stageResults$pValues[1:stage])) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - thetaH1 * cumsum(sqrt(nPlanned[(stage + 1):(kMax - 1)]) * weights[(stage + 1):(kMax - 1)]) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) } # Scaled information for use in getGroupSeqProbs scaledInformation <- (informationRates[(stage + 1):kMax] - informationRates[stage]) / (1 - informationRates[stage]) if (design$sided == 2) { decisionMatrix <- matrix(c(shiftedDecisionRegionLower, shiftedDecisionRegionUpper), nrow = 2, byrow = TRUE) } else { decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, shiftedDecisionRegionUpper ), nrow = 2, byrow = TRUE) } probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = scaledInformation ) if (design$twoSidedPower) { conditionalPower[(stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ] + probs[1, ]) } else { conditionalPower[(stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ]) } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned return(list( nPlanned = nPlanned, conditionalPower = conditionalPower )) } # # Calculation of conditional power based on Fisher combination test # .getConditionalPowerSurvivalFisher <- function(..., stageResults, stage = stageResults$stage, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, nPlanned = NA_real_, thetaH1 = NA_real_, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { design <- stageResults$.design .assertIsTrialDesignFisher(design) .assertIsValidStage(stage, design$kMax) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerSurvivalFisher", ignore = c("design", "piTreatmentRange", "stageResultsName"), ... ) kMax <- design$kMax conditionalPower <- rep(NA_real_, kMax) seed <- .setSeed(seed) simulated <- FALSE nPlanned <- c(rep(NA, stageResults$stage), nPlanned) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned if (stageResults$direction == "upper") { thetaH1 <- log(thetaH1 / stageResults$thetaH0) } else { thetaH1 <- -log(thetaH1 / stageResults$thetaH0) } criticalValues <- design$criticalValues weightsFisher <- stageResults$weightsFisher pValues <- stageResults$pValues if (stageResults$stage < kMax - 1) { for (k in (stageResults$stage + 1):kMax) { reject <- 0 for (i in 1:iterations) { reject <- reject + .getRejectValueConditionalPowerFisher( kMax = kMax, alpha0Vec = design$alpha0Vec, criticalValues = criticalValues, weightsFisher = weightsFisher, pValues = pValues, currentKMax = k, thetaH1 = thetaH1, stage = stageResults$stage, nPlanned = nPlanned ) } conditionalPower[k] <- reject / iterations } simulated <- TRUE } if (stageResults$stage == kMax - 1) { divisor <- prod(pValues[1:(kMax - 1)]^weightsFisher[1:(kMax - 1)]) result <- 1 - (criticalValues[kMax] / divisor)^(1 / weightsFisher[kMax]) if (result <= 0 || result >= 1) { warning("Calculation not possible: could not calculate conditional power for stage ", kMax, call. = FALSE) conditionalPower[kMax] <- NA_real_ } else { conditionalPower[kMax] <- 1 - stats::pnorm(.getQNorm(result) - thetaH1 * sqrt(nPlanned[kMax])) } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned return(list( nPlanned = nPlanned, conditionalPower = conditionalPower, iterations = as.integer(iterations), seed = seed, simulated = simulated )) } .getConditionalPowerSurvival <- function(..., stageResults, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaH1 = NA_real_) { results <- ConditionalPowerResultsSurvival( .stageResults = stageResults, .design = stageResults$.design, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1 ) if (any(is.na(nPlanned))) { return(results) } stage <- stageResults$stage thetaH1 <- .assertIsValidThetaH1(thetaH1, stageResults, stage) .assertIsInOpenInterval(thetaH1, "thetaH1", 0, Inf) if (!.isValidNPlanned(nPlanned = nPlanned, kMax = stageResults$.design$kMax, stage = stage)) { return(results) } if (.isTrialDesignGroupSequential(stageResults$.design)) { cp <- .getConditionalPowerSurvivalGroupSequential( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, ... ) } else if (.isTrialDesignInverseNormal(stageResults$.design)) { cp <- .getConditionalPowerSurvivalInverseNormal( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, ... ) } else if (.isTrialDesignFisher(stageResults$.design)) { cp <- .getConditionalPowerSurvivalFisher( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, ... ) results$iterations <- cp$iterations results$seed <- cp$seed results$simulated <- cp$simulated results$.setParameterType("iterations", ifelse(identical(cp$iterations, C_ITERATIONS_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) seed <- .getOptionalArgument("seed", ...) results$.setParameterType("seed", ifelse(!is.null(seed) && !is.na(seed), C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE )) } else { .stopWithWrongDesignMessage(stageResults$.design) } results$nPlanned <- cp$nPlanned results$conditionalPower <- cp$conditionalPower results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$.setParameterType( "allocationRatioPlanned", ifelse(allocationRatioPlanned == C_ALLOCATION_RATIO_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED) ) results$.setParameterType("thetaH1", ifelse(is.na(thetaH1), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) return(results) } .getConditionalPowerPlotSurvival <- function(..., stageResults, stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaRange) { .assertIsValidAllocationRatioPlanned(allocationRatioPlanned, 2) .associatedArgumentsAreDefined(nPlanned = nPlanned, thetaRange = thetaRange) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerPlotSurvival", ignore = c("iterations", "seed", "stageResultsName", "grid"), ... ) design <- stageResults$.design if (!.isValidNPlanned(nPlanned = nPlanned, kMax = design$kMax, stage = stage)) { return(list( xValues = 0, condPowerValues = 0, likelihoodValues = 0, main = C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, xlab = "Hazard ratio", ylab = C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, sub = "" )) } thetaRange <- .assertIsValidThetaRange(thetaRange = thetaRange, survivalDataEnabled = TRUE) condPowerValues <- rep(NA, length(thetaRange)) likelihoodValues <- rep(NA, length(thetaRange)) warningMessages <- c() withCallingHandlers( for (i in seq(along = thetaRange)) { if (.isTrialDesignGroupSequential(design)) { condPowerValues[i] <- .getConditionalPowerSurvivalGroupSequential( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i] )$conditionalPower[design$kMax] } if (.isTrialDesignInverseNormal(design)) { condPowerValues[i] <- .getConditionalPowerSurvivalInverseNormal( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i] )$conditionalPower[design$kMax] } if (.isTrialDesignFisher(design)) { condPowerValues[i] <- .getConditionalPowerSurvivalFisher( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i] )$conditionalPower[design$kMax] } likelihoodValues[i] <- stats::dnorm( log(thetaRange[i]), log(stageResults$effectSizes[stage]), 2 / sqrt(stageResults$overallEvents[stage]) ) / stats::dnorm(0, 0, 2 / sqrt(stageResults$overallEvents[stage])) }, warning = function(w) { m <- w$message if (!(m %in% warningMessages)) { warningMessages <<- c(warningMessages, m) } invokeRestart("muffleWarning") }, error = function(e) { e } ) if (length(warningMessages) > 0) { for (m in warningMessages) { warning(m, call. = FALSE) } } subtitle <- paste0( "Stage = ", stage, ", maximum number of remaining events = ", sum(nPlanned), ", allocation ratio = ", .formatSubTitleValue(allocationRatioPlanned, "allocationRatioPlanned") ) return(list( xValues = thetaRange, condPowerValues = condPowerValues, likelihoodValues = likelihoodValues, main = C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, xlab = "Hazard ratio", ylab = C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, sub = subtitle )) } # # Calculation of final confidence interval # based on group sequential test without SSR (general case). # .getFinalConfidenceIntervalSurvivalGroupSequential <- function(..., design, dataInput, stage, thetaH0 = C_THETA_H0_SURVIVAL_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { stageResults <- .getStageResultsSurvival( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper ) finalConfidenceIntervalGeneral <- rep(NA_real_, 2) medianUnbiasedGeneral <- NA_real_ stageGroupSeq <- .getStageGroupSeq(design = design, stageResults = stageResults, stage = stage) finalStage <- min(stageGroupSeq, design$kMax) # Early stopping or at end of study if (stageGroupSeq < design$kMax || stage == design$kMax) { if (stageGroupSeq == 1) { finalConfidenceIntervalGeneral[1] <- stageResults$testStatistics[1] - .getOneMinusQNorm(design$alpha / design$sided) finalConfidenceIntervalGeneral[2] <- stageResults$testStatistics[1] + .getOneMinusQNorm(design$alpha / design$sided) medianUnbiasedGeneral <- stageResults$testStatistics[1] } else { finalConfidenceIntervalGeneral[1] <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "overallPValues", case = "finalConfidenceIntervalGeneralLower" ) finalConfidenceIntervalGeneral[2] <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "overallPValues", case = "finalConfidenceIntervalGeneralUpper" ) medianUnbiasedGeneral <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "overallPValues", case = "medianUnbiasedGeneral" ) } } if (is.na(finalConfidenceIntervalGeneral[1]) && (stageGroupSeq > 1)) { finalStage <- NA_integer_ } finalConfidenceInterval <- rep(NA_real_, 2) medianUnbiased <- NA_real_ if (!is.na(finalStage)) { # Retransformation y <- .getStageResultsSurvival( design = design, dataInput = dataInput, stage = finalStage, thetaH0 = thetaH0, directionUpper = directionUpper ) stderr <- (1 + y$overallAllocationRatios[finalStage]) / sqrt(y$overallAllocationRatios[finalStage]) / sqrt(stageResults$overallEvents[finalStage]) directionUpperSign <- ifelse(directionUpper, 1, -1) if (stageGroupSeq == 1) { finalConfidenceInterval <- exp(stderr * finalConfidenceIntervalGeneral) medianUnbiased <- exp(stderr * medianUnbiasedGeneral) } else { finalConfidenceInterval[1] <- exp(finalConfidenceIntervalGeneral[1] * (1 + y$overallAllocationRatios[finalStage]) / sqrt(y$overallAllocationRatios[finalStage]) + directionUpperSign * log(thetaH0)) finalConfidenceInterval[2] <- exp(finalConfidenceIntervalGeneral[2] * (1 + y$overallAllocationRatios[finalStage]) / sqrt(y$overallAllocationRatios[finalStage]) + directionUpperSign * log(thetaH0)) medianUnbiased <- exp(medianUnbiasedGeneral * (1 + y$overallAllocationRatios[finalStage]) / sqrt(y$overallAllocationRatios[finalStage]) + directionUpperSign * log(thetaH0)) } } if (!directionUpper) { medianUnbiasedGeneral <- 1 / medianUnbiasedGeneral finalConfidenceIntervalGeneral <- 1 / finalConfidenceIntervalGeneral if (stageGroupSeq > 1) { medianUnbiased <- 1 / medianUnbiased finalConfidenceInterval <- 1 / finalConfidenceInterval } } return(list( finalStage = finalStage, medianUnbiasedGeneral = medianUnbiasedGeneral, finalConfidenceIntervalGeneral = sort(finalConfidenceIntervalGeneral), medianUnbiased = medianUnbiased, finalConfidenceInterval = sort(finalConfidenceInterval) )) } # # Calculation of final confidence interval # based on inverse normal method, only valid for kMax <= 2 or no SSR. # .getFinalConfidenceIntervalSurvivalInverseNormal <- function(..., design, dataInput, stage, thetaH0 = C_THETA_H0_SURVIVAL_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { stageResults <- .getStageResultsSurvival( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper ) finalConfidenceIntervalGeneral <- rep(NA_real_, 2) medianUnbiasedGeneral <- NA_real_ stageInvNormal <- .getStageInverseNormal(design = design, stageResults = stageResults, stage = stage) finalStage <- min(stageInvNormal, design$kMax) # Early stopping or at end of study if (stageInvNormal < design$kMax || stage == design$kMax) { if (stageInvNormal == 1) { finalConfidenceIntervalGeneral[1] <- stageResults$testStatistics[1] - .getOneMinusQNorm(design$alpha / design$sided) finalConfidenceIntervalGeneral[2] <- stageResults$testStatistics[1] + .getOneMinusQNorm(design$alpha / design$sided) medianUnbiasedGeneral <- stageResults$testStatistics[1] } else { if ((design$kMax > 2) && !.isNoEarlyEfficacy(design)) { message( "Calculation of final confidence interval performed for kMax = ", design$kMax, " (for kMax > 2, it is theoretically shown that it is valid only ", "if no sample size change was performed)" ) } finalConfidenceIntervalGeneral[1] <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "combInverseNormal", case = "finalConfidenceIntervalGeneralLower" ) finalConfidenceIntervalGeneral[2] <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "combInverseNormal", case = "finalConfidenceIntervalGeneralUpper" ) medianUnbiasedGeneral <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "combInverseNormal", case = "medianUnbiasedGeneral" ) } } if (is.na(finalConfidenceIntervalGeneral[1]) && (stageInvNormal > 1)) { finalStage <- NA_integer_ } finalConfidenceInterval <- rep(NA_real_, 2) medianUnbiased <- NA_real_ if (!is.na(finalStage)) { # Retransformation y <- .getStageResultsSurvival( design = design, dataInput = dataInput, stage = finalStage, thetaH0 = thetaH0, directionUpper = directionUpper ) stderr <- (1 + y$overallAllocationRatios[finalStage]) / sqrt(y$overallAllocationRatios[finalStage]) / sqrt(stageResults$overallEvents[finalStage]) directionUpperSign <- ifelse(directionUpper, 1, -1) if (stageInvNormal == 1) { finalConfidenceInterval <- exp(stderr * finalConfidenceIntervalGeneral) medianUnbiased <- exp(stderr * medianUnbiasedGeneral) } else { finalConfidenceInterval[1] <- exp(finalConfidenceIntervalGeneral[1] * (1 + y$overallAllocationRatios[finalStage]) / sqrt(y$overallAllocationRatios[finalStage]) + directionUpperSign * log(thetaH0)) finalConfidenceInterval[2] <- exp(finalConfidenceIntervalGeneral[2] * (1 + y$overallAllocationRatios[finalStage]) / sqrt(y$overallAllocationRatios[finalStage]) + directionUpperSign * log(thetaH0)) medianUnbiased <- exp(medianUnbiasedGeneral * (1 + y$overallAllocationRatios[finalStage]) / sqrt(y$overallAllocationRatios[finalStage]) + directionUpperSign * log(thetaH0)) } } if (!directionUpper) { medianUnbiasedGeneral <- 1 / medianUnbiasedGeneral finalConfidenceIntervalGeneral <- 1 / finalConfidenceIntervalGeneral if (stageInvNormal > 1) { medianUnbiased <- 1 / medianUnbiased finalConfidenceInterval <- 1 / finalConfidenceInterval } } return(list( finalStage = finalStage, medianUnbiasedGeneral = medianUnbiasedGeneral, finalConfidenceIntervalGeneral = sort(finalConfidenceIntervalGeneral), medianUnbiased = medianUnbiased, finalConfidenceInterval = sort(finalConfidenceInterval) )) } # # Calculation of final confidence interval # based on Fisher combination test, only valid for kMax <= 2. # .getFinalConfidenceIntervalSurvivalFisher <- function(..., design, dataInput, stage, thetaH0 = C_THETA_H0_SURVIVAL_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { stageResults <- .getStageResultsSurvival( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper ) stageFisher <- .getStageFisher(design = design, stageResults = stageResults, stage = stage) finalStage <- min(stageFisher, design$kMax) finalConfidenceInterval <- rep(NA_real_, 2) medianUnbiased <- NA_real_ # early stopping or at end of study if (stageFisher < design$kMax || stage == design$kMax) { message( "Calculation of final confidence interval for Fisher's ", "design not implemented yet" ) return(list( finalStage = NA_integer_, medianUnbiased = NA_real_, finalConfidenceInterval = rep(NA_real_, design$kMax) )) } return(list( finalStage = finalStage, medianUnbiased = medianUnbiased, finalConfidenceInterval = finalConfidenceInterval )) } .getFinalConfidenceIntervalSurvival <- function(..., design, dataInput, thetaH0 = NA_real_, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .assertIsValidThetaH0DataInput(thetaH0, dataInput) .warnInCaseOfUnknownArguments( functionName = "getFinalConfidenceIntervalSurvival", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) if (design$kMax == 1) { return(list( finalStage = NA_integer_, medianUnbiasedGeneral = NA_real_, finalConfidenceIntervalGeneral = c(NA_real_, NA_real_), medianUnbiased = NA_real_, finalConfidenceInterval = c(NA_real_) )) } if (is.na(thetaH0)) { thetaH0 <- C_THETA_H0_SURVIVAL_DEFAULT } if (.isTrialDesignGroupSequential(design)) { return(.getFinalConfidenceIntervalSurvivalGroupSequential( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, tolerance = tolerance )) } if (.isTrialDesignInverseNormal(design)) { return(.getFinalConfidenceIntervalSurvivalInverseNormal( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, tolerance = tolerance )) } if (.isTrialDesignFisher(design)) { return(.getFinalConfidenceIntervalSurvivalFisher( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, tolerance = tolerance )) } .stopWithWrongDesignMessage(design) } rpact/R/f_analysis_enrichment.R0000644000175000017500000004244114145656364016430 0ustar nileshnilesh## | ## | *Analysis of enrichment designs with adaptive test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | # # @title # Get Enrichment Analysis Results # # @description # Calculates and returns the analysis results for the specified design and data. # .getAnalysisResultsEnrichment <- function(design, dataInput, ..., intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, thetaH0 = NA_real_, nPlanned = NA_real_) { .assertIsTrialDesignInverseNormalOrFisher(design) .assertIsValidIntersectionTestEnrichment(design, intersectionTest) .assertIsOneSidedDesign(design, designType = "enrichment", engineType = "analysis") stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design, showWarnings = TRUE) .assertIsSingleLogical(directionUpper, "directionUpper") .assertIsValidDataInput(dataInput = dataInput, design = design, stage = stage) on.exit(dataInput$.trim()) .assertIsValidThetaH0DataInput(thetaH0, dataInput) .assertIsValidNPlanned(nPlanned, design$kMax, stage, required = FALSE) if (dataInput$isDatasetMeans()) { if (is.na(thetaH0)) { thetaH0 <- C_THETA_H0_MEANS_DEFAULT } return(.getAnalysisResultsMeansEnrichment( design = design, dataInput = dataInput, intersectionTest = intersectionTest, directionUpper = directionUpper, thetaH0 = thetaH0, nPlanned = nPlanned, stage = stage, ... )) } if (dataInput$isDatasetRates()) { if (is.na(thetaH0)) { thetaH0 <- C_THETA_H0_RATES_DEFAULT } return(.getAnalysisResultsRatesEnrichment( design = design, dataInput = dataInput, intersectionTest = intersectionTest, directionUpper = directionUpper, thetaH0 = thetaH0, nPlanned = nPlanned, stage = stage, ... )) } if (dataInput$isDatasetSurvival()) { if (is.na(thetaH0)) { thetaH0 <- C_THETA_H0_SURVIVAL_DEFAULT } return(.getAnalysisResultsSurvivalEnrichment( design = design, dataInput = dataInput, intersectionTest = intersectionTest, directionUpper = directionUpper, thetaH0 = thetaH0, nPlanned = nPlanned, stage = stage, ... )) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(dataInput), "' is not implemented yet") } # # Get Stage Results # Returns summary statistics and p-values for a given data set and a given enrichment design. # .getStageResultsEnrichment <- function(design, dataInput, ...) { .assertIsTrialDesignInverseNormalOrFisher(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .assertIsValidDataInput(dataInput = dataInput, design = design, stage = stage) on.exit(dataInput$.trim()) if (dataInput$isDatasetMeans()) { return(.getStageResultsMeansEnrichment(design = design, dataInput = dataInput, userFunctionCallEnabled = TRUE, ...)) } if (dataInput$isDatasetRates()) { return(.getStageResultsRatesEnrichment(design = design, dataInput = dataInput, userFunctionCallEnabled = TRUE, ...)) } if (dataInput$isDatasetSurvival()) { return(.getStageResultsSurvivalEnrichment(design = design, dataInput = dataInput, userFunctionCallEnabled = TRUE, ...)) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(dataInput), "' is not supported") } # Get Repeated Confidence Intervals for enrichment case # Calculates and returns the lower and upper limit of the repeated confidence intervals of the trial for enrichment designs. # .getRepeatedConfidenceIntervalsEnrichment <- function(design, dataInput, ...) { .assertIsTrialDesignInverseNormalOrFisher(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .assertIsValidDataInput(dataInput = dataInput, design = design, stage = stage) on.exit(dataInput$.trim()) if (dataInput$isDatasetMeans()) { return(.getRepeatedConfidenceIntervalsMeansEnrichment( design = design, dataInput = dataInput, ... )) } if (dataInput$isDatasetRates()) { return(.getRepeatedConfidenceIntervalsRatesEnrichment( design = design, dataInput = dataInput, ... )) } if (dataInput$isDatasetSurvival()) { return(.getRepeatedConfidenceIntervalsSurvivalEnrichment( design = design, dataInput = dataInput, ... )) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(dataInput), "' is not implemented yet") } # # Get Conditional Power for enrichment case # Calculates and returns the conditional power for enrichment case. # .getConditionalPowerEnrichment <- function(..., stageResults, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT) { .assertIsStageResults(stageResults) if (stageResults$isDatasetMeans()) { if ("assumedStDev" %in% names(list(...))) { warning("For enrichment analysis the argument for assumed standard deviation ", "is named 'assumedStDevs' and not 'assumedStDev'", call. = FALSE ) } return(.getConditionalPowerMeansEnrichment( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... )) } if (stageResults$isDatasetRates()) { return(.getConditionalPowerRatesEnrichment( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... )) } if (stageResults$isDatasetSurvival()) { return(.getConditionalPowerSurvivalEnrichment( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... )) } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(stageResults$.dataInput), "' is not implemented yet" ) } # # Repeated p-values for enrichment designs # .getRepeatedPValuesEnrichment <- function(stageResults, ..., tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments(functionName = "getRepeatedPValuesEnrichment", ...) return(.getRepeatedPValuesMultiArm(stageResults = stageResults, tolerance = tolerance, ...)) } # # Calculation of conditional rejection probability (CRP) # .getConditionalRejectionProbabilitiesEnrichment <- function(stageResults, ..., stage = stageResults$stage, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .assertIsValidStage(stage, stageResults$.design$kMax) gMax <- stageResults$getGMax() if (.isTrialDesignInverseNormal(stageResults$.design)) { return(.getConditionalRejectionProbabilitiesEnrichmentInverseNormal( stageResults = stageResults, stage = stage, ... )) } else if (.isTrialDesignFisher(stageResults$.design)) { return(.getConditionalRejectionProbabilitiesEnrichmentFisher( stageResults = stageResults, stage = stage, ... )) } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of TrialDesignInverseNormal or TrialDesignFisher" ) } # # Calculation of CRP based on inverse normal method # .getConditionalRejectionProbabilitiesEnrichmentInverseNormal <- function(..., stageResults, stage) { design <- stageResults$.design .assertIsTrialDesignInverseNormal(design) .warnInCaseOfUnknownArguments( functionName = ".getConditionalRejectionProbabilitiesEnrichmentInverseNormal", ignore = c("stage", "design"), ... ) kMax <- design$kMax if (kMax == 1) { return(as.matrix(NA_real_)) } gMax <- stageResults$getGMax() conditionalRejectionProbabilities <- matrix(NA_real_, nrow = gMax, ncol = kMax) weights <- .getWeightsInverseNormal(design) informationRates <- design$informationRates ctr <- .performClosedCombinationTest(stageResults = stageResults) criticalValues <- design$criticalValues for (stageIndex in (1:min(stage, kMax - 1))) { for (g in 1:gMax) { if (!is.na(ctr$separatePValues[g, stageIndex])) { # shifted decision region for use in getGroupSeqProbs # Inverse Normal Method shiftedDecisionRegionUpper <- criticalValues[(stageIndex + 1):kMax] * sqrt(sum(weights[1:stageIndex]^2) + cumsum(weights[(stageIndex + 1):kMax]^2)) / sqrt(cumsum(weights[(stageIndex + 1):kMax]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stageIndex], na.rm = TRUE) * sqrt(sum(weights[1:stageIndex]^2)) / sqrt(cumsum(weights[(stageIndex + 1):kMax]^2)) if (stageIndex == kMax - 1) { shiftedFutilityBounds <- c() } else { shiftedFutilityBounds <- design$futilityBounds[(stageIndex + 1):(kMax - 1)] * sqrt(sum(weights[1:stageIndex]^2) + cumsum(weights[(stageIndex + 1):(kMax - 1)]^2)) / sqrt(cumsum(weights[(stageIndex + 1):(kMax - 1)]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stageIndex], na.rm = TRUE) * sqrt(sum(weights[1:stageIndex]^2)) / sqrt(cumsum(weights[(stageIndex + 1):(kMax - 1)]^2)) } # scaled information for use in getGroupSeqProbs scaledInformation <- (informationRates[(stageIndex + 1):kMax] - informationRates[stageIndex]) / (1 - informationRates[stageIndex]) decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, shiftedDecisionRegionUpper ), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = scaledInformation ) conditionalRejectionProbabilities[g, stageIndex] <- sum(probs[3, ] - probs[2, ]) } } } return(conditionalRejectionProbabilities) } # # Calculation of conditional rejection probability based on Fisher's combination test # .getConditionalRejectionProbabilitiesEnrichmentFisher <- function(..., stageResults, stage) { design <- stageResults$.design .assertIsTrialDesignFisher(design) .warnInCaseOfUnknownArguments( functionName = ".getConditionalRejectionProbabilitiesEnrichmentFisher", ignore = c("stage", "design"), ... ) kMax <- design$kMax if (kMax == 1) { return(as.matrix(NA_real_)) } gMax <- stageResults$getGMax() criticalValues <- design$criticalValues weights <- .getWeightsFisher(design) intersectionTest <- stageResults$intersectionTest conditionalRejectionProbabilities <- matrix(NA_real_, nrow = gMax, ncol = kMax) if (design$bindingFutility) { alpha0Vec <- design$alpha0Vec } else { alpha0Vec <- rep(1, kMax - 1) } for (g in 1:gMax) { for (stageIndex in (1:min(stage, kMax - 1))) { if (!is.na(stageResults$separatePValues[g, stageIndex])) { if (gMax == 1) { pValues <- stageResults$separatePValues[1, 1:stageIndex] } else { ctr <- .performClosedCombinationTest( stageResults = stageResults, design = design, intersectionTest = intersectionTest ) pValues <- ctr$adjustedStageWisePValues[ctr$indices[, g] == 1, ][which.max( ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stageIndex] ), 1:stageIndex] } if (prod(pValues^weights[1:stageIndex]) <= criticalValues[stageIndex]) { conditionalRejectionProbabilities[g, stageIndex] <- 1 } else { if (stageIndex < kMax - 1) { conditionalRejectionProbabilities[g, stageIndex] <- .getFisherCombinationSize( kMax - stageIndex, alpha0Vec[(stageIndex + 1):(kMax - 1)], (criticalValues[(stageIndex + 1):kMax] / prod(pValues^weights[1:stageIndex]))^(1 / weights[stageIndex + 1]), weights[(stageIndex + 2):kMax] / weights[stageIndex + 1] ) } else { conditionalRejectionProbabilities[g, stageIndex] <- (criticalValues[kMax] / prod(pValues^weights[1:stageIndex]))^(1 / weights[kMax]) } } if (design$bindingFutility) { if (pValues[stageIndex] > alpha0Vec[stageIndex]) { conditionalRejectionProbabilities[g, stageIndex:stage] <- 0 break } } } } } conditionalRejectionProbabilities[conditionalRejectionProbabilities >= 1] <- 1 conditionalRejectionProbabilities[conditionalRejectionProbabilities < 0] <- NA_real_ return(conditionalRejectionProbabilities) } # # Plotting conditional power and likelihood # .getConditionalPowerPlotEnrichment <- function(stageResults, ..., nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaRange = NA_real_, assumedStDevs = NA_real_, piTreatmentRange = NA_real_, piControls = NA_real_, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_, showArms = NA_real_) { .stopInCaseOfIllegalStageDefinition2(...) kMax <- stageResults$.design$kMax stage <- stageResults$stage if (stage == kMax && length(nPlanned) > 0) { stage <- kMax - 1 } if (stage < 1 || kMax == 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot plot conditional power of a fixed design") } if (stage >= kMax) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the conditional power plot is only available for subsequent stages. ", "Please specify a 'stage' (", stage, ") < 'kMax' (", kMax, ")" ) } .assertIsValidNPlanned(nPlanned = nPlanned, kMax = kMax, stage = stage) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) if (stageResults$isDatasetMeans()) { .warnInCaseOfUnusedArgument(piTreatmentRange, "piTreatmentRange", NA_real_, "plot") .warnInCaseOfUnusedArgument(piControls, "piControls", NA_real_, "plot") return(.getConditionalPowerLikelihoodMeansEnrichment( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaRange = thetaRange, assumedStDevs = assumedStDevs, iterations = iterations, seed = seed )) } else if (stageResults$isDatasetRates()) { .warnInCaseOfUnusedArgument(thetaRange, "thetaRange", NA_real_, "plot") .warnInCaseOfUnusedArgument(assumedStDevs, "assumedStDevs", NA_real_, "plot") return(.getConditionalPowerLikelihoodRatesEnrichment( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, piTreatmentRange = piTreatmentRange, piControls = piControls, iterations = iterations, seed = seed )) } else if (stageResults$isDatasetSurvival()) { .warnInCaseOfUnusedArgument(piTreatmentRange, "piTreatmentRange", NA_real_, "plot") .warnInCaseOfUnusedArgument(piControls, "piControls", NA_real_, "plot") .warnInCaseOfUnusedArgument(assumedStDevs, "assumedStDevs", NA_real_, "plot") return(.getConditionalPowerLikelihoodSurvivalEnrichment( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaRange = thetaRange, iterations = iterations, seed = seed )) } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(stageResults$.dataInput), "' is not implemented yet" ) } rpact/R/class_core_plot_settings.R0000644000175000017500000005607414156402621017151 0ustar nileshnilesh## | ## | *Plot setting classes* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5663 $ ## | Last changed: $Date: 2021-12-15 16:11:12 +0100 (Mi, 15 Dez 2021) $ ## | Last changed by: $Author: pahlke $ ## | PlotSubTitleItem <- setRefClass("PlotSubTitleItem", fields = list( title = "character", subscript = "character", value = "numeric" ), methods = list( initialize = function(..., title, subscript = NA_character_, value) { callSuper(title = trimws(title), subscript = trimws(subscript), value = value, ...) }, show = function() { cat(toString(), "\n") }, toQuote = function() { if (!is.null(subscript) && length(subscript) == 1 && !is.na(subscript)) { return(bquote(' '*.(title)[.(subscript)] == .(value))) } return(bquote(' '*.(title) == .(value))) }, toString = function() { valueStr <- value if (is.numeric(value)) { valueStr <- round(value, 3) } if (!is.null(subscript) && length(subscript) == 1 && !is.na(subscript)) { if (grepl("^(\\d+)|max|min$", subscript)) { return(paste0(title, "_", subscript, " = ", valueStr)) } return(paste0(title, "(", trimws(subscript), ") = ", valueStr)) } return(paste(title, "=", valueStr)) } ) ) PlotSubTitleItems <- setRefClass("PlotSubTitleItems", fields = list( title = "character", subtitle = "character", items = "list" ), methods = list( initialize = function(...) { callSuper(...) items <<- list() }, show = function() { cat(title, "\n") if (length(subtitle) == 1 && !is.na(subtitle)) { cat(subtitle, "\n") } s <- toString() if (length(s) == 1 && !is.na(s) && nchar(s) > 0) { cat(s, "\n") } }, addItem = function(item) { items <<- c(items, item) }, add = function(title, value, subscript = NA_character_) { titleTemp <- title if (length(items) == 0) { titleTemp <- .firstCharacterToUpperCase(titleTemp) } titleTemp <- paste0(' ', titleTemp) if (length(subscript) == 1 && !is.na(subscript)) { subscript <- paste0(as.character(subscript), ' ') } else { titleTemp <- paste0(titleTemp, ' ') } addItem(PlotSubTitleItem(title = titleTemp, subscript = subscript, value = value)) }, toString = function() { if (is.null(items) || length(items) == 0) { return(NA_character_) } s <- character(0) for (item in items) { s <- c(s, item$toString()) } return(paste0(s, collapse = ", ")) }, toHtml = function() { htmlStr <- title if (length(subtitle) == 1 && !is.na(subtitle)) { htmlStr <- paste0(htmlStr, '
', subtitle, '') } s <- toString() if (length(s) == 1 && !is.na(s) && nchar(s) > 0) { htmlStr <- paste0(htmlStr, '
', s, '') } return(htmlStr) }, toQuote = function() { quotedItems <- .getQuotedItems() if (is.null(quotedItems)) { if (length(subtitle) > 0) { return(bquote(atop(bold(.(title)), atop(.(subtitle))))) } return(title) } if (length(subtitle) > 0) { return(bquote(atop(bold(.(title)), atop(.(subtitle)*','~.(quotedItems))))) } return(bquote(atop(bold(.(title)), atop(.(quotedItems))))) }, .getQuotedItems = function() { item1 <- NULL item2 <- NULL item3 <- NULL item4 <- NULL if (length(items) > 0) { item1 <- items[[1]] } if (length(items) > 1) { item2 <- items[[2]] } if (length(items) > 2) { item3 <- items[[3]] } if (length(items) > 3) { item4 <- items[[4]] } if (!is.null(item1) && !is.null(item2) && !is.null(item3) && !is.null(item4)) { if (length(item1$subscript) == 1 && !is.na(item1$subscript) && length(item2$subscript) == 1 && !is.na(item2$subscript)) { return(bquote(' '*.(item1$title)[.(item1$subscript)] == .(item1$value)*','~.(item2$title)[.(item2$subscript)] == .(item2$value)*','~.(item3$title) == .(item3$value)*','~.(item4$title) == .(item4$value)*'')) } if (length(item1$subscript) == 1 && !is.na(item1$subscript)) { return(bquote(' '*.(item1$title)[.(item1$subscript)] == .(item1$value)*','~.(item2$title) == .(item2$value)*','~.(item3$title) == .(item3$value)*','~.(item4$title) == .(item4$value)*'')) } if (length(item2$subscript) == 1 && !is.na(item2$subscript)) { return(bquote(' '*.(item1$title) == .(item1$value)*','~.(item2$title)[.(item2$subscript)] == .(item2$value)*','~.(item3$title) == .(item3$value)*','~.(item4$title) == .(item4$value)*'')) } return(bquote(' '*.(item1$title) == .(item1$value)*','~.(item2$title) == .(item2$value)*','~.(item3$title) == .(item3$value)*','~.(item4$title) == .(item4$value)*'')) } if (!is.null(item1) && !is.null(item2) && !is.null(item3)) { if (length(item1$subscript) == 1 && !is.na(item1$subscript) && length(item2$subscript) == 1 && !is.na(item2$subscript)) { return(bquote(' '*.(item1$title)[.(item1$subscript)] == .(item1$value)*','~.(item2$title)[.(item2$subscript)] == .(item2$value)*','~.(item3$title) == .(item3$value)*'')) } if (length(item1$subscript) == 1 && !is.na(item1$subscript)) { return(bquote(' '*.(item1$title)[.(item1$subscript)] == .(item1$value)*','~.(item2$title) == .(item2$value)*','~.(item3$title) == .(item3$value)*'')) } if (length(item2$subscript) == 1 && !is.na(item2$subscript)) { return(bquote(' '*.(item1$title) == .(item1$value)*','~.(item2$title)[.(item2$subscript)] == .(item2$value)*','~.(item3$title) == .(item3$value)*'')) } return(bquote(' '*.(item1$title) == .(item1$value)*','~.(item2$title) == .(item2$value)*','~.(item3$title) == .(item3$value)*'')) } if (!is.null(item1) && !is.null(item2)) { if (length(item1$subscript) == 1 && !is.na(item1$subscript) && length(item2$subscript) == 1 && !is.na(item2$subscript)) { return(bquote(' '*.(item1$title)[.(item1$subscript)] == .(item1$value)*','~.(item2$title)[.(item2$subscript)] == .(item2$value)*'')) } if (length(item1$subscript) == 1 && !is.na(item1$subscript)) { return(bquote(' '*.(item1$title)[.(item1$subscript)] == .(item1$value)*','~.(item2$title) == .(item2$value)*'')) } if (length(item2$subscript) == 1 && !is.na(item2$subscript)) { return(bquote(' '*.(item1$title) == .(item1$value)*','~.(item2$title)[.(item2$subscript)] == .(item2$value)*'')) } return(bquote(' '*.(item1$title) == .(item1$value)*','~.(item2$title) == .(item2$value)*'')) } if (!is.null(item1)) { if (length(item1$subscript) == 1 && !is.na(item1$subscript)) { return(bquote(' '*.(item1$title)[.(item1$subscript)] == .(item1$value)*'')) } return(bquote(' '*.(item1$title) == .(item1$value)*'')) } return(NULL) } ) ) #' #' @title #' Get Plot Settings #' #' @description #' Returns a plot settings object. #' #' @param lineSize The line size, default is \code{0.8}. #' @param pointSize The point size, default is \code{3}. #' @param pointColor The point color (character), default is \code{NA_character_}. #' @param mainTitleFontSize The main title font size, default is \code{14}. #' @param axesTextFontSize The axes text font size, default is \code{10}. #' @param legendFontSize The legend font size, default is \code{11}. #' @param scalingFactor The scaling factor, default is \code{1}. #' #' @details #' Returns an object of class \code{PlotSettings} that collects typical plot settings. #' #' @export #' #' @keywords internal #' getPlotSettings <- function( lineSize = 0.8, pointSize = 3, pointColor = NA_character_, mainTitleFontSize = 14, axesTextFontSize = 10, legendFontSize = 11, scalingFactor = 1) { return(PlotSettings(lineSize = lineSize, pointSize = pointSize, pointColor = pointColor, mainTitleFontSize = mainTitleFontSize, axesTextFontSize = axesTextFontSize, legendFontSize = legendFontSize, scalingFactor = scalingFactor)) } #' #' @name PlotSettings #' #' @title #' Plot Settings #' #' @description #' Class for plot settings. #' #' @field lineSize The line size. #' @field pointSize The point size. #' @field pointColor The point color, e.g., "red" or "blue". #' @field mainTitleFontSize The main tile font size. #' @field axesTextFontSize The text font size. #' @field legendFontSize The legend font size. #' @field scalingFactor The scaling factor. #' #' @details #' Collects typical plot settings in an object. #' #' @keywords internal #' #' @include class_core_parameter_set.R #' #' @importFrom methods new #' PlotSettings <- setRefClass("PlotSettings", contains = "ParameterSet", fields = list( .legendLineBreakIndex = "numeric", .pointSize = "numeric", .legendFontSize = "numeric", .htmlTitle = "character", lineSize = "numeric", pointSize = "numeric", pointColor = "character", mainTitleFontSize = "numeric", axesTextFontSize = "numeric", legendFontSize = "numeric", scalingFactor = "numeric" ), methods = list( initialize = function( lineSize = 0.8, pointSize = 3, pointColor = NA_character_, mainTitleFontSize = 14, axesTextFontSize = 10, legendFontSize = 11, scalingFactor = 1, ...) { callSuper( lineSize = lineSize, pointSize = pointSize, pointColor = pointColor, mainTitleFontSize = mainTitleFontSize, axesTextFontSize = axesTextFontSize, legendFontSize = legendFontSize, scalingFactor = scalingFactor, ...) .legendLineBreakIndex <<- 15 .pointSize <<- pointSize .legendFontSize <<- legendFontSize .htmlTitle <<- NA_character_ .parameterNames <<- list( "lineSize" = "Line size", "pointSize" = "Point size", "pointColor" = "Point color", "mainTitleFontSize" = "Main title font size", "axesTextFontSize" = "Axes text font size", "legendFontSize" = "Legend font size", "scalingFactor" = "Scaling factor" ) }, clone = function() { return(PlotSettings( lineSize = .self$lineSize, pointSize = .self$pointSize, pointColor = .self$pointColor, mainTitleFontSize = .self$mainTitleFontSize, axesTextFontSize = .self$axesTextFontSize, legendFontSize = .self$legendFontSize, scalingFactor = .self$scalingFactor )) }, show = function(showType = 1, digits = NA_integer_) { .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { 'Method for automatically printing plot setting objects' .resetCat() .showParametersOfOneGroup(parameters = .getVisibleFieldNames(), title = "Plot settings", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) }, setColorPalette = function(p, palette, mode = c("colour", "fill", "all")) { "Sets the color palette" mode <- match.arg(mode) # l = 45: make colors slightly darker if (is.null(palette) || is.na(palette)) { if (mode %in% c("colour", "all")) { p <- p + ggplot2::scale_colour_hue(l = 45) } if (mode %in% c("fill", "all")) { p <- p + ggplot2::scale_fill_hue(l = 45) } } else if (is.character(palette)) { if (mode %in% c("colour", "all")) { p <- p + ggplot2::scale_colour_brewer(palette = palette) } if (mode %in% c("fill", "all")) { p <- p + ggplot2::scale_fill_brewer(palette = palette) } } else if (palette == 0) { if (mode %in% c("colour", "all")) { p <- p + ggplot2::scale_colour_grey() } if (mode %in% c("fill", "all")) { p <- p + ggplot2::scale_fill_grey() } } else { if (mode %in% c("colour", "all")) { p <- p + ggplot2::scale_colour_hue(l = 45) } if (mode %in% c("fill", "all")) { p <- p + ggplot2::scale_fill_hue(l = 45) } } return(p) }, enlargeAxisTicks = function(p) { "Enlarges the axis ticks" p <- p + ggplot2::theme(axis.ticks.length = ggplot2::unit(scaleSize(0.3), "cm")) return(p) }, setAxesAppearance = function(p) { "Sets the font size and face of the axes titles and texts" p <- p + ggplot2::theme(axis.title.x = ggplot2::element_text(size = scaleSize(.self$axesTextFontSize + 1), face = "bold")) p <- p + ggplot2::theme(axis.title.y = ggplot2::element_text(size = scaleSize(.self$axesTextFontSize + 1), face = "bold")) p <- p + ggplot2::theme(axis.text.x = ggplot2::element_text(size = scaleSize(.self$axesTextFontSize))) p <- p + ggplot2::theme(axis.text.y = ggplot2::element_text(size = scaleSize(.self$axesTextFontSize))) return(p) }, # Sets the axes labels setAxesLabels = function(p, xAxisLabel = NULL, yAxisLabel1 = NULL, yAxisLabel2 = NULL, xlab = NA_character_, ylab = NA_character_, scalingFactor1 = 1, scalingFactor2 = 1) { if (is.null(xAxisLabel) && !is.na(xlab)) { xAxisLabel <- xlab } plotLabsType <- getOption("rpact.plot.labs.type", "quote") if (plotLabsType == "quote" && !is.null(xAxisLabel)) { if (xAxisLabel == "Theta") { xAxisLabel <- bquote(bold("Theta"~Theta)) } else if (xAxisLabel == "pi1") { xAxisLabel <- bquote(bold('pi'['1'])) } else if (xAxisLabel == "pi2") { xAxisLabel <- bbquote(bold('pi'['2'])) } else if (xAxisLabel == "Theta") { xAxisLabel <- bquote(bold("Theta"~Theta)) } } p <- p + ggplot2::xlab(xAxisLabel) if (sum(is.na(ylab)) == 0) { yAxisLabel1 = ylab[1] if (length(ylab) == 2) { yAxisLabel2 = ylab[2] } } p <- p + ggplot2::ylab(yAxisLabel1) p <- setSecondYAxisOnRightSide(p, yAxisLabel1, yAxisLabel2, scalingFactor1, scalingFactor2) return(p) }, setSecondYAxisOnRightSide = function(p, yAxisLabel1, yAxisLabel2, scalingFactor1 = 1, scalingFactor2 = 1) { if (!is.null(yAxisLabel2) && scalingFactor1 != scalingFactor2) { p <- p + ggplot2::scale_y_continuous(yAxisLabel1, sec.axis = ggplot2::sec_axis(~ . * scalingFactor1 / scalingFactor2, name = yAxisLabel2)) } return(p) }, setLegendTitle = function(p, legendTitle, mode = c("colour", "fill")) { mode <- match.arg(mode) if (!is.null(legendTitle) && !is.na(legendTitle) && trimws(legendTitle) != "") { if (mode == "colour") { p <- p + ggplot2::labs(colour = .getTextLineWithLineBreak(legendTitle, lineBreakIndex = scaleSize(.legendLineBreakIndex))) } else { p <- p + ggplot2::labs(fill = .getTextLineWithLineBreak(legendTitle, lineBreakIndex = scaleSize(.legendLineBreakIndex))) } p <- p + ggplot2::theme(legend.title = ggplot2::element_text( colour = "black", size = scaleSize(.self$legendFontSize + 1), face = "bold")) } else { p <- p + ggplot2::theme(legend.title = ggplot2::element_blank()) p <- p + ggplot2::labs(colour = NULL) } return(p) }, setLegendLabelSize = function(p) { p <- p + ggplot2::theme(legend.text = ggplot2::element_text(size = scaleSize(.self$legendFontSize))) return(p) }, setLegendPosition = function(p, legendPosition) { .assertIsValidLegendPosition(legendPosition) switch(as.character(legendPosition), '-1' = { p <- p + ggplot2::theme(legend.position = "none") }, '0' = { p <- p + ggplot2::theme(aspect.ratio = 1) }, '1' = { p <- p + ggplot2::theme(legend.position = c(0.05, 1), legend.justification = c(0, 1)) }, '2' = { p <- p + ggplot2::theme(legend.position = c(0.05, 0.5), legend.justification = c(0, 0.5)) }, '3' = { p <- p + ggplot2::theme(legend.position = c(0.05, 0.05), legend.justification = c(0, 0)) }, '4' = { p <- p + ggplot2::theme(legend.position = c(0.95, 1), legend.justification = c(1, 1)) }, '5' = { p <- p + ggplot2::theme(legend.position = c(0.95, 0.5), legend.justification = c(1, 0.5)) }, '6' = { p <- p + ggplot2::theme(legend.position = c(0.95, 0.05), legend.justification = c(1, 0)) } ) return(p) }, setLegendBorder = function(p) { "Sets the legend border" p <- p + ggplot2::theme(legend.background = ggplot2::element_rect(fill = "white", colour = "black", size = scaleSize(0.4))) return(p) }, adjustPointSize = function(adjustingValue) { .assertIsInClosedInterval(adjustingValue, "adjustingValue", lower = 0.1, upper = 2) pointSize <<- .self$.pointSize * adjustingValue }, adjustLegendFontSize = function(adjustingValue) { "Adjusts the legend font size, e.g., run \\cr \\code{adjustLegendFontSize(-2)} # makes the font size 2 points smaller" .assertIsInClosedInterval(adjustingValue, "adjustingValue", lower = 0.1, upper = 2) legendFontSize <<- .self$.legendFontSize * adjustingValue }, scaleSize = function(size, pointEnabled = FALSE) { if (pointEnabled) { return(size * .self$scalingFactor^2) } return(size * .self$scalingFactor) }, setMainTitle = function(p, mainTitle, subtitle = NA_character_) { "Sets the main title" caption <- NA_character_ if (!is.null(mainTitle) && inherits(mainTitle, "PlotSubTitleItems")) { plotLabsType <- getOption("rpact.plot.labs.type", "quote") if (plotLabsType == "quote") { mainTitle <- mainTitle$toQuote() } else { items <- mainTitle mainTitle <- items$title if (length(items$subtitle) == 1 && !is.na(items$subtitle)) { if (length(subtitle) == 1 && !is.na(subtitle)) { subtitle <- paste0(subtitle, ", ", items$subtitle) } else { subtitle <- items$subtitle } } s <- items$toString() if (length(s) == 1 && !is.na(s) && nchar(s) > 0) { plotLabsCaptionEnabled <- as.logical(getOption("rpact.plot.labs.caption.enabled", "true")) if (isTRUE(plotLabsCaptionEnabled)) { caption <- s } else { if (length(subtitle) == 1 && !is.na(subtitle)) { subtitle <- paste0(subtitle, ", ", s) } else { subtitle <- s } } } if (plotLabsType == "html") { .htmlTitle <<- items$toHtml() } } } subtitleFontSize <- NA_real_ if (length(subtitle) == 1 && !is.na(subtitle)) { if (is.na(caption)) { caption <- ggplot2::waiver() } p <- p + ggplot2::labs(title = mainTitle, subtitle = subtitle, caption = caption) targetWidth = 130 subtitleFontSize <- targetWidth / nchar(subtitle) * 8 if (subtitleFontSize > scaleSize(.self$mainTitleFontSize) - 2) { subtitleFontSize <- scaleSize(.self$mainTitleFontSize) - 2 } } else if (length(caption) == 1 && !is.na(caption)) { p <- p + ggplot2::labs(title = mainTitle, caption = caption) } else { p <- p + ggplot2::ggtitle(mainTitle) } p <- p + ggplot2::theme(plot.title = ggplot2::element_text( hjust = 0.5, size = scaleSize(.self$mainTitleFontSize), face = "bold")) if (!is.na(subtitleFontSize)) { p <- p + ggplot2::theme( plot.subtitle = ggplot2::element_text(hjust = 0.5, size = scaleSize(subtitleFontSize))) } return(p) }, setMarginAroundPlot = function(p, margin = 0.2) { "Sets the margin around the plot, e.g., run \\cr \\code{setMarginAroundPlot(p, .2)} or \\cr \\code{setMarginAroundPlot(p, c(.1, .2, .1, .2)}" if (length(margin == 1)) { margin = base::rep(margin, 4) } if (!(length(margin) %in% c(1, 4))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'margin' (", .arrayToString(margin), ") must be a numeric vector with length 1 or 4") } p <- p + ggplot2::theme(plot.margin = ggplot2::unit(margin, "cm")) return(p) }, expandAxesRange = function(p, x = NA_real_, y = NA_real_) { "Expands the axes range" if (!is.na(x)) { p <- p + ggplot2::expand_limits(x = x) } if (!is.na(y)) { p <- p + ggplot2::expand_limits(y = y) } return(p) }, hideGridLines = function(p) { "Hides the grid lines" p <- p + ggplot2::theme(panel.grid.major.x = ggplot2::element_blank()) p <- p + ggplot2::theme(panel.grid.minor.x = ggplot2::element_blank()) p <- p + ggplot2::theme(panel.grid.major.y = ggplot2::element_blank()) p <- p + ggplot2::theme(panel.grid.minor.y = ggplot2::element_blank()) return(p) }, setTheme = function(p) { "Sets the theme" p <- p + ggplot2::theme_bw() p <- p + ggplot2::theme(panel.border = ggplot2::element_blank(), axis.line = ggplot2::element_line(colour = "black")) return(p) }, plotPoints = function(p, pointBorder, ..., mapping = NULL) { # plot white border around the points if (pointBorder > 0) { p <- p + ggplot2::geom_point(mapping = mapping, color = "white", size = scaleSize(.self$pointSize, TRUE), alpha = 1, shape = 21, stroke = pointBorder / 2.25, show.legend = FALSE) } if (!is.null(.self$pointColor) && length(.self$pointColor) == 1 && !is.na(.self$pointColor)) { p <- p + ggplot2::geom_point(mapping = mapping, color = .self$pointColor, size = scaleSize(.self$pointSize, TRUE), alpha = 1, shape = 19, show.legend = FALSE) } else { p <- p + ggplot2::geom_point(mapping = mapping, size = scaleSize(.self$pointSize, TRUE), alpha = 1, shape = 19, show.legend = FALSE) } return(p) }, plotValues = function(p, ..., plotLineEnabled = TRUE, plotPointsEnabled = TRUE, pointBorder = 4) { if (plotLineEnabled) { p <- p + ggplot2::geom_line(size = scaleSize(.self$lineSize)) } if (plotPointsEnabled) { p <- plotPoints(p, pointBorder) } return(p) }, mirrorYValues = function(p, yValues, plotLineEnabled = TRUE, plotPointsEnabled = TRUE, pointBorder = 4) { if (plotLineEnabled) { p <- p + ggplot2::geom_line(ggplot2::aes(y = -yValues), size = scaleSize(.self$lineSize)) } if (plotPointsEnabled) { p <- plotPoints(p, pointBorder, mapping = ggplot2::aes(y = -yValues)) } return(p) }, addCompanyAnnotation = function(p, enabled = TRUE) { if (!enabled) { return(p) } label <- "www.rpact.org" p <- p + ggplot2::annotate("label", x = -Inf, y = Inf, hjust = -0.1, vjust=1, label = label, size = scaleSize(2.8), colour = "white", fill = "white") p <- p + ggplot2::annotate("text", x = -Inf, y = Inf, label = label, hjust=-.12, vjust=1, colour = "lightgray", size = scaleSize(2.7)) return(p) } ) ) rpact/R/f_simulation_multiarm_means.R0000644000175000017500000007274314150167045017647 0ustar nileshnilesh ## | ## | *Simulation of multi-arm design with continuous data* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5594 $ ## | Last changed: $Date: 2021-11-26 15:24:35 +0100 (Fr, 26 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include f_simulation_multiarm.R NULL .getSimulationMeansMultiArmStageSubjects <- function(..., stage, conditionalPower, conditionalCriticalValue, plannedSubjects, allocationRatioPlanned, selectedArms, thetaH1, overallEffects, stDevH1, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage) { stage <- stage - 1 # to be consistent with non-multiarm situation gMax <- nrow(overallEffects) if (!is.na(conditionalPower)) { if (any(selectedArms[1:gMax, stage + 1], na.rm = TRUE)) { if (is.na(thetaH1)) { thetaStandardized <- max(min(overallEffects[ selectedArms[1:gMax, stage + 1], stage ] / stDevH1, na.rm = TRUE), 1e-07) } else { thetaStandardized <- max(thetaH1 / stDevH1, 1e-07) } if (conditionalCriticalValue[stage] > 8) { newSubjects <- maxNumberOfSubjectsPerStage[stage + 1] } else { newSubjects <- (1 + allocationRatioPlanned) * (max(0, conditionalCriticalValue[stage] + .getQNorm(conditionalPower)))^2 / thetaStandardized^2 newSubjects <- min( max(minNumberOfSubjectsPerStage[stage + 1], newSubjects), maxNumberOfSubjectsPerStage[stage + 1] ) } } else { newSubjects <- 0 } } else { newSubjects <- plannedSubjects[stage + 1] - plannedSubjects[stage] } return(newSubjects) } .getSimulatedStageMeansMultiArm <- function(..., design, muVector, stDev, plannedSubjects, typeOfSelection, effectMeasure, adaptations, epsilonValue, rValue, threshold, allocationRatioPlanned, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage, conditionalPower, thetaH1, stDevH1, calcSubjectsFunction, calcSubjectsFunctionIsUserDefined, selectArmsFunction) { kMax <- length(plannedSubjects) gMax <- length(muVector) simMeans <- matrix(NA_real_, nrow = gMax + 1, ncol = kMax) overallEffects <- matrix(NA_real_, nrow = gMax, ncol = kMax) subjectsPerStage <- matrix(NA_real_, nrow = gMax + 1, ncol = kMax) testStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallTestStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) separatePValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) conditionalCriticalValue <- rep(NA_real_, kMax - 1) conditionalPowerPerStage <- rep(NA_real_, kMax) selectedArms <- matrix(FALSE, nrow = gMax + 1, ncol = kMax) selectedArms[, 1] <- TRUE adjustedPValues <- rep(NA_real_, kMax) if (.isTrialDesignFisher(design)) { weights <- .getWeightsFisher(design) } else if (.isTrialDesignInverseNormal(design)) { weights <- .getWeightsInverseNormal(design) } for (k in 1:kMax) { if (k == 1) { subjectsPerStage[gMax + 1, k] <- plannedSubjects[k] / allocationRatioPlanned } else { subjectsPerStage[gMax + 1, k] <- (plannedSubjects[k] - plannedSubjects[k - 1]) / allocationRatioPlanned } if (subjectsPerStage[gMax + 1, k] > 0) { simMeans[gMax + 1, k] <- stats::rnorm(1, 0, stDev / sqrt(subjectsPerStage[gMax + 1, k])) } for (treatmentArm in 1:gMax) { if (selectedArms[treatmentArm, k]) { if (k == 1) { subjectsPerStage[treatmentArm, k] <- plannedSubjects[k] } else { subjectsPerStage[treatmentArm, k] <- plannedSubjects[k] - plannedSubjects[k - 1] } if (subjectsPerStage[treatmentArm, k] > 0) { simMeans[treatmentArm, k] <- stats::rnorm( 1, muVector[treatmentArm], stDev / sqrt(subjectsPerStage[treatmentArm, k]) ) testStatistics[treatmentArm, k] <- (simMeans[treatmentArm, k] - simMeans[gMax + 1, k]) / (stDev * sqrt(1 / subjectsPerStage[treatmentArm, k] + 1 / subjectsPerStage[gMax + 1, k])) } overallEffects[treatmentArm, k] <- subjectsPerStage[treatmentArm, 1:k] %*% simMeans[treatmentArm, 1:k] / sum(subjectsPerStage[treatmentArm, 1:k]) - subjectsPerStage[gMax + 1, 1:k] %*% simMeans[gMax + 1, 1:k] / sum(subjectsPerStage[gMax + 1, 1:k]) overallTestStatistics[treatmentArm, k] <- overallEffects[treatmentArm, k] / (stDev * sqrt(1 / sum(subjectsPerStage[treatmentArm, 1:k]) + 1 / sum(subjectsPerStage[gMax + 1, 1:k]))) separatePValues[treatmentArm, k] <- 1 - stats::pnorm(testStatistics[treatmentArm, k]) } } if (k < kMax) { if (colSums(selectedArms)[k] == 1) { break } # Bonferroni adjustment adjustedPValues[k] <- min(min(separatePValues[, k], na.rm = TRUE) * (colSums(selectedArms)[k] - 1), 1 - 1e-7) # conditional critical value to reject the null hypotheses at the next stage of the trial if (.isTrialDesignConditionalDunnett(design)) { conditionalCriticalValue[k] <- (.getOneMinusQNorm(design$alpha) - .getOneMinusQNorm(adjustedPValues[k]) * sqrt(design$informationAtInterim)) / sqrt(1 - design$informationAtInterim) } else { if (.isTrialDesignFisher(design)) { conditionalCriticalValue[k] <- .getOneMinusQNorm(min((design$criticalValues[k + 1] / prod(adjustedPValues[1:k]^weights[1:k]))^(1 / weights[k + 1]), 1 - 1e-7)) } else { conditionalCriticalValue[k] <- (design$criticalValues[k + 1] * sqrt(design$informationRates[k + 1]) - .getOneMinusQNorm(adjustedPValues[1:k]) %*% weights[1:k]) / sqrt(design$informationRates[k + 1] - design$informationRates[k]) } } if (adaptations[k]) { if (effectMeasure == "testStatistic") { selectedArms[, k + 1] <- (selectedArms[, k] & .selectTreatmentArms( k, overallTestStatistics[, k], typeOfSelection, epsilonValue, rValue, threshold, selectArmsFunction )) } else if (effectMeasure == "effectEstimate") { selectedArms[, k + 1] <- (selectedArms[, k] & .selectTreatmentArms( k, overallEffects[, k], typeOfSelection, epsilonValue, rValue, threshold, selectArmsFunction )) } newSubjects <- calcSubjectsFunction( stage = k + 1, # to be consistent with non-multiarm situation, cf. line 37 conditionalPower = conditionalPower, conditionalCriticalValue = conditionalCriticalValue, plannedSubjects = plannedSubjects, allocationRatioPlanned = allocationRatioPlanned, selectedArms = selectedArms, thetaH1 = thetaH1, stDevH1 = stDevH1, overallEffects = overallEffects, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage ) if (is.null(newSubjects) || length(newSubjects) != 1 || !is.numeric(newSubjects) || is.na(newSubjects) || newSubjects < 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'calcSubjectsFunction' returned an illegal or undefined result (", newSubjects, "); ", "the output must be a single numeric value >= 0" ) } if (!is.na(conditionalPower) || calcSubjectsFunctionIsUserDefined) { plannedSubjects[(k + 1):kMax] <- sum(subjectsPerStage[gMax + 1, 1:k]) * allocationRatioPlanned + cumsum(rep(newSubjects, kMax - k)) } } else { selectedArms[, k + 1] <- selectedArms[, k] } if (is.na(thetaH1)) { thetaStandardized <- max(min(overallEffects[selectedArms[1:gMax, k], k] / stDevH1, na.rm = TRUE), 1e-12) } else { thetaStandardized <- thetaH1 / stDevH1 } conditionalPowerPerStage[k] <- 1 - stats::pnorm(conditionalCriticalValue[k] - thetaStandardized * sqrt(plannedSubjects[k + 1] - plannedSubjects[k]) * sqrt(1 / (1 + allocationRatioPlanned))) } } return(list( subjectsPerStage = subjectsPerStage, allocationRatioPlanned = allocationRatioPlanned, overallEffects = overallEffects, testStatistics = testStatistics, overallTestStatistics = overallTestStatistics, separatePValues = separatePValues, conditionalCriticalValue = conditionalCriticalValue, conditionalPowerPerStage = conditionalPowerPerStage, selectedArms = selectedArms )) } #' #' @title #' Get Simulation Multi-Arm Means #' #' @description #' Returns the simulated power, stopping and selection probabilities, conditional power, #' and expected sample size for testing means in a multi-arm treatment groups testing situation. #' #' @param muMaxVector Range of effect sizes for the treatment group with highest response #' for \code{"linear"} and \code{"sigmoidEmax"} model, default is \code{seq(0, 1, 0.2)}. #' @inheritParams param_intersectionTest_MultiArm #' @inheritParams param_typeOfSelection #' @inheritParams param_effectMeasure #' @inheritParams param_adaptations #' @inheritParams param_threshold #' @inheritParams param_effectMatrix #' @inheritParams param_stDevSimulation #' @inheritParams param_activeArms #' @inheritParams param_successCriterion #' @inheritParams param_typeOfShape #' @inheritParams param_typeOfSelection #' @inheritParams param_design_with_default #' @inheritParams param_allocationRatioPlanned #' @inheritParams param_plannedSubjects #' @inheritParams param_minNumberOfSubjectsPerStage #' @inheritParams param_maxNumberOfSubjectsPerStage #' @inheritParams param_conditionalPowerSimulation #' @inheritParams param_thetaH1 #' @inheritParams param_stDevH1 #' @inheritParams param_maxNumberOfIterations #' @inheritParams param_calcSubjectsFunction #' @inheritParams param_selectArmsFunction #' @inheritParams param_rValue #' @inheritParams param_epsilonValue #' @inheritParams param_gED50 #' @inheritParams param_slope #' @inheritParams param_seed #' @inheritParams param_three_dots #' @inheritParams param_showStatistics #' #' @details #' At given design the function simulates the power, stopping probabilities, selection probabilities, #' and expected sample size at given number of subjects, parameter configuration, and treatment arm #' selection rule in the multi-arm situation. #' An allocation ratio can be specified referring to the ratio of number of subjects in the active #' treatment groups as compared to the control group. #' #' The definition of \code{thetaH1} and/or \code{stDevH1} makes only sense if \code{kMax} > 1 #' and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and #' \code{maxNumberOfSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. #' #' \code{calcSubjectsFunction}\cr #' This function returns the number of subjects at given conditional power and conditional #' critical value for specified testing situation. The function might depend on the variables #' \code{stage}, #' \code{selectedArms}, #' \code{plannedSubjects}, #' \code{allocationRatioPlanned}, #' \code{minNumberOfSubjectsPerStage}, #' \code{maxNumberOfSubjectsPerStage}, #' \code{conditionalPower}, #' \code{conditionalCriticalValue}, #' \code{overallEffects}, and #' \code{stDevH1}. #' The function has to contain the three-dots argument '...' (see examples). #' #' @template return_object_simulation_results #' @template how_to_get_help_for_generics #' #' @template examples_get_simulation_multiarm_means #' #' @export #' getSimulationMultiArmMeans <- function(design = NULL, ..., activeArms = 3L, # C_ACTIVE_ARMS_DEFAULT effectMatrix = NULL, typeOfShape = c("linear", "sigmoidEmax", "userDefined"), # C_TYPE_OF_SHAPE_DEFAULT muMaxVector = seq(0, 1, 0.2), # C_ALTERNATIVE_POWER_SIMULATION_DEFAULT gED50 = NA_real_, slope = 1, intersectionTest = c("Dunnett", "Bonferroni", "Simes", "Sidak", "Hierarchical"), # C_INTERSECTION_TEST_MULTIARMED_DEFAULT stDev = 1, # C_STDEV_DEFAULT adaptations = NA, typeOfSelection = c("best", "rBest", "epsilon", "all", "userDefined"), # C_TYPE_OF_SELECTION_DEFAULT effectMeasure = c("effectEstimate", "testStatistic"), # C_EFFECT_MEASURE_DEFAULT successCriterion = c("all", "atLeastOne"), # C_SUCCESS_CRITERION_DEFAULT epsilonValue = NA_real_, rValue = NA_real_, threshold = -Inf, plannedSubjects = NA_integer_, allocationRatioPlanned = NA_real_, minNumberOfSubjectsPerStage = NA_real_, maxNumberOfSubjectsPerStage = NA_real_, conditionalPower = NA_real_, thetaH1 = NA_real_, stDevH1 = NA_real_, maxNumberOfIterations = 1000L, # C_MAX_SIMULATION_ITERATIONS_DEFAULT seed = NA_real_, calcSubjectsFunction = NULL, selectArmsFunction = NULL, showStatistics = FALSE) { if (is.null(design)) { design <- .getDefaultDesign(..., type = "simulation") .warnInCaseOfUnknownArguments( functionName = "getSimulationMultiArmMeans", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "showStatistics"), ... ) } else { .assertIsTrialDesignInverseNormalOrFisherOrConditionalDunnett(design) .warnInCaseOfUnknownArguments( functionName = "getSimulationMultiArmMeans", ignore = "showStatistics", ... ) .warnInCaseOfTwoSidedPowerArgument(...) } .assertIsOneSidedDesign(design, designType = "multi-arm", engineType = "simulation") calcSubjectsFunctionIsUserDefined <- !is.null(calcSubjectsFunction) simulationResults <- .createSimulationResultsMultiArmObject( design = design, activeArms = activeArms, effectMatrix = effectMatrix, typeOfShape = typeOfShape, muMaxVector = muMaxVector, # means only gED50 = gED50, slope = slope, intersectionTest = intersectionTest, stDev = stDev, # means only adaptations = adaptations, typeOfSelection = typeOfSelection, effectMeasure = effectMeasure, successCriterion = successCriterion, epsilonValue = epsilonValue, rValue = rValue, threshold = threshold, plannedSubjects = plannedSubjects, # means + rates only allocationRatioPlanned = allocationRatioPlanned, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, # means + rates only maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage, # means + rates only conditionalPower = conditionalPower, thetaH1 = thetaH1, # means + survival only stDevH1 = stDevH1, # means only maxNumberOfIterations = maxNumberOfIterations, seed = seed, calcSubjectsFunction = calcSubjectsFunction, # means + rates only selectArmsFunction = selectArmsFunction, showStatistics = showStatistics, endpoint = "means" ) design <- simulationResults$.design successCriterion <- simulationResults$successCriterion effectMeasure <- simulationResults$effectMeasure adaptations <- simulationResults$adaptations gMax <- activeArms kMax <- simulationResults$.design$kMax intersectionTest <- simulationResults$intersectionTest typeOfSelection <- simulationResults$typeOfSelection effectMatrix <- t(simulationResults$effectMatrix) muMaxVector <- simulationResults$muMaxVector # means only thetaH1 <- simulationResults$thetaH1 # means + survival only stDevH1 <- simulationResults$stDevH1 # means only conditionalPower <- simulationResults$conditionalPower minNumberOfSubjectsPerStage <- simulationResults$minNumberOfSubjectsPerStage maxNumberOfSubjectsPerStage <- simulationResults$maxNumberOfSubjectsPerStage allocationRatioPlanned <- simulationResults$allocationRatioPlanned calcSubjectsFunction <- simulationResults$calcSubjectsFunction indices <- .getIndicesOfClosedHypothesesSystemForSimulation(gMax = gMax) if (.isTrialDesignConditionalDunnett(design)) { criticalValuesDunnett <- .getCriticalValuesDunnettForSimulation( alpha = design$alpha, indices = indices, allocationRatioPlanned = allocationRatioPlanned ) } cols <- length(muMaxVector) simulatedSelections <- array(0, dim = c(kMax, cols, gMax + 1)) simulatedRejections <- array(0, dim = c(kMax, cols, gMax)) simulatedNumberOfActiveArms <- matrix(0, nrow = kMax, ncol = cols) simulatedSubjectsPerStage <- array(0, dim = c(kMax, cols, gMax + 1)) simulatedSuccessStopping <- matrix(0, nrow = kMax, ncol = cols) simulatedFutilityStopping <- matrix(0, cols * (kMax - 1), nrow = kMax - 1, ncol = cols) simulatedConditionalPower <- matrix(0, nrow = kMax, ncol = cols) simulatedRejectAtLeastOne <- rep(0, cols) expectedNumberOfSubjects <- rep(0, cols) iterations <- matrix(0, nrow = kMax, ncol = cols) len <- maxNumberOfIterations * kMax * gMax * cols dataIterationNumber <- rep(NA_real_, len) dataStageNumber <- rep(NA_real_, len) dataArmNumber <- rep(NA_real_, len) dataAlternative <- rep(NA_real_, len) dataEffect <- rep(NA_real_, len) dataSubjectsControlArm <- rep(NA_real_, len) dataSubjectsActiveArm <- rep(NA_real_, len) dataNumberOfSubjects <- rep(NA_real_, len) dataNumberOfCumulatedSubjects <- rep(NA_real_, len) dataRejectPerStage <- rep(NA, len) dataFutilityStop <- rep(NA_real_, len) dataSuccessStop <- rep(NA, len) dataFutilityStop <- rep(NA, len) dataTestStatistics <- rep(NA_real_, len) dataConditionalCriticalValue <- rep(NA_real_, len) dataConditionalPowerAchieved <- rep(NA_real_, len) dataEffectEstimate <- rep(NA_real_, len) dataPValuesSeparate <- rep(NA_real_, len) if (is.na(stDevH1)) { stDevH1 <- stDev } index <- 1 for (i in 1:cols) { for (j in 1:maxNumberOfIterations) { stageResults <- .getSimulatedStageMeansMultiArm( design = design, muVector = effectMatrix[i, ], stDev = stDev, plannedSubjects = plannedSubjects, typeOfSelection = typeOfSelection, effectMeasure = effectMeasure, adaptations = adaptations, epsilonValue = epsilonValue, rValue = rValue, threshold = threshold, allocationRatioPlanned = allocationRatioPlanned, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage, conditionalPower = conditionalPower, thetaH1 = thetaH1, stDevH1 = stDevH1, calcSubjectsFunction = calcSubjectsFunction, calcSubjectsFunctionIsUserDefined = calcSubjectsFunctionIsUserDefined, selectArmsFunction = selectArmsFunction ) if (.isTrialDesignConditionalDunnett(design)) { closedTest <- .performClosedConditionalDunnettTestForSimulation( stageResults = stageResults, design = design, indices = indices, criticalValuesDunnett = criticalValuesDunnett, successCriterion = successCriterion ) } else { closedTest <- .performClosedCombinationTestForSimulationMultiArm( stageResults = stageResults, design = design, indices = indices, intersectionTest = intersectionTest, successCriterion = successCriterion ) } rejectAtSomeStage <- FALSE rejectedArmsBefore <- rep(FALSE, gMax) for (k in 1:kMax) { simulatedRejections[k, i, ] <- simulatedRejections[k, i, ] + (closedTest$rejected[, k] & closedTest$selectedArms[1:gMax, k] | rejectedArmsBefore) simulatedSelections[k, i, ] <- simulatedSelections[k, i, ] + closedTest$selectedArms[, k] simulatedNumberOfActiveArms[k, i] <- simulatedNumberOfActiveArms[k, i] + sum(closedTest$selectedArms[, k]) if (!any(is.na(closedTest$successStop))) { simulatedSuccessStopping[k, i] <- simulatedSuccessStopping[k, i] + closedTest$successStop[k] } if ((kMax > 1) && (k < kMax)) { if (!any(is.na(closedTest$futilityStop))) { simulatedFutilityStopping[k, i] <- simulatedFutilityStopping[k, i] + (closedTest$futilityStop[k] && !closedTest$successStop[k]) } if (!closedTest$successStop[k] && !closedTest$futilityStop[k]) { simulatedConditionalPower[k + 1, i] <- simulatedConditionalPower[k + 1, i] + stageResults$conditionalPowerPerStage[k] } } iterations[k, i] <- iterations[k, i] + 1 for (g in (1:(gMax + 1))) { if (!is.na(stageResults$subjectsPerStage[g, k])) { simulatedSubjectsPerStage[k, i, g] <- simulatedSubjectsPerStage[k, i, g] + stageResults$subjectsPerStage[g, k] } } for (g in 1:gMax) { dataIterationNumber[index] <- j dataStageNumber[index] <- k dataArmNumber[index] <- g dataAlternative[index] <- muMaxVector[i] dataEffect[index] <- effectMatrix[i, g] dataSubjectsControlArm[index] <- round(stageResults$subjectsPerStage[gMax + 1, k], 1) dataSubjectsActiveArm[index] <- round(stageResults$subjectsPerStage[g, k], 1) dataNumberOfSubjects[index] <- round(sum(stageResults$subjectsPerStage[, k], na.rm = TRUE), 1) dataNumberOfCumulatedSubjects[index] <- round(sum(stageResults$subjectsPerStage[, 1:k], na.rm = TRUE), 1) dataRejectPerStage[index] <- closedTest$rejected[g, k] dataTestStatistics[index] <- stageResults$testStatistics[g, k] dataSuccessStop[index] <- closedTest$successStop[k] if (k < kMax) { dataFutilityStop[index] <- closedTest$futilityStop[k] dataConditionalCriticalValue[index] <- stageResults$conditionalCriticalValue[k] dataConditionalPowerAchieved[index + 1] <- stageResults$conditionalPowerPerStage[k] } dataEffectEstimate[index] <- stageResults$overallEffects[g, k] dataPValuesSeparate[index] <- closedTest$separatePValues[g, k] index <- index + 1 } if (!rejectAtSomeStage && any(closedTest$rejected[, k] & closedTest$selectedArms[1:gMax, k] | rejectedArmsBefore)) { simulatedRejectAtLeastOne[i] <- simulatedRejectAtLeastOne[i] + 1 rejectAtSomeStage <- TRUE } if ((k < kMax) && (closedTest$successStop[k] || closedTest$futilityStop[k])) { # rejected hypotheses remain rejected also in case of early stopping simulatedRejections[(k + 1):kMax, i, ] <- simulatedRejections[(k + 1):kMax, i, ] + matrix((closedTest$rejected[, k] & closedTest$selectedArms[1:gMax, k] | rejectedArmsBefore), kMax - k, gMax, byrow = TRUE ) break } rejectedArmsBefore <- closedTest$rejected[, k] & closedTest$selectedArms[1:gMax, k] | rejectedArmsBefore } } simulatedSubjectsPerStage[is.na(simulatedSubjectsPerStage)] <- 0 simulatedSubjectsPerStage[, i, ] <- simulatedSubjectsPerStage[, i, ] / iterations[, i] if (kMax > 1) { simulatedRejections[2:kMax, i, ] <- simulatedRejections[2:kMax, i, ] - simulatedRejections[1:(kMax - 1), i, ] stopping <- cumsum(simulatedSuccessStopping[1:(kMax - 1), i] + simulatedFutilityStopping[, i]) / maxNumberOfIterations expectedNumberOfSubjects[i] <- sum(simulatedSubjectsPerStage[1, i, ] + t(1 - stopping) %*% simulatedSubjectsPerStage[2:kMax, i, ]) } else { expectedNumberOfSubjects[i] <- sum(simulatedSubjectsPerStage[1, i, ]) } } simulatedConditionalPower[1, ] <- NA_real_ if (kMax > 1) { simulatedConditionalPower[2:kMax, ] <- simulatedConditionalPower[2:kMax, ] / iterations[2:kMax, ] } simulationResults$numberOfActiveArms <- simulatedNumberOfActiveArms / iterations - 1 simulationResults$rejectAtLeastOne <- simulatedRejectAtLeastOne / maxNumberOfIterations simulationResults$selectedArms <- simulatedSelections / maxNumberOfIterations simulationResults$rejectedArmsPerStage <- simulatedRejections / maxNumberOfIterations simulationResults$successPerStage <- simulatedSuccessStopping / maxNumberOfIterations simulationResults$futilityPerStage <- simulatedFutilityStopping / maxNumberOfIterations simulationResults$futilityStop <- base::colSums(simulatedFutilityStopping / maxNumberOfIterations) if (kMax > 1) { simulationResults$earlyStop <- simulationResults$futilityPerStage + simulationResults$successPerStage[1:(kMax - 1), ] simulationResults$conditionalPowerAchieved <- simulatedConditionalPower } simulationResults$sampleSizes <- simulatedSubjectsPerStage simulationResults$expectedNumberOfSubjects <- expectedNumberOfSubjects simulationResults$iterations <- iterations if (!all(is.na(simulationResults$conditionalPowerAchieved))) { simulationResults$.setParameterType("conditionalPowerAchieved", C_PARAM_GENERATED) } if (any(simulationResults$rejectedArmsPerStage < 0)) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "internal error, simulation not possible due to numerical overflow" ) } data <- data.frame( iterationNumber = dataIterationNumber, stageNumber = dataStageNumber, armNumber = dataArmNumber, muMax = dataAlternative, effect = dataEffect, numberOfSubjects = dataNumberOfSubjects, numberOfCumulatedSubjects = dataNumberOfCumulatedSubjects, subjectsControlArm = dataSubjectsControlArm, subjectsActiveArm = dataSubjectsActiveArm, effectEstimate = dataEffectEstimate, testStatistic = dataTestStatistics, pValue = dataPValuesSeparate, conditionalCriticalValue = round(dataConditionalCriticalValue, 6), conditionalPowerAchieved = round(dataConditionalPowerAchieved, 6), rejectPerStage = dataRejectPerStage, successStop = dataSuccessStop, futilityPerStage = dataFutilityStop ) data <- data[!is.na(data$effectEstimate), ] simulationResults$.data <- data return(simulationResults) } rpact/R/class_analysis_dataset.R0000644000175000017500000044432414160550674016601 0ustar nileshnilesh## | ## | *Dataset classes* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5680 $ ## | Last changed: $Date: 2021-12-22 08:20:24 +0100 (Wed, 22 Dec 2021) $ ## | Last changed by: $Author: pahlke $ ## | C_KEY_WORDS_GROUPS <- c("group", "groups") C_KEY_WORDS_STAGES <- c("stage", "stages") C_KEY_WORDS_SUBSETS <- c("subset", "subsets") C_KEY_WORDS_SAMPLE_SIZES <- c("n", "sampleSizes", "sampleSize") C_KEY_WORDS_MEANS <- c("means", "mean") C_KEY_WORDS_ST_DEVS <- c("stDevs", "stDev", "stds", "st.dev", "sd") C_KEY_WORDS_EVENTS <- c("event", "events") C_KEY_WORDS_EVENTS_1 <- c("event1", "events1") C_KEY_WORDS_EVENTS_2 <- c("event2", "events2") C_KEY_WORDS_OVERALL_EVENTS <- c("overallEvents", "overallEvent", "overall.events", "overall.event") C_KEY_WORDS_OVERALL_EVENTS_1 <- c("overallEvents1", "overallEvent1", "overall.events.1", "overall.event.1") C_KEY_WORDS_OVERALL_EVENTS_2 <- c("overallEvents2", "overallEvent2", "overall.events.2", "overall.event.2") C_KEY_WORDS_EXPECTED_EVENTS <- c("expectedEvents", "expectedEvent") C_KEY_WORDS_VARIANCE_EVENTS <- c("varianceEvents", "varianceEvent") C_KEY_WORDS_OVERALL_EXPECTED_EVENTS <- c("overallExpectedEvents", "overallExpectedEvent") C_KEY_WORDS_OVERALL_VARIANCE_EVENTS <- c("overallVarianceEvents", "overallVarianceEvent") C_KEY_WORDS_SAMPLE_SIZES_1 <- c("n1", "sampleSize1", "sampleSizes1") C_KEY_WORDS_MEANS_1 <- c("means1", "mean1") C_KEY_WORDS_ST_DEVS_1 <- c("stDevs1", "stDev1", "stds1", "st.dev1", "sd1") C_KEY_WORDS_SAMPLE_SIZES_2 <- c("n2", "sampleSize2", "sampleSizes2") C_KEY_WORDS_MEANS_2 <- c("means2", "mean2") C_KEY_WORDS_ST_DEVS_2 <- c("stDevs2", "stDev2", "stds2", "st.dev2", "sd2") C_KEY_WORDS_OVERALL_SAMPLE_SIZES <- c("overallN", "overall.n", "overallSampleSizes", "overallSampleSize") C_KEY_WORDS_OVERALL_MEANS <- c("overallMeans", "overallMean", "overall.means", "overall.mean") C_KEY_WORDS_OVERALL_ST_DEVS <- c("overallStDevs", "overallStDev", "overall.st.dev", "overall.stds", "overall.sd") C_KEY_WORDS_OVERALL_SAMPLE_SIZES_1 <- c("overallN1", "overall.n.1", "overallSampleSizes1", "overallSampleSize1") C_KEY_WORDS_OVERALL_MEANS_1 <- c("overallMeans1", "overallMean1", "overall.means.1", "overall.mean.1") C_KEY_WORDS_OVERALL_ST_DEVS_1 <- c("overallStDevs1", "overallStDev1", "overall.st.dev.1", "overall.stds.1", "overall.sd.1") C_KEY_WORDS_OVERALL_SAMPLE_SIZES_2 <- c("overallN2", "overall.n.2", "overallSampleSizes2", "overallSampleSize2") C_KEY_WORDS_OVERALL_MEANS_2 <- c("overallMeans2", "overallMean2", "overall.means.2", "overall.mean.2") C_KEY_WORDS_OVERALL_ST_DEVS_2 <- c("overallStDevs2", "overallStDev2", "overall.st.dev.2", "overall.stds.2", "overall.sd.2") C_KEY_WORDS_ALLOCATION_RATIOS <- c("allocationRatios", "allocationRatio", "ar", "allocation.ratios", "allocation.ratio") C_KEY_WORDS_LOG_RANKS <- c("logRanks", "logRank", "lr", "log.ranks", "log.rank") C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS <- c("overallAllocationRatios", "overallAllocationRatio", "oar", "overall.allocation.ratios", "overall.allocation.ratio") C_KEY_WORDS_OVERALL_LOG_RANKS <- c("overallLogRanks", "overallLogRank", "olr", "overall.log.ranks", "overall.log.rank") C_KEY_WORDS <- c( C_KEY_WORDS_GROUPS, C_KEY_WORDS_STAGES, C_KEY_WORDS_SUBSETS, C_KEY_WORDS_SAMPLE_SIZES, C_KEY_WORDS_MEANS, C_KEY_WORDS_ST_DEVS, C_KEY_WORDS_EVENTS, C_KEY_WORDS_EVENTS_1, C_KEY_WORDS_EVENTS_2, C_KEY_WORDS_OVERALL_EVENTS, C_KEY_WORDS_OVERALL_EVENTS_1, C_KEY_WORDS_OVERALL_EVENTS_2, C_KEY_WORDS_SAMPLE_SIZES_1, C_KEY_WORDS_MEANS_1, C_KEY_WORDS_ST_DEVS_1, C_KEY_WORDS_SAMPLE_SIZES_2, C_KEY_WORDS_MEANS_2, C_KEY_WORDS_ST_DEVS_2, C_KEY_WORDS_OVERALL_SAMPLE_SIZES, C_KEY_WORDS_OVERALL_MEANS, C_KEY_WORDS_OVERALL_ST_DEVS, C_KEY_WORDS_OVERALL_SAMPLE_SIZES_1, C_KEY_WORDS_OVERALL_MEANS_1, C_KEY_WORDS_OVERALL_ST_DEVS_1, C_KEY_WORDS_OVERALL_SAMPLE_SIZES_2, C_KEY_WORDS_OVERALL_MEANS_2, C_KEY_WORDS_OVERALL_ST_DEVS_2, C_KEY_WORDS_ALLOCATION_RATIOS, C_KEY_WORDS_LOG_RANKS, C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, C_KEY_WORDS_OVERALL_LOG_RANKS ) #' @title #' Read Dataset #' #' @description #' Reads a data file and returns it as dataset object. #' #' @param file A CSV file (see \code{\link[utils]{read.table}}). #' @param header A logical value indicating whether the file contains the names of #' the variables as its first line. #' @param sep The field separator character. Values on each line of the file are separated #' by this character. If sep = "," (the default for \code{readDataset}) the separator is a comma. #' @param quote The set of quoting characters. To disable quoting altogether, use #' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only #' considered for columns read as character, which is all of them unless \code{colClasses} is specified. #' @param dec The character used in the file for decimal points. #' @param fill logical. If \code{TRUE} then in case the rows have unequal length, blank fields #' are implicitly added. #' @param comment.char character: a character vector of length one containing a single character #' or an empty string. Use "" to turn off the interpretation of comments altogether. #' @param fileEncoding character string: if non-empty declares the encoding used on a file #' (not a connection) so the character data can be re-encoded. #' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. #' @param ... Further arguments to be passed to code{\link[utils]{read.table}}. #' #' @details #' \code{readDataset} is a wrapper function that uses \code{\link[utils]{read.table}} to read the #' CSV file into a data frame, transfers it from long to wide format with \code{\link[stats]{reshape}} #' and puts the data to \code{\link{getDataset}}. #' #' @template return_object_dataset #' #' @seealso #' \itemize{ #' \item \code{\link{readDatasets}} for reading multiple datasets, #' \item \code{\link{writeDataset}} for writing a single dataset, #' \item \code{\link{writeDatasets}} for writing multiple datasets. #' } #' #' @examples #' dataFileRates <- system.file("extdata", #' "dataset_rates.csv", package = "rpact") #' if (dataFileRates != "") { #' datasetRates <- readDataset(dataFileRates) #' datasetRates #' } #' #' dataFileMeansMultiArm <- system.file("extdata", #' "dataset_means_multi-arm.csv", package = "rpact") #' if (dataFileMeansMultiArm != "") { #' datasetMeansMultiArm <- readDataset(dataFileMeansMultiArm) #' datasetMeansMultiArm #' } #' #' dataFileRatesMultiArm <- system.file("extdata", #' "dataset_rates_multi-arm.csv", package = "rpact") #' if (dataFileRatesMultiArm != "") { #' datasetRatesMultiArm <- readDataset(dataFileRatesMultiArm) #' datasetRatesMultiArm #' } #' #' dataFileSurvivalMultiArm <- system.file("extdata", #' "dataset_survival_multi-arm.csv", package = "rpact") #' if (dataFileSurvivalMultiArm != "") { #' datasetSurvivalMultiArm <- readDataset(dataFileSurvivalMultiArm) #' datasetSurvivalMultiArm #' } #' #' @export #' readDataset <- function(file, ..., header = TRUE, sep = ",", quote = "\"", dec = ".", fill = TRUE, comment.char = "", fileEncoding = "UTF-8") { if (!file.exists(file)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the file '", file, "' does not exist") } data <- utils::read.table(file = file, header = header, sep = sep, quote = quote, dec = dec, fill = fill, fileEncoding = fileEncoding, ...) dataWide <- stats::reshape(data = data, direction = "wide", idvar = "stages", timevar = "groups") colnames(dataWide) <- gsub("\\.", "", colnames(dataWide)) return(getDataset(dataWide)) } #' @title #' Write Dataset #' #' @description #' Writes a dataset to a CSV file. #' #' @param dataset A dataset. #' @param file The target CSV file. #' @param append Logical. Only relevant if file is a character string. #' If \code{TRUE}, the output is appended to the file. If \code{FALSE}, any existing file of the name is destroyed. #' @param sep The field separator character. Values on each line of the file are separated #' by this character. If sep = "," (the default for \code{writeDataset}) the separator is a comma. #' @param quote The set of quoting characters. To disable quoting altogether, use #' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only #' considered for columns read as character, which is all of them unless \code{colClasses} is specified. #' @param dec The character used in the file for decimal points. #' @param eol The character(s) to print at the end of each line (row). #' @param na The string to use for missing values in the data. #' @param row.names Either a logical value indicating whether the row names of \code{dataset} are #' to be written along with \code{dataset}, or a character vector of row names to be written. #' @param col.names Either a logical value indicating whether the column names of \code{dataset} are #' to be written along with \code{dataset}, or a character vector of column names to be written. #' See the section on 'CSV files' for the meaning of \code{col.names = NA}. #' @param qmethod A character string specifying how to deal with embedded double quote characters #' when quoting strings. Must be one of "double" (default in \code{writeDataset}) or "escape". #' @param fileEncoding Character string: if non-empty declares the encoding used on a file #' (not a connection) so the character data can be re-encoded. #' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. #' @param ... Further arguments to be passed to \code{\link[utils]{write.table}}. #' #' @details #' \code{\link{writeDataset}} is a wrapper function that coerces the dataset to a data frame and uses \cr #' \code{\link[utils]{write.table}} to write it to a CSV file. #' #' @seealso #' \itemize{ #' \item \code{\link{writeDatasets}} for writing multiple datasets, #' \item \code{\link{readDataset}} for reading a single dataset, #' \item \code{\link{readDatasets}} for reading multiple datasets. #' } #' #' @examples #' \dontrun{ #' datasetOfRates <- getDataset( #' n1 = c(11, 13, 12, 13), #' n2 = c(8, 10, 9, 11), #' events1 = c(10, 10, 12, 12), #' events2 = c(3, 5, 5, 6) #' ) #' writeDataset(datasetOfRates, "dataset_rates.csv") #' } #' #' @export #' writeDataset <- function(dataset, file, ..., append = FALSE, quote = TRUE, sep = ",", eol = "\n", na = "NA", dec = ".", row.names = TRUE, col.names = NA, qmethod = "double", fileEncoding = "UTF-8") { .assertIsDataset(dataset) x <- as.data.frame(dataset, niceColumnNamesEnabled = FALSE) utils::write.table(x = x, file = file, append = append, quote = quote, sep = sep, eol = eol, na = na, dec = dec, row.names = FALSE, col.names = TRUE, qmethod = qmethod, fileEncoding = fileEncoding) } #' @title #' Read Multiple Datasets #' #' @description #' Reads a data file and returns it as a list of dataset objects. #' #' @param file A CSV file (see \code{\link[utils]{read.table}}). #' @param header A logical value indicating whether the file contains the names of #' the variables as its first line. #' @param sep The field separator character. Values on each line of the file are separated #' by this character. If sep = "," (the default for \code{readDatasets}) the separator is a comma. #' @param quote The set of quoting characters. To disable quoting altogether, use #' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only #' considered for columns read as character, which is all of them unless \code{colClasses} is specified. #' @param dec The character used in the file for decimal points. #' @param fill logical. If \code{TRUE} then in case the rows have unequal length, blank fields #' are implicitly added. #' @param comment.char character: a character vector of length one containing a single character #' or an empty string. Use "" to turn off the interpretation of comments altogether. #' @param fileEncoding character string: if non-empty declares the encoding used on a file #' (not a connection) so the character data can be re-encoded. #' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. #' @param ... Further arguments to be passed to \code{\link[utils]{read.table}}. #' #' @details #' Reads a file that was written by \code{\link{writeDatasets}} before. #' #' @return Returns a \code{\link[base]{list}} of \code{\link{Dataset}} objects. #' #' @seealso #' \itemize{ #' \item \code{\link{readDataset}} for reading a single dataset, #' \item \code{\link{writeDatasets}} for writing multiple datasets, #' \item \code{\link{writeDataset}} for writing a single dataset. #' } #' #' @examples #' dataFile <- system.file("extdata", "datasets_rates.csv", package = "rpact") #' if (dataFile != "") { #' datasets <- readDatasets(dataFile) #' datasets #' } #' #' @export #' readDatasets <- function(file, ..., header = TRUE, sep = ",", quote = "\"", dec = ".", fill = TRUE, comment.char = "", fileEncoding = "UTF-8") { if (!file.exists(file)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the file '", file, "' does not exist") } data <- utils::read.table(file = file, header = header, sep = sep, quote = quote, dec = dec, fill = fill, fileEncoding = fileEncoding, ...) if (is.null(data[["datasetId"]])) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "data file must contain the column 'datasetId'") } datasets <- list() for (datasetId in unique(data$datasetId)) { subData <- data[data$datasetId == datasetId, ] dataFrame <- subset(subData, select = -datasetId) description <- NA_character_ if (!is.null(dataFrame[["description"]])) { description <- as.character(dataFrame$description[1]) dataFrame <- subset(dataFrame, select = -description) } if (length(unique(subData$groups)) == 2) { dataWide <- stats::reshape(dataFrame, direction = "wide", idvar = "stages", timevar = "groups") colnames(dataWide) <- gsub("\\.", "", colnames(dataWide)) dataset <- getDataset(dataWide) } else { dataset <- getDataset(dataFrame) } dataset$setDescription(description) datasets <- c(datasets, dataset) } return(datasets) } #' @title #' Write Multiple Datasets #' #' @description #' Writes a list of datasets to a CSV file. #' #' @param datasets A list of datasets. #' @param file The target CSV file. #' @param append Logical. Only relevant if file is a character string. #' If \code{TRUE}, the output is appended to the file. If FALSE, any existing file of the name is destroyed. #' @param sep The field separator character. Values on each line of the file are separated #' by this character. If sep = "," (the default for \code{writeDatasets}) the separator is a comma. #' @param quote The set of quoting characters. To disable quoting altogether, use #' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only #' considered for columns read as character, which is all of them unless \code{colClasses} is specified. #' @param dec The character used in the file for decimal points. #' @param eol The character(s) to print at the end of each line (row). #' @param na The string to use for missing values in the data. #' @param row.names Either a logical value indicating whether the row names of \code{dataset} are #' to be written along with \code{dataset}, or a character vector of row names to be written. #' @param col.names Either a logical value indicating whether the column names of \code{dataset} are #' to be written along with \code{dataset}, or a character vector of column names to be written. #' See the section on 'CSV files' for the meaning of \code{col.names = NA}. #' @param qmethod A character string specifying how to deal with embedded double quote characters #' when quoting strings. Must be one of "double" (default in \code{writeDatasets}) or "escape". #' @param fileEncoding Character string: if non-empty declares the encoding used on a file #' (not a connection) so the character data can be re-encoded. #' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. #' @param ... Further arguments to be passed to \code{\link[utils]{write.table}}. #' #' @details #' The format of the CSV file is optimized for usage of \code{\link{readDatasets}}. #' #' @seealso #' \itemize{ #' \item \code{\link{writeDataset}} for writing a single dataset, #' \item \code{\link{readDatasets}} for reading multiple datasets, #' \item \code{\link{readDataset}} for reading a single dataset. #' } #' #' @examples #' \dontrun{ #' d1 <- getDataset( #' n1 = c(11, 13, 12, 13), #' n2 = c(8, 10, 9, 11), #' events1 = c(10, 10, 12, 12), #' events2 = c(3, 5, 5, 6) #' ) #' d2 <- getDataset( #' n1 = c(9, 13, 12, 13), #' n2 = c(6, 10, 9, 11), #' events1 = c(10, 10, 12, 12), #' events2 = c(4, 5, 5, 6) #' ) #' datasets <- list(d1, d2) #' writeDatasets(datasets, "datasets_rates.csv") #' } #' #' @export #' writeDatasets <- function(datasets, file, ..., append = FALSE, quote = TRUE, sep = ",", eol = "\n", na = "NA", dec = ".", row.names = TRUE, col.names = NA, qmethod = "double", fileEncoding = "UTF-8") { if (!is.list(datasets)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'datasets' must be a list of datasets") } if (length(datasets) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'datasets' is empty") } datasetType <- NA_character_ dataFrames <- NULL for (i in 1:length(datasets)) { dataset <- datasets[[i]] .assertIsDataset(dataset) if (is.na(datasetType)) { datasetType <- class(dataset) } else if (class(dataset) != datasetType) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all datasets must have the same type") } data <- as.data.frame(dataset, niceColumnNamesEnabled = FALSE) datasetId <- ifelse(!is.null(dataset$getId()) && !is.na(dataset$getId()), dataset$getId(), i) data <- cbind(rep(datasetId, nrow(data)), data) colnames(data)[1] <- "datasetId" if (!is.null(dataset$getDescription()) && !is.na(dataset$getDescription())) { data <- cbind(data, rep(dataset$getDescription(), nrow(data))) colnames(data)[ncol(data)] <- "description" } if (is.null(dataFrames)) { dataFrames <- data } else { dataFrames <- rbind(dataFrames, data) } } if (is.null(dataFrames)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to bind datasets") } utils::write.table(x = dataFrames, file = file, append = append, quote = quote, sep = sep, eol = eol, na = na, dec = dec, row.names = FALSE, col.names = TRUE, qmethod = qmethod, fileEncoding = fileEncoding) } #' @title #' Get Dataset #' #' @description #' Creates a dataset object and returns it. #' #' @param ... A \code{data.frame} or some data vectors defining the dataset. #' @param floatingPointNumbersEnabled If \code{TRUE}, #' sample sizes can be specified as floating-point numbers #' (this make sense, e.g., for theoretical comparisons); \cr #' by default \code{floatingPointNumbersEnabled = FALSE}, i.e., #' samples sizes defined as floating-point numbers will be truncated. #' #' @details #' The different dataset types \code{DatasetMeans}, of \code{DatasetRates}, or #' \code{DatasetSurvival} can be created as follows: #' \itemize{ #' \item An element of \code{\link{DatasetMeans}} for one sample is created by \cr #' \code{getDataset(sampleSizes =, means =, stDevs =)} where \cr #' \code{sampleSizes}, \code{means}, \code{stDevs} are vectors with stage-wise sample sizes, #' means and standard deviations of length given by the number of available stages. #' \item An element of \code{\link{DatasetMeans}} for two samples is created by \cr #' \code{getDataset(sampleSizes1 =, sampleSizes2 =, means1 =, means2 =, } \cr #' \code{stDevs1 =, stDevs2 =)} where #' \code{sampleSizes1}, \code{sampleSizes2}, \code{means1}, \code{means2}, #' \code{stDevs1}, \code{stDevs2} are vectors with #' stage-wise sample sizes, means and standard deviations for the two treatment groups #' of length given by the number of available stages. #' \item An element of \code{\link{DatasetRates}} for one sample is created by \cr #' \code{getDataset(sampleSizes =, events =)} where \code{sampleSizes}, \code{events} are vectors #' with stage-wise sample sizes and events of length given by the number of available stages. #' \item An element of \code{\link{DatasetRates}} for two samples is created by \cr #' \code{getDataset(sampleSizes1 =, sampleSizes2 =, events1 =, events2 =)} where #' \code{sampleSizes1}, \code{sampleSizes2}, \code{events1}, \code{events2} #' are vectors with stage-wise sample sizes #' and events for the two treatment groups of length given by the number of available stages. #' \item An element of \code{\link{DatasetSurvival}} is created by \cr #' \code{getDataset(events =, logRanks =, allocationRatios =)} where #' \code{events}, \code{logRanks}, and \code{allocation ratios} are the stage-wise events, #' (one-sided) logrank statistics, and allocation ratios. #' \item An element of \code{\link{DatasetMeans}}, \code{\link{DatasetRates}}, and \code{\link{DatasetSurvival}} #' for more than one comparison is created by adding subsequent digits to the variable names. #' The system can analyze these data in a multi-arm many-to-one comparison setting where the #' group with the highest index represents the control group. #' } #' Prefix \code{overall[Capital case of first letter of variable name]...} for the variable #' names enables entering the overall (cumulative) results and calculates stage-wise statistics. #' #' \code{n} can be used in place of \code{samplesizes}. #' #' Note that in survival design usually the overall (cumulative) events and logrank test statistics are provided #' in the output, so \cr #' \code{getDataset(overallEvents=, overallLogRanks =, overallAllocationRatios =)} \cr #' is the usual command for entering survival data. Note also that for \code{overallLogranks} also the #' z scores from a Cox regression can be used. #' #' For multi-arm designs, the index refers to the considered comparison. For example,\cr #' \code{ #' getDataset(events1=c(13, 33), logRanks1 = c(1.23, 1.55), events2 = c(16, NA), logRanks2 = c(1.55, NA)) #' } \cr #' refers to the case where one active arm (1) is considered at both stages whereas active arm 2 #' was dropped at interim. Number of events and logrank statistics are entered for the corresponding #' comparison to control (see Examples). #' #' For enrichment designs, the comparison of two samples is provided for an unstratified #' (sub-population wise) or stratified data input.\cr #' For unstratified (sub-population wise) data input the data sets are defined for the sub-populations #' S1, S2, ..., F, where F refers to the full populations. Use of \code{getDataset(S1 = , S2, ..., F = )} #' defines the data set to be used in \code{\link{getAnalysisResults}} (see examples)\cr #' For stratified data input the data sets are defined for the strata S1, S12, S2, ..., R, where R #' refers to the remainder of the strata such that the union of all sets is the full population. #' Use of \code{getDataset(S1 = , S12 = , S2, ..., R = )} defines the data set to be used in #' \code{\link{getAnalysisResults}} (see examples)\cr #' For survival data, for enrichment designs the log-rank statistics should be entered as stratified #' log-rank statistics in order to provide strong control of Type I error rate. For stratified data input, #' the variables to be specified in \code{getDataset()} are \code{events}, \code{expectedEvents}, #' \code{varianceEvents}, and \code{allocationRatios} or \code{overallEvents}, \code{overallExpectedEvents}, #' \code{overallVarianceEvents}, and \code{overallAllocationRatios}. From this, (stratified) log-rank tests are #' calculated. #' #' @template return_object_dataset #' #' @template examples_get_dataset #' #' @include f_analysis_base.R #' @include f_analysis_utilities.R #' #' @export #' getDataset <- function(..., floatingPointNumbersEnabled = FALSE) { args <- list(...) if (length(args) == 0) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "data.frame, data vectors, or datasets expected") } if (.optionalArgsContainsDatasets(...)) { return(.getEnrichmentDatasetFromArgs(...)) } exampleType <- args[["example"]] if (!is.null(exampleType) && exampleType %in% c("means", "rates", "survival")) { return(.getDatasetExample(exampleType = exampleType)) } if (length(args) == 1 && !is.null(args[[1]]) && is.list(args[[1]]) && !is.data.frame(args[[1]])) { return(.getDatasetMeansFromModelsByStage(emmeansResults = args[[1]])) } emmeansResults <- .getDatasetMeansModelObjectsList(args) if (!is.null(emmeansResults) && length(emmeansResults) > 0) { return(.getDatasetMeansFromModelsByStage(emmeansResults = emmeansResults)) } dataFrame <- .getDataFrameFromArgs(...) if (is.null(dataFrame)) { paramNames <- names(args) paramNames <- paramNames[paramNames != ""] if (length(paramNames) != length(args)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all parameters must be named") } if (length(paramNames) != length(unique(paramNames))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the parameter names must be unique") } dataFrame <- .createDataFrame(...) } enrichmentEnabled <- .isDataObjectEnrichment(...) if (.isDataObjectMeans(...)) { return(DatasetMeans(dataFrame = dataFrame, floatingPointNumbersEnabled = floatingPointNumbersEnabled, enrichmentEnabled = enrichmentEnabled)) } if (.isDataObjectRates(...)) { return(DatasetRates(dataFrame = dataFrame, floatingPointNumbersEnabled = floatingPointNumbersEnabled, enrichmentEnabled = enrichmentEnabled)) } if (.isDataObjectNonStratifiedEnrichmentSurvival(...)) { return(DatasetEnrichmentSurvival(dataFrame = dataFrame, floatingPointNumbersEnabled = floatingPointNumbersEnabled, enrichmentEnabled = enrichmentEnabled)) } if (.isDataObjectSurvival(...)) { return(DatasetSurvival(dataFrame = dataFrame, floatingPointNumbersEnabled = floatingPointNumbersEnabled, enrichmentEnabled = enrichmentEnabled)) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "failed to identify dataset type") } #' @rdname getDataset #' @export getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) { return(getDataset(floatingPointNumbersEnabled = floatingPointNumbersEnabled, ...)) } .getDatasetMeansModelObjectsList <- function(args) { if (is.null(args) || length(args) == 0 || !is.list(args)) { return(NULL) } emmeansResults <- list() for (arg in args) { if (inherits(arg, "emmGrid")) { emmeansResults[[length(emmeansResults) + 1]] <- arg } } if (length(emmeansResults) == 0) { return(NULL) } argNames <- names(args) for (i in 1:length(args)) { arg <- args[[i]] if (!inherits(arg, "emmGrid")) { argName <- argNames[i] argInfo <- "" if (length(argName) == 1 && argName != "") { argInfo <- paste0(sQuote(argName), " ") } argInfo <- paste0(argInfo, "(", .arrayToString(arg), ")") warning("Argument ", argInfo, " will be ignored because only 'emmGrid' objects will be respected") } } return(emmeansResults) } .getStandardDeviationFromStandardError <- function(sampleSize, standardError, ..., dfValue = NA_real_, alpha = 0.05, lmEnabled = TRUE, stDevCalcMode = "auto") { qtCalcEnablbled <- length(stDevCalcMode) == 1 && !is.na(stDevCalcMode) && stDevCalcMode == "t" if ((qtCalcEnablbled || !lmEnabled) && !is.na(dfValue) && !is.infinite(dfValue) && dfValue > 0) { qValue <- stats::qt(1 - alpha / 2, df = dfValue) stDev <- standardError * 2 / qValue * sqrt(sampleSize) } else { stDev <- standardError * sqrt(sampleSize) } return(stDev) } .getDatasetMeansFromModelsByStage <- function(emmeansResults, correctGroupOrder = TRUE) { if (is.null(emmeansResults)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be a non-empty list") } if (!is.list(emmeansResults)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be a list") } if (length(emmeansResults) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be not empty") } for (stage in 1:length(emmeansResults)) { if (!inherits(emmeansResults[[stage]], "emmGrid")) { stop(sprintf(paste0("%s%s must contain %s objects created by emmeans(x), ", "where x is a linear model result (one object per stage; class is %s at stage %s)"), C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("emmeansResults"), sQuote("emmGrid"), class(emmeansResults[[stage]]), stage)) } } stages <- integer(0) groups <- integer(0) means <- numeric(0) stDevs <- numeric(0) sampleSizes <- numeric(0) lmEnabled <- TRUE tryCatch({ modelCall <- emmeansResults[[1]]@model.info$call modelFunction <- as.character(modelCall)[1] lmEnabled <- modelFunction == "lm" if (!grepl(paste0("::", modelFunction), modelFunction)) { packageName <- .getPackageName(modelFunction) if (!is.na(packageName)) { modelFunction <- paste0(packageName, "::", modelFunction) } } if (lmEnabled) { warning("When using ", modelFunction, "() ", "the estimated marginal means and standard deviations can be inaccurate ", "and analysis results based on this values may be imprecise", call. = FALSE) } else { warning("Using ", modelFunction, " emmeans result objects as ", "arguments of getDataset() is experminental in this rpact version and not fully validated", call. = FALSE) } }, error = function(e) { warning("Using emmeans result objects as ", "arguments of getDataset() is experminental in this rpact version and not fully validated", call. = FALSE) }) stDevCalcMode <- getOption("rpact.dataset.stdev.calc.mode", "auto") # auto, sigma, norm, t for (stage in 1:length(emmeansResults)) { emmeansResult <- emmeansResults[[stage]] emmeansResultsSummary <- summary(emmeansResult) emmeansResultsList <- as.list(emmeansResult) if (is.null(emmeansResultsSummary[["emmean"]])) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "the objects in summary(emmeansResults) must contain the field 'emmean'") } for (expectedField in c("sigma", "extras")) { if (is.null(emmeansResultsList[[expectedField]])) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "the objects in as.list(emmeansResults) must contain the field ", sQuote(expectedField)) } } numberOfGroups <- length(emmeansResultsSummary$emmean) rpactGroupNumbers <- 1:numberOfGroups if (correctGroupOrder) { rpactGroupNumbers <- 1 if (numberOfGroups > 1) { rpactGroupNumbers <- c(2:numberOfGroups, rpactGroupNumbers) } } for (group in 1:length(emmeansResultsSummary$emmean)) { stages <- c(stages, stage) groups <- c(groups, group) rpactGroupNumber <- rpactGroupNumbers[group] standardError <- emmeansResultsSummary$SE[rpactGroupNumber] sampleSize <- emmeansResultsList$extras[rpactGroupNumber, ] meanValue <- emmeansResultsSummary$emmean[rpactGroupNumber] dfValue <- emmeansResultsSummary$df[rpactGroupNumber] if (length(stDevCalcMode) == 1 && !is.na(stDevCalcMode) && stDevCalcMode == "sigma") { # pooled standard deviation from emmeans stDev <- emmeansResultsList$sigma } else { stDev <- .getStandardDeviationFromStandardError(sampleSize, standardError, dfValue = dfValue, lmEnabled = lmEnabled, stDevCalcMode = stDevCalcMode) } means <- c(means, meanValue) stDevs <- c(stDevs, stDev) sampleSizes <- c(sampleSizes, sampleSize) } } data <- data.frame( stages = stages, groups = groups, means = means, stDevs = stDevs, sampleSizes = sampleSizes ) data <- data[order(data$stages, data$groups), ] dataWide <- stats::reshape(data = data, direction = "wide", idvar = "stages", timevar = "groups") colnames(dataWide) <- gsub("\\.", "", colnames(dataWide)) return(getDataset(dataWide)) } .optionalArgsContainsDatasets <- function(...) { args <- list(...) if (length(args) == 0) { return(FALSE) } for (arg in args) { if (inherits(arg, "Dataset")) { return(TRUE) } } return(FALSE) } .getGMaxFromSubsetNames <- function(subsetNames) { subsetNumbers <- gsub("\\D", "", subsetNames) subsetNumbers <- subsetNumbers[subsetNumbers != ""] if (length(subsetNumbers) == 0) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'subsetNames' (", .arrayToString(subsetNames), ") does not contain any numbers") } subsetNumbers <- paste0(subsetNumbers, collapse = "") subsetNumbers <- strsplit(subsetNumbers, "")[[1]] subsetNumbers <- as.integer(subsetNumbers) gMax <- max(subsetNumbers) + 1 return(gMax) } .getSubsetsFromArgs <- function(...) { args <- list(...) if (length(args) == 0) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "one or more subset datasets expected") } subsetNames <- names(args) if (is.null(subsetNames)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subsets must be named") } if (!("R" %in% subsetNames) && !("F" %in% subsetNames)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, '"R" (stratified analysis)" or "F" (non-stratified analysis) must be defined as subset') } subsetNumbers <- gsub("\\D", "", subsetNames) subsetNumbers <- subsetNumbers[subsetNumbers != ""] # & nchar(subsetNumbers) == 1 if (length(subsetNumbers) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subset names (", .arrayToString(subsetNames), ") must be \"S[n]\", \"R\", or \"F\", ", "where [n] is a number with increasing digits (starting with 1)") } stratifiedInput <- "R" %in% subsetNames subsetNumbers <- paste0(subsetNumbers, collapse = "") subsetNumbers <- strsplit(subsetNumbers, "")[[1]] subsetNumbers <- as.integer(subsetNumbers) gMax <- max(subsetNumbers) + 1 validSubsetNames <- .createSubsetsByGMax(gMax, stratifiedInput = stratifiedInput, all = FALSE) for (subsetName in subsetNames) { if (subsetName == "") { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subsets must be named") } if (!(subsetName %in% validSubsetNames)) { suffix <- ifelse(stratifiedInput, " (stratified analysis)", " (non-stratified analysis)") if (length(validSubsetNames) < 10) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "invalid subset name (", subsetName, "); ", "valid names are ", .arrayToString(validSubsetNames), suffix) } else { restFull <- ifelse(stratifiedInput, '"R"', '"F"') stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "invalid subset name (", subsetName, "): ", "all subset names must be \"S[n]\" or ", restFull, ", ", "where [n] is a number with increasing digits", suffix) } } } subsets <- NULL subsetType <- NA_character_ emptySubsetNames <- validSubsetNames[!(validSubsetNames %in% subsetNames)] for (subsetName in subsetNames) { subset <- args[[subsetName]] if (is.null(subset) || (!isS4(subset) && is.na(subset))) { emptySubsetNames <- c(emptySubsetNames, subsetName) } else { if (!.isDataset(subset)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "subset ", subsetName, " is not a dataset (is ", class(subset), ")") } if (!is.na(subsetType) && subsetType != class(subset)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subsets must have the same type (found ", subsetType, " and ", class(subset), ")") } subsetType <- class(subset) if (is.null(subset[[".data"]])) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "subset ", subsetName, " does not contain field '.data'") } subset <- subset$.data subset$subset <- rep(subsetName, nrow(subset)) if (is.null(subsets)) { subsets <- subset } else { subsets <- rbind(subsets, subset) } } } if (length(emptySubsetNames) > 0) { emptySubsetNames <- unique(emptySubsetNames) template <- subsets[subsets$subset == ifelse(stratifiedInput, "R", "F"), ] colNames <- colnames(template) colNames <- colNames[!(colNames %in% c("stage", "group", "subset"))] for (colName in colNames) { template[[colName]] <- rep(NA_real_, nrow(template)) } for (subsetName in emptySubsetNames) { template$subset <- rep(subsetName, nrow(template)) subsets <- rbind(subsets, template) } if (length(emptySubsetNames) == 1) { warning("The undefined subset ", emptySubsetNames, " was defined as empty subset", call. = FALSE) } else { warning(gettextf("The %s undefined subsets %s were defined as empty subsets", length(emptySubsetNames), .arrayToString(emptySubsetNames)), call. = FALSE) } } return(subsets) } .validateEnrichmentDataFrameAtFirstStage <- function(dataFrame, params) { dataFrameStage1 <- dataFrame[dataFrame$stage == 1, ] for (param in params) { paramValue <- dataFrameStage1[[param]] if (any(is.null(paramValue) || any(is.infinite(paramValue)))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, gettextf("all %s values (%s) at first stage must be valid", sQuote(param), .arrayToString(paramValue, maxLength = 10))) } if (any(is.na(paramValue))) { subsets <- unique(dataFrame$subset) for (s in subsets) { subData <- dataFrame[dataFrame$subset == s, ] subsetParamValues <- subData[[param]] if (!all(is.na(subsetParamValues)) && any(is.na(subsetParamValues[subData$stage == 1]))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, gettextf("all %s values (%s) at first stage must be valid (NA is not allowed)", sQuote(param), .arrayToString(paramValue, maxLength = 10))) } } } } } .getEndpointSpecificDataFrameParameterNames <- function(dataFrame) { paramNames <- colnames(dataFrame) paramNames <- paramNames[!(paramNames %in% c("stage", "group", "subset"))] return(paramNames) } .validateEnrichmentDataFrameDeselection <- function(dataFrame) { paramNames <- .getEndpointSpecificDataFrameParameterNames(dataFrame) for (i in 1:nrow(dataFrame)) { row <- dataFrame[i, paramNames] if (any(is.na(row)) && !all(is.na(row))) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, gettextf(paste0("inconsistent deselection in group %s at stage %s (", "%s: all or none must be NA)"), dataFrame$group[i], dataFrame$stage[i], .arrayToString(paramNames, maxCharacters = 40))) } } subsets <- unique(dataFrame$subset) for (s in subsets) { deselectedStage <- 0 for (stage in unique(dataFrame$stage)) { subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage, paramNames] if (deselectedStage > 0 && !all(is.na(subData))) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, gettextf(paste0("%s was deselected at stage %s ", "and therefore must be also deselected in the following stages, ", "but is no longer deselected in stage %s"), s, deselectedStage, stage)) } if (any(is.na(subData))) { deselectedStage <- stage } } } } .validateEnrichmentDataFrameMeans <- function(dataFrame) { if (any(na.omit(dataFrame$stDev) <= 0) || any(na.omit(dataFrame$overallStDev) <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all standard deviations must be > 0") } if (any(na.omit(dataFrame$sampleSize) <= 0) || any(na.omit(dataFrame$overallSampleSize) <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0") } .validateEnrichmentDataFrameAtFirstStage(dataFrame, params = c("sampleSize", "overallSampleSize", "mean", "overallMean", "stDev", "overallStDev")) .validateEnrichmentDataFrameDeselection(dataFrame) subsets <- unique(dataFrame$subset) if ("F" %in% subsets) { subsets <- subsets[subsets != "F"] fullData <- dataFrame[dataFrame$subset == "F", ] for (s in subsets) { for (stage in unique(dataFrame$stage)) { for (group in unique(dataFrame$group)) { subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] stDevFull <- na.omit(fullData$stDev[fullData$stage == stage & fullData$group == group]) stDevSubset <- na.omit(subData$stDev) if (length(stDevFull) > 0 && length(stDevSubset) > 0 && any(stDevFull <= stDevSubset)) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, gettextf("'stDev' F (%s) must be > 'stDev' %s (%s) in group %s at stage %s", .arrayToString(stDevFull), s, .arrayToString(stDevSubset), group, stage)) } sampleSizeFull <- na.omit(fullData$sampleSize[fullData$stage == stage & fullData$group == group]) sampleSizeSubset <- na.omit(subData$sampleSize) if (length(sampleSizeFull) > 0 && length(sampleSizeSubset) > 0 && any(sampleSizeFull < sampleSizeSubset)) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, gettextf("'sampleSize' F (%s) must be >= 'sampleSize' %s (%s) in group %s at stage %s", .arrayToString(sampleSizeFull), s, .arrayToString(sampleSizeSubset), group, stage)) } } } } } } .validateEnrichmentDataFrameSurvival <- function(dataFrame) { if (any(na.omit(dataFrame$event) < 0) || any(na.omit(dataFrame$overallEvent) < 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0") } .validateEnrichmentDataFrameAtFirstStage(dataFrame, params = c("event", "overallEvent")) .validateEnrichmentDataFrameDeselection(dataFrame) subsets <- unique(dataFrame$subset) if ("F" %in% subsets) { subsets <- subsets[subsets != "F"] fullData <- dataFrame[dataFrame$subset == "F", ] for (s in subsets) { for (stage in unique(dataFrame$stage)) { for (group in unique(dataFrame$group)) { subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] eventFull <- na.omit(fullData$event[fullData$stage == stage & fullData$group == group]) eventSubset <- na.omit(subData$event) if (length(eventFull) > 0 && length(eventSubset) > 0 && any(eventFull < eventSubset)) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, gettextf("'event' F (%s) must be >= 'event' %s (%s) in group %s at stage %s", .arrayToString(eventFull), s, .arrayToString(eventSubset), group, stage)) } } } } } } .validateEnrichmentDataFrameRates <- function(dataFrame) { if (any(na.omit(dataFrame$sampleSize) <= 0) || any(na.omit(dataFrame$overallSampleSize) <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0") } .validateEnrichmentDataFrameAtFirstStage(dataFrame, params = c("sampleSize", "overallSampleSize")) .validateEnrichmentDataFrameDeselection(dataFrame) subsets <- unique(dataFrame$subset) if ("F" %in% subsets) { subsets <- subsets[subsets != "F"] fullData <- dataFrame[dataFrame$subset == "F", ] for (s in subsets) { for (stage in unique(dataFrame$stage)) { for (group in unique(dataFrame$group)) { subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] sampleSizeFull <- na.omit(fullData$sampleSize[fullData$stage == stage & fullData$group == group]) sampleSizeSubset <- na.omit(subData$sampleSize) if (length(sampleSizeFull) > 0 && length(sampleSizeSubset) > 0 && any(sampleSizeFull < sampleSizeSubset)) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, gettextf("'sampleSize' F (%s) must be >= 'sampleSize' %s (%s) in group %s at stage %s", .arrayToString(sampleSizeFull), s, .arrayToString(sampleSizeSubset), group, stage)) } } } } } .validateEnrichmentDataFrameSurvival(dataFrame) } .validateEnrichmentDataFrameHasConsistentNumberOfStages <- function(dataFrame) { subsets <- unique(dataFrame$subset) kMaxList <- list() for (s in subsets) { subsetStages <- as.integer(sort(unique(na.omit(as.character(dataFrame$stage[dataFrame$subset == s]))))) kMax <- max(subsetStages) if (!identical(1:kMax, subsetStages)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, gettextf("subset %s has incomplete stages (%s)", s, .arrayToString(subsetStages))) } kMaxList[[s]] <- kMax } kMax <- unique(unlist(kMaxList)) if (length(kMax) > 1) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "all subsets must have the identical number of stages defined (kMax: ", .listToString(kMaxList), ")") } } .validateEnrichmentDataFrame <- function(dataFrame) { paramNames <- colnames(dataFrame) if (any(grepl("(S|s)tDev", paramNames))) { .validateEnrichmentDataFrameMeans(dataFrame) } else if (any(grepl("(S|s)ampleSize", paramNames)) && any(grepl("(E|e)vent", paramNames))) { .validateEnrichmentDataFrameRates(dataFrame) } else if (any(grepl("(L|l)ogRank", paramNames)) || any(grepl("(E|e)xpectedEvent", paramNames))) { .validateEnrichmentDataFrameSurvival(dataFrame) } else { print(paramNames) stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "could not identify the endpoint of the specified dataset") } subsets <- unique(dataFrame$subset) if ("R" %in% subsets) { paramNames <- .getEndpointSpecificDataFrameParameterNames(dataFrame) paramName <- paramNames[1] subsets <- subsets[subsets != "R"] subsets <- subsets[grepl("^S\\d$", subsets)] if (length(subsets) > 0) { restData <- dataFrame[dataFrame$subset == "R", ] for (s in subsets) { stages <- unique(dataFrame$stage) stages <- stages[stages != 1] if (length(stages) > 0) { for (stage in stages) { for (group in unique(dataFrame$group)) { subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] paramValueRest <- restData[[paramName]][restData$stage == stage & restData$group == group] paramValueSubset <- subData[[paramName]] if (length(paramValueRest) > 0 && length(paramValueSubset) > 0 && any(is.na(paramValueSubset)) && !all(is.na(paramValueRest))) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, gettextf(paste0("if %s is deselected (NA) then R also must be deselected (NA) but, e.g., ", "%s R is %s in group %s at stage %s"), s, sQuote(paramName), .arrayToString(paramValueRest, vectorLookAndFeelEnabled = TRUE), group, stage)) } } } } } } } .validateEnrichmentDataFrameHasConsistentNumberOfStages(dataFrame) } .getEnrichmentDataFrameFromArgs <- function(...) { dataFrame <- .getSubsetsFromArgs(...) validColumns <- c() for (j in 1:ncol(dataFrame)) { if (!all(is.na(dataFrame[, j]))) { validColumns <- c(validColumns, j) } } if (length(validColumns) > 0) { dataFrame <- dataFrame[, validColumns] } return(dataFrame) } .getEnrichmentDatasetFromArgs <- function(...) { dataFrame <- .getEnrichmentDataFrameFromArgs(...) .validateEnrichmentDataFrame(dataFrame) dataFrame <- .getWideFormat(dataFrame) return(getDataset(dataFrame = dataFrame)) } .getDatasetExample <- function(exampleType) { if (exampleType == "means") { return(getDataset( n1 = c(13, 25), n2 = c(15, NA), n3 = c(14, 27), n4 = c(12, 29), means1 = c(24.2, 22.2), means2 = c(18.8, NA), means3 = c(26.7, 27.7), means4 = c(9.2, 12.2), stDevs1 = c(24.4, 22.1), stDevs2 = c(21.2, NA), stDevs3 = c(25.6, 23.2), stDevs4 = c(21.5, 22.7))) } else if (exampleType == "rates") { return(getDataset( n1 = c(23, 25), n2 = c(25, NA), n3 = c(24, 27), n4 = c(22, 29), events1 = c(15, 12), events2 = c(19, NA), events3 = c(18, 22), events4 = c(12, 13))) } else if (exampleType == "survival") { return(getDataset( events1 = c(25, 32), events2 = c(18, NA), events3 = c(22, 36), logRanks1 = c(2.2,1.8), logRanks2 = c(1.99, NA), logRanks3 = c(2.32, 2.11))) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'exampleType' (", exampleType, ") is not allowed") } #' #' @name Dataset #' #' @title #' Dataset #' #' @description #' Basic class for datasets. #' #' @field stages The stage numbers. #' @field groups The group numbers. #' #' @details #' \code{Dataset} is the basic class for #' \itemize{ #' \item \code{\link{DatasetMeans}}, #' \item \code{\link{DatasetRates}}, and #' \item \code{\link{DatasetSurvival}}. #' } #' This basic class contains the fields \code{stages} and \code{groups} and several commonly used #' functions. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include f_core_constants.R #' @include f_core_assertions.R #' #' @keywords internal #' #' @importFrom methods new #' Dataset <- setRefClass("Dataset", contains = "ParameterSet", fields = list( .data = "data.frame", .plotSettings = "PlotSettings", .id = "integer", .description = "character", .floatingPointNumbersEnabled = "logical", .kMax = "integer", .enrichmentEnabled = "logical", .inputType = "character", stages = "integer", groups = "integer", subsets = "character" ), methods = list( initialize = function(dataFrame, ..., floatingPointNumbersEnabled = FALSE, enrichmentEnabled = FALSE) { callSuper(.floatingPointNumbersEnabled = floatingPointNumbersEnabled, .enrichmentEnabled = enrichmentEnabled, ...) .plotSettings <<- PlotSettings() .parameterNames <<- .getParameterNames(dataset = .self) .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS .id <<- NA_integer_ .description <<- NA_character_ .inputType <<- NA_character_ if (!missing(dataFrame)) { .initByDataFrame(dataFrame) .kMax <<- getNumberOfStages() if (!.enrichmentEnabled) { .validateDataset() } } }, getPlotSettings = function() { return(.plotSettings) }, show = function(showType = 1, digits = NA_integer_) { 'Method for automatically printing dataset objects' .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { .resetCat() if (!is.null(showType) && length(showType) == 1 && !is.na(showType) && is.character(showType) && showType == "rcmd") { s <- strsplit(getObjectRCode(.self, stringWrapParagraphWidth = NULL), "), *")[[1]] s[2:length(s)] <- paste0("\t", s[2:length(s)]) s <- paste0(s, collapse = "),\n") cat(s, "\n") } else if (showType == 2) { callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { .showParametersOfOneGroup(.getUserDefinedParameters(), title = .toString(startWithUpperCase = TRUE), orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getGeneratedParameters(), title = "Calculated data", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) if (!is.na(.description) && nchar(.description) > 0) { .cat("Description: ", .description, "\n\n", consoleOutputEnabled = consoleOutputEnabled) } } }, .initByDataFrame = function(dataFrame) { if (!is.data.frame(dataFrame)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataFrame' must be a data.frame (is an instance of class ", class(dataFrame), ")") } if (!.paramExists(dataFrame, "stage") && !.paramExists(dataFrame, "stages")) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataFrame' must contain parameter 'stages' or 'stage'") } stages <<- as.integer(.getValuesByParameterName(dataFrame, c("stages", "stage"))) if (!.enrichmentEnabled && length(unique(stages)) < length(stages)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stages' (", .arrayToString(stages), ") must be a unique vector of stage numbers") } groups <<- rep(1L, length(stages)) .setParameterType("groups", C_PARAM_USER_DEFINED) .setParameterType("stages", C_PARAM_USER_DEFINED) if (any(grepl("^subsets?\\d*$", colnames(dataFrame)))) { numberOfTreatmentGroups <- .getNumberOfGroups(dataFrame, c(C_KEY_WORDS_SAMPLE_SIZES, C_KEY_WORDS_LOG_RANKS)) subsets <<- character(0) for (group in 1:numberOfTreatmentGroups) { suffix <- ifelse(any(grepl("^subsets?\\d+$", colnames(dataFrame))), group, "") subsets <<- c(subsets, .getValuesByParameterName(dataFrame, C_KEY_WORDS_SUBSETS, suffix = suffix)) } .setParameterType("subsets", C_PARAM_USER_DEFINED) } else { subsets <<- rep(NA_character_, length(stages)) } }, .validateDataset = function() { .assertIsValidKMax(kMax = getNumberOfStages()) for (var in names(.self)) { values <- .self[[var]] if (any(is.nan(values)) || any(is.infinite(values))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'", var, "' (", .arrayToString(values), ") contains illegal values, i.e., something went wrong") } } }, .validateValues = function(values, name) { if (.enrichmentEnabled) { return(invisible()) } l1 <- length(unique(stages)) l2 <- length(values) if (l1 != l2) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "there ", ifelse(l1 == 1, paste("is", l1, "stage"), paste("are", l1, "stages")), " defined", " (", .arrayToString(unique(stages)), ") and '", name, "' has length ", l2) } }, .recreateDataFrame = function() { .data <<- data.frame( stage = factor(stages), group = factor(groups), subset = factor(subsets)) }, .setDataToVariables = function() { stages <<- as.integer(.data$stage) groups <<- as.integer(.data$group) subsets <<- as.character(.data$subset) }, .fillWithNAs = function(kMax) { numberOfStages <- getNumberOfStages() .kMax <<- numberOfStages if (numberOfStages >= kMax) { return(invisible()) } numberOfGroups <- getNumberOfGroups(survivalCorrectionEnabled = FALSE) if (.enrichmentEnabled) { for (stage in (numberOfStages + 1):kMax) { for (group in 1:numberOfGroups) { for (subset in levels(.data$subset)) { stages <<- c(stages, stage) groups <<- c(groups, group) subsets <<- c(subsets, subset) } } } } else { for (stage in (numberOfStages + 1):kMax) { for (group in 1:numberOfGroups) { stages <<- c(stages, stage) groups <<- c(groups, group) subsets <<- c(subsets, NA_character_) } } } }, .trim = function(kMax) { if (is.na(kMax)) { kMax <- .kMax } numberOfStages <- getNumberOfStages(FALSE) if (numberOfStages <= kMax) { return(invisible(numeric(0))) } indices <- which(stages <= kMax) stages <<- stages[indices] groups <<- groups[indices] subsets <<- subsets[indices] return(indices) }, .orderDataByStageAndGroup = function() { if (.enrichmentEnabled) { dat <- .data dat$char <- gsub("\\d", "", as.character(.data$subset)) dat$char[dat$char == "R"] <- "Z" dat$char[dat$char == "F"] <- "Z" dat$num <- as.integer(gsub("\\D", "", as.character(.data$subset))) .data <<- .data[order(.data$stage, .data$group, dat$char, dat$num), ] } else { .data <<- .data[order(.data$stage, .data$group), ] } }, .getNumberOfNAsToAdd = function(kMax) { n <- kMax - getNumberOfStages() if (n <= 0) { return(0) } n <- n * getNumberOfGroups(survivalCorrectionEnabled = FALSE) if (.enrichmentEnabled) { n <- n * getNumberOfSubsets() } return(n) }, .paramExists = function(dataFrame, parameterName) { for (p in parameterName) { value <- dataFrame[[p]] if (!is.null(value)) { return(TRUE) } } return(FALSE) }, .getValuesByParameterName = function(dataFrame, parameterNameVariants, ..., defaultValues = NULL, suffix = "") { for (parameterName in parameterNameVariants) { key <- paste0(parameterName, suffix) if (.paramExists(dataFrame, key)) { return(dataFrame[[key]]) } } if (!is.null(defaultValues)) { return(defaultValues) } stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "parameter '", paste0(parameterNameVariants[1], suffix), "' is missing or not correctly specified") }, .getValueLevels = function(values) { if (is.factor(values)) { return(levels(values)) } return(sort(unique(na.omit(values)))) }, .getValues = function(paramName, paramValues) { values <- .data[[paramName]] valueLevels <- .getValueLevels(values) if (!all(paramValues %in% valueLevels)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", paramName, "' (", .arrayToString(paramValues), ") out of range [", .arrayToString(valueLevels), "]") } return(values) }, .getIndexValues = function(paramName, paramValues, subset = NA_character_) { values <- .getValues(paramName, paramValues) if (all(is.na(subset))) { return(which(values %in% paramValues)) } .assertIsValidSubset(subset) return(which(values %in% paramValues & .data$subset %in% subset)) }, .assertIsValidSubset = function(subset) { for (s in subset) { if (!(s %in% levels(.data$subset))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'subset' (", s, ") is not a defined value [", .arrayToString(levels(.data$subset)), "]") } } }, .getIndices = function(..., stage, group, subset = NA_character_) { if (is.null(.data)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.data' must be defined") } if (!is.null(stage) && !any(is.na(stage)) && all(stage < 0)) { index <- 1:getNumberOfStages() stage <- index[!(index %in% abs(stage))] } if (!is.null(group) && !any(is.na(group)) && all(group < 0)) { index <- 1:getNumberOfGroups(survivalCorrectionEnabled = FALSE) group <- index[!(index %in% abs(group))] } # stage only and optional subset if (!is.null(group) && length(group) == 1 && is.na(group)) { return(.getIndexValues("stage", stage, subset)) } # group only and optional subset if (!is.null(stage) && length(stage) == 1 && is.na(stage)) { return(.getIndexValues("group", group, subset)) } # stage and group and optional subset stageValues <- .getValues("stage", stage) groupValues <- .getValues("group", group) if (all(is.na(subset))) { return(which(stageValues %in% stage & groupValues %in% group)) } .assertIsValidSubset(subset) return(which(stageValues %in% stage & groupValues %in% group & .data$subset %in% subset)) }, .getValidatedFloatingPointNumbers = function(x, parameterName = "Sample sizes") { if (.floatingPointNumbersEnabled) { return(x) } nToCheck <- stats::na.omit(x) if (any(nToCheck != as.integer(nToCheck))) { warning(parameterName, " specified as floating-point numbers were truncated", call. = FALSE) } x[!is.na(x)] <- as.integer(x[!is.na(x)]) return(x) }, .keyWordExists = function(dataFrame, keyWords, suffix = "") { for (key in keyWords) { if (.paramExists(dataFrame, paste0(key, suffix))) { return(TRUE) } } return(FALSE) }, .getNumberOfGroups = function(dataFrame, keyWords) { for (group in 2:1000) { if (!.keyWordExists(dataFrame, keyWords, group)) { return(group - 1) } } return(1) }, .getValidatedStage = function(stage = NA_integer_) { if (all(is.na(stage))) { stage <- c(1:getNumberOfStages()) } return(stage) }, getNumberOfGroups = function(survivalCorrectionEnabled = TRUE) { data <- stats::na.omit(.data) if (!survivalCorrectionEnabled) { return(length(levels(data$group))) } return(length(levels(data$group)) + ifelse(inherits(.self, "DatasetSurvival"), 1, 0)) }, getNumberOfStages = function(naOmitEnabled = TRUE) { if (naOmitEnabled) { colNames <- colnames(.data) validColNames <- character(0) for (colName in colNames) { colValues <- .data[, colName] if (length(colValues) > 0 && !all(is.na(colValues))) { validColNames <- c(validColNames, colName) } } subData <- stats::na.omit(.data[, validColNames]) numberOfStages <- length(unique(as.character(subData$stage))) if (numberOfStages == 0) { print(.data[, validColNames]) stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, ".data seems to contain an invalid column") } return(numberOfStages) } return(length(levels(.data$stage))) }, getNumberOfSubsets = function() { return(length(levels(.data$subset))) }, isDatasetMeans = function() { return(inherits(.self, "DatasetMeans")) }, isDatasetRates = function() { return(inherits(.self, "DatasetRates")) }, isDatasetSurvival = function() { return(inherits(.self, "DatasetSurvival")) }, isStratified = function() { return(.enrichmentEnabled && "R" %in% levels(.data$subset)) }, setId = function(id) { .id <<- as.integer(id) }, getId = function() { return(.id) }, setDescription = function(description) { .description <<- description }, getDescription = function() { return(.description) }, .toString = function(startWithUpperCase = FALSE) { s <- "dataset of " if (.enrichmentEnabled) { s <- paste0(s, "enrichment ") } else if (.self$getNumberOfGroups() > 2) { s <- paste0(s, "multi-arm ") } if (isDatasetMeans()) { s <- paste0(s, "means") } else if (isDatasetRates()) { s <- paste0(s, "rates") } else if (isDatasetSurvival()) { s <- paste0(s, "survival data") } else { s <- paste0(s, "unknown endpoint") } return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) } ) ) #' #' @name DatasetMeans #' #' @title #' Dataset of Means #' #' @description #' Class for a dataset of means. #' #' @field groups The group numbers. #' @field stages The stage numbers. #' @field sampleSizes The sample sizes. #' @field means The means. #' @field stDevs The standard deviations. #' #' @details #' This object cannot be created directly; better use \code{\link{getDataset}} #' with suitable arguments to create a dataset of means. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' DatasetMeans <- setRefClass("DatasetMeans", contains = "Dataset", fields = list( sampleSizes = "numeric", means = "numeric", stDevs = "numeric", overallSampleSizes = "numeric", overallMeans = "numeric", overallStDevs = "numeric" ), methods = list( getSampleSize = function(stage, group = 1, subset = NA_character_) { return(.data$sampleSize[.getIndices(stage = stage, group = group, subset = subset)]) }, getMean = function(stage, group = 1, subset = NA_character_) { return(.data$mean[.getIndices(stage = stage, group = group, subset = subset)]) }, getStDev = function(stage, group = 1, subset = NA_character_) { return(.data$stDev[.getIndices(stage = stage, group = group, subset = subset)]) }, getSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$sampleSize[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getMeans = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$mean[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getStDevs = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$stDev[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { return(.data$sampleSize[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getMeansUpTo = function(to, group = 1, subset = NA_character_) { return(.data$mean[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getStDevsUpTo = function(to, group = 1, subset = NA_character_) { return(.data$stDev[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallSampleSize = function(stage, group = 1, subset = NA_character_) { return(.data$overallSampleSize[.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallMean = function(stage, group = 1, subset = NA_character_) { return(.data$overallMean[.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallStDev = function(stage, group = 1, subset = NA_character_) { return(.data$overallStDev[.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$overallSampleSize[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getOverallMeans = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$overallMean[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getOverallStDevs = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$overallStDev[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getOverallSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { return(.data$overallSampleSize[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallMeansUpTo = function(to, group = 1, subset = NA_character_) { return(.data$overallMean[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallStDevsUpTo = function(to, group = 1, subset = NA_character_) { return(.data$overallStDev[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, .getValidatedSampleSizes = function(n) { return(.getValidatedFloatingPointNumbers(n, parameterName = "Sample sizes")) }, .initByDataFrame = function(dataFrame) { callSuper(dataFrame) # case: one mean - stage wise if (.paramExists(dataFrame, C_KEY_WORDS_SAMPLE_SIZES)) { .inputType <<- "stagewise" sampleSizes <<- .getValidatedSampleSizes(.getValuesByParameterName(dataFrame, C_KEY_WORDS_SAMPLE_SIZES)) .validateValues(sampleSizes, "n") if (any(stats::na.omit(sampleSizes) <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0, but 'n' = ", .arrayToString(sampleSizes, vectorLookAndFeelEnabled = TRUE)) } means <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_MEANS) .validateValues(means, "means") stDevs <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_ST_DEVS) .validateValues(stDevs, "stDevs") } # case: one mean - overall else if (.paramExists(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES)) { .inputType <<- "overall" overallSampleSizes <<- .getValidatedSampleSizes(.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES)) .validateValues(overallSampleSizes, "overallSampleSizes") overallMeans <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_MEANS) .validateValues(overallMeans, "overallMeans") overallStDevs <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_ST_DEVS) .validateValues(overallStDevs, "overallStDevs") } # case: two or more means - stage wise else if (.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 1)) && .paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 2))) { .inputType <<- "stagewise" numberOfTreatmentGroups <- .getNumberOfGroups(dataFrame, C_KEY_WORDS_SAMPLE_SIZES) stages <<- rep(stages, numberOfTreatmentGroups) groups <<- integer(0) sampleSizes <<- numeric(0) means <<- numeric(0) stDevs <<- numeric(0) for (group in 1:numberOfTreatmentGroups) { sampleSizesTemp <- .getValidatedSampleSizes(.getValuesByParameterName( dataFrame, C_KEY_WORDS_SAMPLE_SIZES, suffix = group)) .validateValues(sampleSizesTemp, paste0("n", group)) if (any(stats::na.omit(sampleSizesTemp) <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0, but 'n", group, "' = ", .arrayToString(sampleSizesTemp, vectorLookAndFeelEnabled = TRUE)) } sampleSizes <<- c(sampleSizes, sampleSizesTemp) meansTemp <- .getValuesByParameterName(dataFrame, C_KEY_WORDS_MEANS, suffix = group) .validateValues(meansTemp, paste0("means", group)) means <<- c(means, meansTemp) stDevsTemp <- .getValuesByParameterName(dataFrame, C_KEY_WORDS_ST_DEVS, suffix = group) .validateValues(stDevsTemp, paste0("stDevs", group)) stDevs <<- c(stDevs, stDevsTemp) groups <<- c(groups, rep(as.integer(group), length(sampleSizesTemp))) } } # case: two or more means - overall else if (.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 1)) && .paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 2))) { .inputType <<- "overall" numberOfTreatmentGroups <- .getNumberOfGroups(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES) stages <<- rep(stages, numberOfTreatmentGroups) groups <<- integer(0) sampleSizes <<- numeric(0) means <<- numeric(0) stDevs <<- numeric(0) overallSampleSizes <<- numeric(0) overallMeans <<- numeric(0) overallStDevs <<- numeric(0) for (group in 1:numberOfTreatmentGroups) { overallSampleSizesTemp <- .getValidatedSampleSizes(.getValuesByParameterName( dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES, suffix = group)) .validateValues(overallSampleSizesTemp, paste0("overallSampleSizes", group)) overallSampleSizes <<- c(overallSampleSizes, overallSampleSizesTemp) overallMeansTemp <- .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_MEANS, suffix = group) .validateValues(overallMeansTemp, paste0("overallMeans", group)) overallMeans <<- c(overallMeans, overallMeansTemp) overallStDevsTemp <- .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_ST_DEVS, suffix = group) .validateValues(overallStDevsTemp, paste0("overallStDevs", group)) overallStDevs <<- c(overallStDevs, overallStDevsTemp) groups <<- c(groups, rep(as.integer(group), length(overallSampleSizesTemp))) } } else { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "sample sizes are missing or not correctly specified") } if (.inputType == "stagewise") { n <- length(sampleSizes) overallSampleSizes <<- rep(NA_real_, n) overallMeans <<- rep(NA_real_, n) overallStDevs <<- rep(NA_real_, n) .setParameterType("sampleSizes", C_PARAM_USER_DEFINED) .setParameterType("means", C_PARAM_USER_DEFINED) .setParameterType("stDevs", C_PARAM_USER_DEFINED) .setParameterType("overallSampleSizes", C_PARAM_GENERATED) .setParameterType("overallMeans", C_PARAM_GENERATED) .setParameterType("overallStDevs", C_PARAM_GENERATED) .recreateDataFrame() .createOverallData() } else { n <- length(overallSampleSizes) sampleSizes <<- rep(NA_real_, n) means <<- rep(NA_real_, n) stDevs <<- rep(NA_real_, n) .setParameterType("sampleSizes", C_PARAM_GENERATED) .setParameterType("means", C_PARAM_GENERATED) .setParameterType("stDevs", C_PARAM_GENERATED) .setParameterType("overallSampleSizes", C_PARAM_USER_DEFINED) .setParameterType("overallMeans", C_PARAM_USER_DEFINED) .setParameterType("overallStDevs", C_PARAM_USER_DEFINED) .recreateDataFrame() .createStageWiseData() } if (sum(stats::na.omit(sampleSizes) < 0) > 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be >= 0") } if (sum(stats::na.omit(stDevs) < 0) > 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all standard deviations must be >= 0") } }, .recreateDataFrame = function() { callSuper() .data <<- cbind(.data, data.frame( sampleSize = sampleSizes, mean = means, stDev = stDevs, overallSampleSize = overallSampleSizes, overallMean = overallMeans, overallStDev = overallStDevs)) .orderDataByStageAndGroup() .setDataToVariables() }, .setDataToVariables = function() { callSuper() sampleSizes <<- .data$sampleSize means <<- .data$mean stDevs <<- .data$stDev overallSampleSizes <<- .data$overallSampleSize overallMeans <<- .data$overallMean overallStDevs <<- .data$overallStDev }, .fillWithNAs = function(kMax) { callSuper(kMax) n <- .getNumberOfNAsToAdd(kMax) naRealsToAdd <- rep(NA_real_, n) sampleSizes <<- c(sampleSizes, naRealsToAdd) means <<- c(means, naRealsToAdd) stDevs <<- c(stDevs, naRealsToAdd) overallSampleSizes <<- c(overallSampleSizes, naRealsToAdd) overallMeans <<- c(overallMeans, naRealsToAdd) overallStDevs <<- c(overallStDevs, naRealsToAdd) .recreateDataFrame() }, .trim = function(kMax = NA_integer_) { indices <- callSuper(kMax) if (length(indices) == 0) { return(invisible(FALSE)) } sampleSizes <<- sampleSizes[indices] means <<- means[indices] stDevs <<- stDevs[indices] overallSampleSizes <<- overallSampleSizes[indices] overallMeans <<- overallMeans[indices] overallStDevs <<- overallStDevs[indices] .recreateDataFrame() return(invisible(TRUE)) }, .getOverallMeans = function(sampleSizes, means) { return(cumsum(sampleSizes * means) / cumsum(sampleSizes)) }, .getOverallStDevs = function(sampleSizes, means, stDevs, overallMeans) { kMax <- length(sampleSizes) overallStDev <- rep(NA_real_, kMax) for (k in 1:kMax) { overallStDev[k] <- sqrt((sum((sampleSizes[1:k] - 1) * stDevs[1:k]^2) + sum(sampleSizes[1:k] * (means[1:k] - overallMeans[k])^2)) / (sum(sampleSizes[1:k]) - 1)) } return(overallStDev) }, .createOverallData = function() { .data$overallSampleSize <<- rep(NA_real_, nrow(.data)) .data$overallMean <<- rep(NA_real_, nrow(.data)) .data$overallStDev <<- rep(NA_real_, nrow(.data)) subsetLevels <- NA_character_ if (.enrichmentEnabled) { subsetLevels <- levels(.data$subset) } for (s in subsetLevels) { for (g in levels(.data$group)) { if (!is.na(s)) { indices <- which(.data$subset == s & .data$group == g) } else { indices <- which(.data$group == g) } .data$overallSampleSize[indices] <<- cumsum(.data$sampleSize[indices]) .data$overallMean[indices] <<- .getOverallMeans( .data$sampleSize[indices], .data$mean[indices]) .data$overallStDev[indices] <<- .getOverallStDevs(.data$sampleSize[indices], .data$mean[indices], .data$stDev[indices], .data$overallMean[indices]) } } .setDataToVariables() }, .getStageWiseSampleSizes = function(overallSampleSizes) { result <- overallSampleSizes if (length(overallSampleSizes) == 1) { return(result) } kMax <- length(overallSampleSizes) result[2:kMax] <- overallSampleSizes[2:kMax] - overallSampleSizes[1:(kMax - 1)] return(result) }, .getStageWiseMeans = function(sampleSizes, overallSampleSizes, overallMeans) { result <- overallMeans if (length(overallMeans) == 1) { return(result) } for (k in 2:length(overallMeans)) { result[k] <- (overallSampleSizes[k] * overallMeans[k] - overallSampleSizes[k - 1] * overallMeans[k - 1]) / sampleSizes[k] } return(result) }, .getStageWiseStDevs = function(overallStDevs, sampleSizes, overallSampleSizes, means, overallMeans) { result <- overallStDevs if (length(overallStDevs) == 1) { return(result) } for (k in 2:length(overallStDevs)) { result[k] <- sqrt(((overallSampleSizes[k] - 1) * overallStDevs[k]^2 - (overallSampleSizes[k - 1] - 1) * overallStDevs[k - 1]^2 + sum(sampleSizes[1:(k - 1)] * (means[1:(k - 1)] - overallMeans[k - 1])^2) - sum(sampleSizes[1:k] * (means[1:k] - overallMeans[k])^2)) / (sampleSizes[k] - 1)) } return(result) }, .createStageWiseData = function() { "Calculates stage-wise means and standard deviation if cunulative data is available" .data$sampleSize <<- rep(NA_real_, nrow(.data)) .data$mean <<- rep(NA_real_, nrow(.data)) .data$stDev <<- rep(NA_real_, nrow(.data)) subsetLevels <- NA_character_ if (.enrichmentEnabled) { subsetLevels <- levels(.data$subset) } for (s in subsetLevels) { for (g in levels(.data$group)) { if (!is.na(s)) { indices <- which(.data$subset == s & .data$group == g) } else { indices <- which(.data$group == g) } .assertValuesAreStrictlyIncreasing(.data$overallSampleSize[indices], paste0("overallSampleSizes", g), endingNasAllowed = TRUE) .data$sampleSize[indices] <<- .getStageWiseSampleSizes(.data$overallSampleSize[indices]) .data$mean[indices] <<- .getStageWiseMeans(.data$sampleSize[indices], .data$overallSampleSize[indices], .data$overallMean[indices]) .data$stDev[indices] <<- .getStageWiseStDevs( .data$overallStDev[indices], .data$sampleSize[indices], .data$overallSampleSize[indices], .data$mean[indices], .data$overallMean[indices]) } } .setDataToVariables() }, getRandomData = function() { return(.getRandomDataMeans(.self)) } ) ) ## Example: ## ## datasetExample <- getDataset( ## means1 = c(112.3, 105.1, 121.3), ## means2 = c(98.1, 99.3, 100.1), ## means3 = c(98.1, 99.3, 100.1), ## stDevs1 = c(44.4, 42.9, 41.4), ## stDevs2 = c(46.7, 41.1, 39.5), ## stDevs3 = c(46.7, 41.1, 39.5), ## n1 = c(84, 81, 82), ## n2 = c(87, 83, 81), ## n3 = c(87, 82, 84) ## ) ## .getRandomDataMeans(datasetExample, randomDataParamName = "outcome", numberOfVisits = 3, ## fixedCovariates = list(gender = c("f", "m"), bmi = c(17, 40))) ## .getRandomDataMeans = function(dataset, ..., treatmentName = "Treatment group", controlName = "Control group", randomDataParamName = "randomData", numberOfVisits = 1L, fixedCovariates = NULL, covariateEffects = NULL, seed = NA_real_) { if (!is.null(fixedCovariates)) { if (!is.list(fixedCovariates)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("fixedCovariates"), " must be a named list") } } if (!is.null(covariateEffects)) { if (!is.list(covariateEffects)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("covariateEffects"), " must be a named list") } } .assertIsSingleCharacter(treatmentName, "treatmentName") .assertIsSingleCharacter(controlName, "controlName") .assertIsSingleCharacter(randomDataParamName, "randomDataParamName") .assertIsSinglePositiveInteger(numberOfVisits, "numberOfVisits", validateType = FALSE) .assertIsSingleNumber(seed, "seed", naAllowed = TRUE) seed <- .setSeed(seed) numberOfGroups <- dataset$getNumberOfGroups() sampleSize <- 0 for (stage in 1:dataset$getNumberOfStages()) { for (group in 1:numberOfGroups) { if (dataset$.enrichmentEnabled) { for (subset in levels(dataset$.data$subset)) { n <- dataset$getSampleSize(stage = stage, group = group, subset = subset) if (n > sampleSize) { sampleSize <- n } } } else { n <- dataset$getSampleSize(stage = stage, group = group) n <- round(n / numberOfVisits) if (n > sampleSize) { sampleSize <- n } } } } idFactor <- 10^nchar(as.character(sampleSize)) data <- NULL for (stage in 1:dataset$getNumberOfStages()) { for (group in 1:numberOfGroups) { for (visit in 1:numberOfVisits) { if (dataset$.enrichmentEnabled) { for (subset in levels(dataset$.data$subset)) { n <- dataset$getSampleSize(stage = stage, group = group, subset = subset) randomData <- stats::rnorm( n = n, mean = dataset$getMean(stage = stage, group = group, subset = subset), sd = dataset$getStDev(stage = stage, group = group, subset = subset)) row <- data.frame( subject = idFactor * group + c(1:n), stage = rep(stage, n), group = rep(group, n), subset = rep(subset, n), randomData = randomData ) if (is.null(data)) { data <- row } else { data <- rbind(data, row) } } } else { n <- dataset$getSampleSize(stage = stage, group = group) n <- floor(n / numberOfVisits) randomData <- stats::rnorm( n = sampleSize, mean = dataset$getMean(stage = stage, group = group), sd = dataset$getStDev(stage = stage, group = group)) subjectIds <- (idFactor * 10 * stage) + (idFactor * group) + c(1:sampleSize) indices <- 1:sampleSize randomDataBefore <- NULL numberOfDropOutsBefore <- 0 if (visit > 1 && !is.null(data)) { randomDataBefore <- data$randomData[data$stage == visit - 1 & data$subject %in% subjectIds] numberOfDropOutsBefore <- sum(is.na(randomDataBefore)) indices <- which(!is.na(randomDataBefore)) } sampleSizeBefore <- sampleSize - numberOfDropOutsBefore if (n < sampleSizeBefore) { numberOfDropOuts <- sampleSizeBefore - n dropOuts <- sample(c(rep(1, n - numberOfDropOuts), rep(0, numberOfDropOuts))) randomData[indices[dropOuts == 0]] <- NA_real_ if (!is.null(randomDataBefore)) { randomData[is.na(randomDataBefore)] <- NA_real_ } } row <- data.frame( subject = subjectIds, stage = rep(stage, sampleSize), group = rep(group, sampleSize), visit = rep(visit - 1, sampleSize), randomData = randomData ) if (is.null(data)) { data <- row } else { data <- rbind(data, row) } } } } } data$stage <- factor(data$stage) groupLevels <- paste(treatmentName, c(1:numberOfGroups)) if (numberOfGroups > 1) { if (numberOfGroups == 2) { groupLevels[1] <- treatmentName } groupLevels[numberOfGroups] <- controlName } data$group <- factor(data$group, labels = groupLevels) if (dataset$.enrichmentEnabled) { data$subset <- factor(data$subset) } if (!is.null(randomDataParamName) && length(randomDataParamName) == 1 && !is.na(randomDataParamName)) { colNames <- colnames(data) colNames[colNames == "randomData"] <- randomDataParamName colnames(data) <- colNames } if (!is.null(fixedCovariates)) { fixedCovariateNames <- names(fixedCovariates) if (is.null(fixedCovariateNames) || any(nchar(trimws(fixedCovariateNames)) == 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("fixedCovariates"), " must be a named list") } subjects <- sort(unique(data$subject)) for (fixedCovariateName in fixedCovariateNames) { data[[fixedCovariateName]] <- rep(NA, nrow(data)) values <- fixedCovariates[[fixedCovariateName]] if (is.null(values) || length(values) < 2 || any(is.na(values))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(paste0("fixedCovariates$", fixedCovariateName)), " (", .arrayToString(values), ") must be a valid numeric or character vector with a minimum of 2 values") } if (is.character(values)) { if (length(unique(values)) < length(values)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(paste0("fixedCovariates$", fixedCovariateName)), " (", .arrayToString(values, maxLength = 20), ") must be a unique vector") } fixedCovariateSample <- sample(values, length(subjects), replace = TRUE) for (i in 1:length(subjects)) { data[[fixedCovariateName]][data$subject == subjects[i]] <- fixedCovariateSample[i] } } else if (is.numeric(values)) { if (length(values) == 2) { minValue <- min(values) maxValue <- max(values) covMean <- runif(1, minValue, maxValue) covSD <- covMean * 0.1 showMessage <- TRUE for (i in 1:length(subjects)) { groupName <- as.character(data$group[data$subject == subjects[i]])[1] covEffect <- 1 if (groupName == controlName && !is.null(covariateEffects)) { covEffect <- covariateEffects[[fixedCovariateName]] if (is.null(covEffect)) { covEffect <- 1 } else { .assertIsNumericVector(covEffect, paste0("covariateEffects$", fixedCovariateName)) if (showMessage) { message("Add effect ", covEffect, " to ", sQuote(fixedCovariateName), " of ", sQuote(groupName)) showMessage <- FALSE } } } continuesExample <- rnorm(sum(data$subject == subjects[i]), covMean * covEffect, covSD) data[[fixedCovariateName]][data$subject == subjects[i]] <- continuesExample } } } } } data$seed <- rep(seed, nrow(data)) return(data) } #' #' @title #' Dataset Plotting #' #' @description #' Plots a dataset. #' #' @param x The \code{\link{Dataset}} object to plot. #' @param y Not available for this kind of plot (is only defined to be compatible #' to the generic plot function). #' @param main The main title, default is \code{"Dataset"}. #' @param xlab The x-axis label, default is \code{"Stage"}. #' @param ylab The y-axis label. #' @param legendTitle The legend title, default is \code{"Group"}. #' @inheritParams param_palette #' @inheritParams param_showSource #' @inheritParams param_plotSettings #' @inheritParams param_three_dots_plot #' #' @details #' Generic function to plot all kinds of datasets. #' #' @template return_object_ggplot #' #' @examples #' # Plot a dataset of means #' dataExample <- getDataset( #' n1 = c(22, 11, 22, 11), #' n2 = c(22, 13, 22, 13), #' means1 = c(1, 1.1, 1, 1), #' means2 = c(1.4, 1.5, 3, 2.5), #' stDevs1 = c(1, 2, 2, 1.3), #' stDevs2 = c(1, 2, 2, 1.3)) #' \donttest{ #' if (require(ggplot2)) plot(dataExample, main = "Comparison of Means") #' } #' #' # Plot a dataset of rates #' dataExample <- getDataset( #' n1 = c(8, 10, 9, 11), #' n2 = c(11, 13, 12, 13), #' events1 = c(3, 5, 5, 6), #' events2 = c(8, 10, 12, 12) #' ) #' \donttest{ #' if (require(ggplot2)) plot(dataExample, main = "Comparison of Rates") #' } #' #' @export #' plot.Dataset <- function(x, y, ..., main = "Dataset", xlab = "Stage", ylab = NA_character_, legendTitle = "Group", palette = "Set1", showSource = FALSE, plotSettings = NULL) { if (x$.enrichmentEnabled) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "plot of enrichment data is not implemented yet") } .assertGgplotIsInstalled() if (x$isDatasetMeans()) { data <- x$getRandomData() if (is.na(ylab)) { ylab <- "Random data" } } else if (x$isDatasetRates()) { data <- x$.data if (is.na(ylab)) { ylab <- "Frequency (Events and Sample Size)" } } else if (x$isDatasetSurvival()) { # Open work: implement dataset plot of survival data stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "plot of survival data is not implemented yet") } if (!is.logical(showSource) || isTRUE(showSource)) { warning("'showSource' != FALSE is not implemented yet for class ", class(x)) } if (is.null(plotSettings)) { plotSettings <- x$getPlotSettings() } if (x$getNumberOfGroups() == 1) { if (x$isDatasetMeans()) { p <- ggplot2::ggplot(data = data, ggplot2::aes(y = .data[["randomData"]], x = factor(.data[["stage"]]))) p <- p + ggplot2::geom_boxplot(ggplot2::aes(fill = .data[["stage"]])) p <- p + ggplot2::geom_point(colour = "#0e414e", shape = 20, position = ggplot2::position_jitter(width = .1), size = plotSettings$pointSize) p <- p + ggplot2::stat_summary(fun = "mean", geom = "point", shape = 21, position = ggplot2::position_dodge(.75), size = 4, fill = "white", colour = "black", show.legend = FALSE) } else if (x$isDatasetRates()) { p <- ggplot2::ggplot(show.legend = FALSE) # plot sample size p <- p + ggplot2::geom_bar(data = data, ggplot2::aes(y = .data[["sampleSize"]], x = factor(.data[["stage"]]), fill = factor(.data[["stage"]])), position = "dodge", stat = "identity", alpha = 0.4) # plot events p <- p + ggplot2::geom_bar(data = data, ggplot2::aes(y = .data[["event"]], x = factor(.data[["stage"]]), fill = factor(.data[["stage"]])), position = "dodge", stat = "identity") } else if (x$isDatasetSurvival()) { # implement survival plot here } } else { data$stageGroup <- interaction(data$stage, data$group) if (x$isDatasetMeans()) { p <- ggplot2::ggplot(ggplot2::aes(y = .data[["randomData"]], x = factor(.data[["stage"]]), fill = factor(.data[["group"]])), data = data) p <- p + ggplot2::geom_point(ggplot2::aes(colour = .data[["group"]]), shape = 20, position = ggplot2::position_dodge(.75), size = plotSettings$pointSize) p <- p + ggplot2::geom_boxplot() p <- p + ggplot2::stat_summary(ggplot2::aes(colour = .data[["group"]]), fun = "mean", geom = "point", shape = 21, position = ggplot2::position_dodge(.75), size = 4, fill = "white", show.legend = FALSE) } else if (x$isDatasetRates()) { p <- ggplot2::ggplot(show.legend = FALSE) # plot sample size p <- p + ggplot2::geom_bar(ggplot2::aes(y = .data[["sampleSize"]], x = factor(.data[["stage"]]), fill = factor(.data[["group"]])), data = data, position = "dodge", stat = "identity", alpha = 0.4) # plot events p <- p + ggplot2::geom_bar(data = data, ggplot2::aes(y = .data[["event"]], x = factor(.data[["stage"]]), fill = factor(.data[["group"]])), position = "dodge", stat = "identity") } else if (x$isDatasetSurvival()) { # implement survival plot here } } # hide second legend if (x$getNumberOfGroups() == 1) { p <- p + ggplot2::guides(fill = FALSE, colour = FALSE) } else { p <- p + ggplot2::guides(colour = FALSE) } # set theme p <- plotSettings$setTheme(p) #p <- designSet$getPlotSettings()$hideGridLines(p) # set main title p <- plotSettings$setMainTitle(p, main) # set axes labels p <- plotSettings$setAxesLabels(p, xlab = xlab, ylab = ylab) # set legend if (x$getNumberOfGroups() > 1) { p <- plotSettings$setLegendPosition(p, legendPosition = C_POSITION_OUTSIDE_PLOT) p <- plotSettings$setLegendBorder(p) p <- plotSettings$setLegendTitle(p, legendTitle, mode = "fill") p <- plotSettings$setLegendLabelSize(p) } p <- plotSettings$setAxesAppearance(p) p <- plotSettings$setColorPalette(p, palette, mode = "all") p <- plotSettings$enlargeAxisTicks(p) companyAnnotationEnabled <- .getOptionalArgument("companyAnnotationEnabled", ...) if (is.null(companyAnnotationEnabled) || !is.logical(companyAnnotationEnabled)) { companyAnnotationEnabled <- FALSE } p <- plotSettings$addCompanyAnnotation(p, enabled = companyAnnotationEnabled) p } #' #' @name DatasetRates #' #' @title #' Dataset of Rates #' #' @description #' Class for a dataset of rates. #' #' @field groups The group numbers. #' @field stages The stage numbers. #' @field sampleSizes The sample sizes. #' @field events The events. #' @field overallSampleSizes The cumulative sample sizes. #' @field overallEvents The cumulative events. #' #' @details #' This object cannot be created directly; better use \code{\link{getDataset}} #' with suitable arguments to create a dataset of rates. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' DatasetRates <- setRefClass("DatasetRates", contains = "Dataset", fields = list( sampleSizes = "numeric", events = "numeric", overallSampleSizes = "numeric", overallEvents = "numeric" ), methods = list( getSampleSize = function(stage, group = 1, subset = NA_character_) { return(.data$sampleSize[.getIndices(stage = stage, group = group, subset = subset)]) }, getSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$sampleSize[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { return(.data$sampleSize[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getEvent = function(stage, group = 1, subset = NA_character_) { return(.data$event[.getIndices(stage = stage, group = group, subset = subset)]) }, getEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$event[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getEventsUpTo = function(to, group = 1, subset = NA_character_) { return(.data$event[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallSampleSize = function(stage, group = 1, subset = NA_character_) { return(.data$overallSampleSize[.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$overallSampleSize[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getOverallSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { return(.data$overallSampleSize[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallEvent = function(stage, group = 1, subset = NA_character_) { return(.data$overallEvent[.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$overallEvent[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getOverallEventsUpTo = function(to, group = 1, subset = NA_character_) { return(.data$overallEvent[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, .getValidatedSampleSizes = function(n) { return(.getValidatedFloatingPointNumbers(n, parameterName = "Sample sizes")) }, .initByDataFrame = function(dataFrame) { callSuper(dataFrame) # case: one rate - stage wise if (.paramExists(dataFrame, C_KEY_WORDS_SAMPLE_SIZES)) { .inputType <<- "stagewise" sampleSizes <<- .getValidatedSampleSizes( .getValuesByParameterName(dataFrame, C_KEY_WORDS_SAMPLE_SIZES)) .validateValues(sampleSizes, "n") if (any(stats::na.omit(sampleSizes) <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0, but 'n' = ", .arrayToString(sampleSizes, vectorLookAndFeelEnabled = TRUE)) } events <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS) .validateValues(events, "events") if (any(stats::na.omit(events) < 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0, but 'events' = ", .arrayToString(events, vectorLookAndFeelEnabled = TRUE)) } kMax <- length(sampleSizes) stageNumber <- length(stats::na.omit(sampleSizes)) dataInput <- data.frame( sampleSizes = sampleSizes, events = events) dataInput <- .getOverallData(dataInput, kMax, stage = stageNumber) overallSampleSizes <<- .getValidatedSampleSizes(dataInput$overallSampleSizes) overallEvents <<- dataInput$overallEvents .setParameterType("sampleSizes", C_PARAM_USER_DEFINED) .setParameterType("events", C_PARAM_USER_DEFINED) .setParameterType("overallSampleSizes", C_PARAM_GENERATED) .setParameterType("overallEvents", C_PARAM_GENERATED) } # case: one rate - overall else if (.paramExists(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES)) { .inputType <<- "overall" overallSampleSizes <<- .getValidatedSampleSizes(.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES)) .validateValues(overallSampleSizes, "overallSampleSizes") .assertValuesAreStrictlyIncreasing(overallSampleSizes, "overallSampleSizes", endingNasAllowed = TRUE) overallEvents <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS) .validateValues(overallEvents, "overallEvents") .assertValuesAreMonotoneIncreasing(overallEvents, "overallEvents", endingNasAllowed = TRUE) kMax <- length(overallSampleSizes) stageNumber <- length(stats::na.omit(overallSampleSizes)) stageWiseData <- .getStageWiseData(data.frame( overallSampleSizes = overallSampleSizes, overallEvents = overallEvents), kMax, stage = stageNumber) sampleSizes <<- .getValidatedSampleSizes(stageWiseData$sampleSizes) events <<- stageWiseData$events .setParameterType("sampleSizes", C_PARAM_GENERATED) .setParameterType("events", C_PARAM_GENERATED) .setParameterType("overallSampleSizes", C_PARAM_USER_DEFINED) .setParameterType("overallEvents", C_PARAM_USER_DEFINED) } # case: two or more rates - stage wise else if (.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 1)) && .paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 2))) { .inputType <<- "stagewise" numberOfTreatmentGroups <- .getNumberOfGroups(dataFrame, C_KEY_WORDS_SAMPLE_SIZES) stages <<- rep(stages, numberOfTreatmentGroups) groups <<- integer(0) sampleSizes <<- numeric(0) events <<- numeric(0) overallSampleSizes <<- numeric(0) overallEvents <<- numeric(0) for (group in 1:numberOfTreatmentGroups) { sampleSizesTemp <- .getValidatedSampleSizes(.getValuesByParameterName( dataFrame, C_KEY_WORDS_SAMPLE_SIZES, suffix = group)) .validateValues(sampleSizesTemp, paste0("n", group)) if (any(stats::na.omit(sampleSizesTemp) <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0, but 'n", group, "' = ", .arrayToString(sampleSizesTemp, vectorLookAndFeelEnabled = TRUE)) } sampleSizes <<- c(sampleSizes, sampleSizesTemp) eventsTemp <- .getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS, suffix = group) .validateValues(eventsTemp, paste0("events", group)) if (any(stats::na.omit(eventsTemp) < 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0, but 'events", group, "' = ", .arrayToString(eventsTemp, vectorLookAndFeelEnabled = TRUE)) } events <<- c(events, eventsTemp) groups <<- c(groups, rep(as.integer(group), length(sampleSizesTemp))) kMax <- length(sampleSizesTemp) numberOfValidStages <- length(stats::na.omit(sampleSizesTemp)) overallData <- .getOverallData(data.frame( sampleSizes = sampleSizesTemp, events = eventsTemp), kMax, stage = numberOfValidStages) overallSampleSizes <<- c(overallSampleSizes, .getValidatedSampleSizes(overallData$overallSampleSizes)) overallEvents <<- c(overallEvents, overallData$overallEvents) } if (sum(stats::na.omit(sampleSizes) < 0) > 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be >= 0") } .setParameterType("sampleSizes", C_PARAM_USER_DEFINED) .setParameterType("events", C_PARAM_USER_DEFINED) .setParameterType("overallSampleSizes", C_PARAM_GENERATED) .setParameterType("overallEvents", C_PARAM_GENERATED) } # case: two or more rates - overall else if (.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 1)) && .paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 2))) { .inputType <<- "overall" numberOfTreatmentGroups <- .getNumberOfGroups(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES) stages <<- rep(stages, numberOfTreatmentGroups) groups <<- integer(0) sampleSizes <<- numeric(0) events <<- numeric(0) overallSampleSizes <<- numeric(0) overallEvents <<- numeric(0) for (group in 1:numberOfTreatmentGroups) { overallSampleSizesTemp <- .getValidatedSampleSizes(.getValuesByParameterName( dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES, suffix = group)) .validateValues(overallSampleSizesTemp, paste0("overallSampleSizes", group)) .assertValuesAreStrictlyIncreasing(overallSampleSizesTemp, paste0("overallSampleSizes", group), endingNasAllowed = TRUE) overallSampleSizes <<- c(overallSampleSizes, overallSampleSizesTemp) overallEventsTemp <- .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS, suffix = group) .validateValues(overallEventsTemp, paste0("overallEvents", group)) .assertValuesAreMonotoneIncreasing(overallEventsTemp, paste0("overallEvents", group), endingNasAllowed = TRUE) overallEvents <<- c(overallEvents, overallEventsTemp) groups <<- c(groups, rep(as.integer(group), length(overallSampleSizesTemp))) kMax <- length(overallSampleSizesTemp) numberOfValidStages <- length(stats::na.omit(overallSampleSizesTemp)) stageWiseData <- .getStageWiseData(data.frame( overallSampleSizes = overallSampleSizesTemp, overallEvents = overallEventsTemp), kMax, stage = numberOfValidStages) validatedSampleSizes <- .getValidatedSampleSizes(stageWiseData$sampleSizes) .validateValues(validatedSampleSizes, paste0("n", group)) sampleSizes <<- c(sampleSizes, validatedSampleSizes) events <<- c(events, stageWiseData$events) if (sum(stats::na.omit(sampleSizes) < 0) > 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be >= 0") } } .setParameterType("sampleSizes", C_PARAM_GENERATED) .setParameterType("events", C_PARAM_GENERATED) .setParameterType("overallSampleSizes", C_PARAM_USER_DEFINED) .setParameterType("overallEvents", C_PARAM_USER_DEFINED) } else { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "sample sizes are missing or not correctly specified") } if (sum(stats::na.omit(events) < 0) > 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0") } .recreateDataFrame() if (.enrichmentEnabled) { .createOverallDataEnrichment() } }, .recreateDataFrame = function() { callSuper() .data <<- cbind(.data, data.frame( sampleSize = sampleSizes, event = events, overallSampleSize = overallSampleSizes, overallEvent = overallEvents)) .orderDataByStageAndGroup() .setDataToVariables() }, .setDataToVariables = function() { callSuper() sampleSizes <<- .data$sampleSize events <<- .data$event overallSampleSizes <<- .data$overallSampleSize overallEvents <<- .data$overallEvent }, .fillWithNAs = function(kMax) { callSuper(kMax) n <- .getNumberOfNAsToAdd(kMax) sampleSizes <<- c(sampleSizes, rep(NA_real_, n)) events <<- c(events, rep(NA_real_, n)) overallSampleSizes <<- c(overallSampleSizes, rep(NA_real_, n)) overallEvents <<- c(overallEvents, rep(NA_real_, n)) .recreateDataFrame() }, .trim = function(kMax = NA_integer_) { indices <- callSuper(kMax) if (length(indices) == 0) { return(invisible(FALSE)) } sampleSizes <<- sampleSizes[indices] events <<- events[indices] overallSampleSizes <<- overallSampleSizes[indices] overallEvents <<- overallEvents[indices] .recreateDataFrame() return(invisible(TRUE)) }, getRandomData = function() { data <- NULL for (stage in 1:getNumberOfStages()) { for (group in 1:getNumberOfGroups()) { if (.enrichmentEnabled) { for (subset in levels(.data$subset)) { n = getSampleSize(stage = stage, group = group, subset = subset) numberOfEvents <- getEvent(stage = stage, group = group, subset = subset) randomIndizes <- sample(x = c(1:n), size = numberOfEvents, replace = FALSE) randomData <- rep(0, n) randomData[randomIndizes] <- 1 row <- data.frame( stage = stage, group = group, subset = subset, randomData = randomData ) if (is.null(data)) { data <- row } else { data <- rbind(data, row) } } } else { n = getSampleSize(stage = stage, group = group) numberOfEvents <- getEvent(stage = stage, group = group) randomIndizes <- sample(x = c(1:n), size = numberOfEvents, replace = FALSE) randomData <- rep(0, n) randomData[randomIndizes] <- 1 row <- data.frame( stage = stage, group = group, randomData = randomData ) if (is.null(data)) { data <- row } else { data <- rbind(data, row) } } } } data$stage <- factor(data$stage) data$group <- factor(data$group, label=paste("Group", c(1:getNumberOfGroups()))) return(data) }, .createOverallDataEnrichment = function() { if (!.enrichmentEnabled) { return(invisible()) } .data$overallSampleSize <<- rep(NA_real_, nrow(.data)) .data$overallEvent <<- rep(NA_real_, nrow(.data)) for (s in levels(.data$subset)) { for (g in levels(.data$group)) { indices <- which(.data$subset == s & .data$group == g) .data$overallSampleSize[indices] <<- cumsum(.data$sampleSize[indices]) .data$overallEvent[indices] <<- cumsum(.data$event[indices]) } } .setDataToVariables() }, .getOverallData = function(dataInput, kMax, stage) { "Calculates cumulative values if stage-wise data is available" if (is.null(dataInput[["sampleSizes"]])) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "data input must contain variable 'sampleSizes'") } if (is.null(dataInput[["events"]])) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "data input must contain variable 'events'") } dataInput$overallSampleSizes <- c(cumsum(dataInput$sampleSizes[1:stage]), rep(NA_real_, kMax - stage)) dataInput$overallEvents <- c(cumsum(dataInput$events[1:stage]), rep(NA_real_, kMax - stage)) return(dataInput) }, .getStageWiseData = function(dataInput, kMax, stage) { "Calculates stage-wise values if cumulative data is available" if (is.null(dataInput[["overallSampleSizes"]])) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "data input must contain variable 'overallSampleSizes'") } if (is.null(dataInput[["overallEvents"]])) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "data input must contain variable 'overallEvents'") } dataInput$sampleSizes <- c(dataInput$overallSampleSizes[1:stage], rep(NA_real_, kMax - stage)) if (stage > 1) { dataInput$sampleSizes[2:stage] <- dataInput$overallSampleSizes[2:stage] - dataInput$overallSampleSizes[1:(stage - 1)] } dataInput$events <- c(dataInput$overallEvents[1:stage], rep(NA_real_, kMax - stage)) if (stage > 1) { dataInput$events[2:stage] <- dataInput$overallEvents[2:stage] - dataInput$overallEvents[1:(stage - 1)] } return(dataInput) } ) ) #' #' @name DatasetSurvival #' #' @title #' Dataset of Survival Data #' #' @description #' Class for a dataset of survival data. #' #' @field groups The group numbers. #' @field stages The stage numbers. #' @field overallEvents The cumulative events. #' @field overallAllocationRatios The cumulative allocations ratios. #' @field overallLogRanks The overall logrank test statistics. #' @field allocationRatios The allocation ratios. #' @field logRanks The logrank test statistics. #' #' @details #' This object cannot be created directly; better use \code{\link{getDataset}} #' with suitable arguments to create a dataset of survival data. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' DatasetSurvival <- setRefClass("DatasetSurvival", contains = "Dataset", fields = list( overallEvents = "numeric", overallAllocationRatios = "numeric", overallLogRanks = "numeric", events = "numeric", allocationRatios = "numeric", logRanks = "numeric" ), methods = list( getEvent = function(stage, group = 1, subset = NA_character_) { return(.data$event[.getIndices(stage = stage, group = group, subset = subset)]) }, getEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$event[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getEventsUpTo = function(to, group = 1, subset = NA_character_) { return(.data$event[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getAllocationRatio = function(stage, group = 1, subset = NA_character_) { return(.data$allocationRatio[.getIndices(stage = stage, group = group, subset = subset)]) }, getAllocationRatios = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$allocationRatio[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getAllocationRatiosUpTo = function(to, group = 1, subset = NA_character_) { return(.data$allocationRatio[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getLogRank = function(stage, group = 1, subset = NA_character_) { return(.data$logRank[.getIndices(stage = stage, group = group, subset = subset)]) }, getLogRanks = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$logRank[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getLogRanksUpTo = function(to, group = 1, subset = NA_character_) { return(.data$logRank[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallEvent = function(stage, group = 1, subset = NA_character_) { return(.data$overallEvent[.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$overallEvent[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getOverallEventsUpTo = function(to, group = 1, subset = NA_character_) { return(.data$overallEvent[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallAllocationRatio = function(stage, group = 1, subset = NA_character_) { return(.data$overallAllocationRatio[.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallAllocationRatios = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$overallAllocationRatio[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getOverallAllocationRatiosUpTo = function(to, group = 1, subset = NA_character_) { return(.data$overallAllocationRatio[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallLogRank = function(stage, group = 1, subset = NA_character_) { return(.data$overallLogRank[.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallLogRanks = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$overallLogRank[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getOverallLogRanksUpTo = function(to, group = 1, subset = NA_character_) { return(.data$overallLogRank[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, .getAllocationRatioDefaultValues = function(stages, events, logRanks) { allocationRatioDefaultValues <- rep(C_ALLOCATION_RATIO_DEFAULT, length(stages)) indices <- which(is.na(events) | is.na(logRanks)) allocationRatioDefaultValues[indices] <- NA_real_ return(allocationRatioDefaultValues) }, .initByDataFrame = function(dataFrame) { callSuper(dataFrame) if (inherits(.self, "DatasetEnrichmentSurvival")) { if (.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) || .paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { .inputType <<- "stagewise" events <<- .getValidatedFloatingPointNumbers( .getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS), parameterName = "Events") .validateValues(events, "events") allocationRatios <<- .getValuesByParameterName( dataFrame, C_KEY_WORDS_ALLOCATION_RATIOS, defaultValues = .getAllocationRatioDefaultValues(stages, events, expectedEvents)) .validateValues(allocationRatios, "allocationRatios") } else if (.paramExists(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS) || .paramExists(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) { .inputType <<- "overall" overallEvents <<- .getValidatedFloatingPointNumbers( .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), parameterName = "Cumulative events") .validateValues(overallEvents, "overallEvents") overallAllocationRatios <<- .getValuesByParameterName( dataFrame, parameterNameVariants = C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, defaultValues = .getAllocationRatioDefaultValues(stages, overallEvents, overallExpectedEvents)) .validateValues(overallAllocationRatios, "overallAllocationRatios") } # stratified enrichment: do nothing more here } # case: survival, two groups - overall else if (.paramExists(dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS)) { .inputType <<- "overall" overallEvents <<- .getValidatedFloatingPointNumbers( .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), parameterName = "Cumulative events") .validateValues(overallEvents, "overallEvents") if (!.enrichmentEnabled) { .assertValuesAreStrictlyIncreasing(overallEvents, "overallEvents", endingNasAllowed = TRUE) } overallLogRanks <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS) .validateValues(overallLogRanks, "overallLogRanks") overallAllocationRatios <<- .getValuesByParameterName( dataFrame, parameterNameVariants = C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, defaultValues = .getAllocationRatioDefaultValues(stages, overallEvents, overallLogRanks)) .validateValues(overallAllocationRatios, "overallAllocationRatios") .setParameterType("groups", C_PARAM_NOT_APPLICABLE) } # case: survival, two groups - stage wise else if (.paramExists(dataFrame, C_KEY_WORDS_LOG_RANKS)) { .inputType <<- "stagewise" events <<- .getValidatedFloatingPointNumbers(.getValuesByParameterName( dataFrame, C_KEY_WORDS_EVENTS), parameterName = "Events") .validateValues(events, "events") if (any(stats::na.omit(events) < 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0") } logRanks <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_LOG_RANKS) .validateValues(logRanks, "logRanks") allocationRatios <<- .getValuesByParameterName( dataFrame, C_KEY_WORDS_ALLOCATION_RATIOS, defaultValues = .getAllocationRatioDefaultValues(stages, events, logRanks)) .validateValues(allocationRatios, "allocationRatios") .setParameterType("groups", C_PARAM_NOT_APPLICABLE) } # case: survival, three ore more groups - overall else if (.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_LOG_RANKS, 1)) && .paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_LOG_RANKS, 2))) { .inputType <<- "overall" numberOfTreatmentGroups <- .getNumberOfGroups(dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS) stages <<- rep(stages, numberOfTreatmentGroups) groups <<- integer(0) overallEvents <<- numeric(0) overallAllocationRatios <<- numeric(0) overallLogRanks <<- numeric(0) for (group in 1:numberOfTreatmentGroups) { overallEventsTemp <- .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS, suffix = group) .validateValues(overallEventsTemp, paste0("overallEvents", group)) .assertValuesAreStrictlyIncreasing(overallEventsTemp, paste0("overallEvents", group), endingNasAllowed = TRUE) overallEvents <<- c(overallEvents, overallEventsTemp) overallLogRanksTemp <- .getValuesByParameterName( dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS, suffix = group) .validateValues(overallLogRanksTemp, paste0("overallLogRanks", group)) overallLogRanks <<- c(overallLogRanks, overallLogRanksTemp) overallAllocationRatiosTemp <- .getValuesByParameterName( dataFrame, C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, suffix = group, defaultValues = .getAllocationRatioDefaultValues(overallEventsTemp, overallEventsTemp, overallLogRanksTemp)) .validateValues(overallAllocationRatiosTemp, paste0("overallAllocationRatios", group)) overallAllocationRatios <<- c(overallAllocationRatios, overallAllocationRatiosTemp) groups <<- c(groups, rep(as.integer(group), length(overallLogRanksTemp))) } } # case: survival, three ore more groups - stage wise else if (.paramExists(dataFrame, paste0(C_KEY_WORDS_LOG_RANKS, 1)) && .paramExists(dataFrame, paste0(C_KEY_WORDS_LOG_RANKS, 2))) { .inputType <<- "stagewise" numberOfTreatmentGroups <- .getNumberOfGroups(dataFrame, C_KEY_WORDS_LOG_RANKS) stages <<- rep(stages, numberOfTreatmentGroups) groups <<- integer(0) events <<- numeric(0) allocationRatios <<- numeric(0) logRanks <<- numeric(0) for (group in 1:numberOfTreatmentGroups) { eventsTemp <- .getValidatedFloatingPointNumbers(.getValuesByParameterName( dataFrame, C_KEY_WORDS_EVENTS, suffix = group), parameterName = "Events") if (any(stats::na.omit(eventsTemp) < 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0, but 'events", group, "' = ", .arrayToString(eventsTemp, vectorLookAndFeelEnabled = TRUE)) } events <<- c(events, eventsTemp) logRanksTemp <- .getValuesByParameterName( dataFrame, C_KEY_WORDS_LOG_RANKS, suffix = group) .validateValues(logRanksTemp, paste0("n", group)) logRanks <<- c(logRanks, logRanksTemp) allocationRatiosTemp <- .getValuesByParameterName( dataFrame, C_KEY_WORDS_ALLOCATION_RATIOS, suffix = group, defaultValues = .getAllocationRatioDefaultValues(eventsTemp, eventsTemp, logRanksTemp)) .validateValues(allocationRatiosTemp, paste0("allocationRatios", group)) allocationRatios <<- c(allocationRatios, allocationRatiosTemp) groups <<- c(groups, rep(as.integer(group), length(eventsTemp))) } } else { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "unable to identify case for ", class(.self), " and columns ", .arrayToString(colnames(dataFrame))) } if (.inputType == "stagewise") { n <- length(events) overallEvents <<- rep(NA_real_, n) overallAllocationRatios <<- rep(NA_real_, n) overallLogRanks <<- rep(NA_real_, n) .setParameterType("events", C_PARAM_USER_DEFINED) .setParameterType("allocationRatios", C_PARAM_USER_DEFINED) if (!inherits(.self, "DatasetEnrichmentSurvival")) { .setParameterType("logRanks", C_PARAM_USER_DEFINED) } .setParameterType("overallEvents", C_PARAM_GENERATED) .setParameterType("overallAllocationRatios", C_PARAM_GENERATED) if (!inherits(.self, "DatasetEnrichmentSurvival")) { .setParameterType("overallLogRanks", C_PARAM_GENERATED) } if (!inherits(.self, "DatasetEnrichmentSurvival")) { .recreateDataFrame() .createOverallData() } } else { n <- length(overallEvents) events <<- rep(NA_real_, n) allocationRatios <<- rep(NA_real_, n) logRanks <<- rep(NA_real_, n) .setParameterType("events", C_PARAM_GENERATED) .setParameterType("allocationRatios", C_PARAM_GENERATED) if (!inherits(.self, "DatasetEnrichmentSurvival")) { .setParameterType("logRanks", C_PARAM_GENERATED) } .setParameterType("overallEvents", C_PARAM_USER_DEFINED) .setParameterType("overallAllocationRatios", C_PARAM_USER_DEFINED) if (!inherits(.self, "DatasetEnrichmentSurvival")) { .setParameterType("overallLogRanks", C_PARAM_USER_DEFINED) } if (!inherits(.self, "DatasetEnrichmentSurvival")) { .recreateDataFrame() .createStageWiseData() } } }, .recreateDataFrame = function() { callSuper() if (inherits(.self, "DatasetEnrichmentSurvival")) { .data <<- cbind(.data, data.frame( overallEvent = overallEvents, overallExpectedEvent = overallExpectedEvents, overallVarianceEvent = overallVarianceEvents, overallAllocationRatio = overallAllocationRatios, event = events, expectedEvent = expectedEvents, # varianceEvent = varianceEvents, # maybe implemented later allocationRatio = allocationRatios)) } else { .data <<- cbind(.data, data.frame( overallEvent = overallEvents, overallAllocationRatio = overallAllocationRatios, overallLogRank = overallLogRanks, event = events, allocationRatio = allocationRatios, logRank = logRanks)) } .orderDataByStageAndGroup() .setDataToVariables() }, .setDataToVariables = function() { callSuper() overallEvents <<- .data$overallEvent overallAllocationRatios <<- .data$overallAllocationRatio events <<- .data$event allocationRatios <<- .data$allocationRatio if (!inherits(.self, "DatasetEnrichmentSurvival")) { overallLogRanks <<- .data$overallLogRank logRanks <<- .data$logRank } }, .fillWithNAs = function(kMax) { callSuper(kMax) n <- .getNumberOfNAsToAdd(kMax) overallEvents <<- c(overallEvents, rep(NA_real_, n)) overallAllocationRatios <<- c(overallAllocationRatios, rep(NA_real_, n)) overallLogRanks <<- c(overallLogRanks, rep(NA_real_, n)) events <<- c(events, rep(NA_real_, n)) allocationRatios <<- c(allocationRatios, rep(NA_real_, n)) logRanks <<- c(logRanks, rep(NA_real_, n)) .recreateDataFrame() }, .trim = function(kMax = NA_integer_) { indices <- callSuper(kMax) if (length(indices) == 0) { return(invisible(FALSE)) } events <<- events[indices] allocationRatios <<- allocationRatios[indices] logRanks <<- logRanks[indices] overallEvents <<- overallEvents[indices] overallAllocationRatios <<- overallAllocationRatios[indices] overallLogRanks <<- overallLogRanks[indices] .recreateDataFrame() return(invisible(TRUE)) }, getRandomData = function() { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "the function 'DatasetSurvival.getRandomData()' is not implemented yet") }, .getOverallLogRanks = function(logRanks, events, overallEvents, kMax = length(logRanks), stage = length(logRanks)) { result <- c(logRanks[1:stage], rep(NA_real_, kMax - stage)) if (stage == 1) { return(result) } for (k in 2:stage) { result[k] <- (sqrt(events[k]) * logRanks[k] + sqrt(overallEvents[k - 1]) * result[k - 1]) / sqrt(overallEvents[k]) } return(result) }, .getOverallAllocationRatios = function(allocationRatios, events, overallEvents, kMax = length(allocationRatios), stage = length(allocationRatios)) { result <- c(allocationRatios[1:stage], rep(NA_real_, kMax - stage)) if (stage == 1) { return(result) } for (k in 2:stage) { result[k] <- (events[k] * allocationRatios[k] + overallEvents[k - 1] * result[k - 1]) / overallEvents[k] } return(result) }, .createOverallData = function() { .data$overallEvent <<- rep(NA_real_, nrow(.data)) if (inherits(.self, "DatasetEnrichmentSurvival")) { .data$overallExpectedEvent <<- rep(NA_real_, nrow(.data)) .data$overallVarianceEvent <<- rep(NA_real_, nrow(.data)) } else { .data$overallLogRank <<- rep(NA_real_, nrow(.data)) } .data$overallAllocationRatio <<- rep(NA_real_, nrow(.data)) subsetLevels <- NA_character_ if (.enrichmentEnabled) { subsetLevels <- levels(.data$subset) } for (s in subsetLevels) { for (g in levels(.data$group)) { if (!is.na(s)) { indices <- which(.data$subset == s & .data$group == g) } else { indices <- which(.data$group == g) } .data$overallEvent[indices] <<- cumsum(.data$event[indices]) .data$overallExpectedEvent[indices] <<- cumsum(.data$expectedEvent[indices]) #.data$overallVarianceEvent[indices] <<- # maybe implemented later .data$overallLogRank[indices] <<- .getOverallLogRanks( .data$logRank[indices], .data$event[indices], .data$overallEvent[indices]) .data$overallAllocationRatio[indices] <<- .getOverallAllocationRatios( .data$allocationRatio[indices], .data$event[indices], .data$overallEvent[indices]) } } .setDataToVariables() }, .getStageWiseEvents = function(overallEvents) { result <- overallEvents if (length(result) == 1) { return(result) } kMax <- length(result) result[2:kMax] <- overallEvents[2:kMax] - overallEvents[1:(kMax - 1)] return(result) }, .getStageWiseLogRanks = function(overallLogRanks, overallEvents) { result <- overallLogRanks if (length(result) == 1) { return(result) } kMax <- length(result) result[2:kMax] <- (sqrt(overallEvents[2:kMax]) * overallLogRanks[2:kMax] - sqrt(overallEvents[1:(kMax - 1)]) * overallLogRanks[1:(kMax - 1)]) / sqrt(overallEvents[2:kMax] - overallEvents[1:(kMax - 1)]) return(result) }, .getStageWiseAllocationRatios = function(overallAllocationRatios, events, overallEvents) { result <- overallAllocationRatios if (length(result) == 1) { return(result) } kMax <- length(result) result[2:kMax] <- ( overallAllocationRatios[2:kMax] - overallAllocationRatios[1:(kMax - 1)] * overallEvents[1:(kMax - 1)] / overallEvents[2:kMax] ) / (events[2:kMax] / overallEvents[2:kMax]) if (any(stats::na.omit(result) <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "overall allocation ratios not correctly specified: ", "one or more calculated stage-wise allocation ratios <= 0") } return(result) }, .createStageWiseData = function() { "Calculates stage-wise logrank statistics, events, and allocation ratios if cumulative data is available" .data$event <<- rep(NA_real_, nrow(.data)) if (inherits(.self, "DatasetEnrichmentSurvival")) { .data$expectedEvent <<- rep(NA_real_, nrow(.data)) .data$varianceEvent <<- rep(NA_real_, nrow(.data)) } else { .data$logRank <<- rep(NA_real_, nrow(.data)) } .data$allocationRatio <<- rep(NA_real_, nrow(.data)) subsetLevels <- NA_character_ if (.enrichmentEnabled) { subsetLevels <- levels(.data$subset) } for (s in subsetLevels) { for (g in levels(.data$group)) { if (!is.na(s)) { indices <- which(.data$subset == s & .data$group == g) } else { indices <- which(.data$group == g) } groupNumber <- ifelse(levels(.data$group) > 1, g, "") if (.enrichmentEnabled) { .assertValuesAreStrictlyIncreasing(.data$overallEvent[indices], paste0("overallEvents", groupNumber, "[subset == \"", s, "\"]"), endingNasAllowed = TRUE) } else { .assertValuesAreStrictlyIncreasing(.data$overallEvent[indices], paste0("overallEvents", groupNumber), endingNasAllowed = TRUE) } .data$event[indices] <<- .getStageWiseEvents(.data$overallEvent[indices]) if (inherits(.self, "DatasetEnrichmentSurvival")) { .data$expectedEvent[indices] <<- .getStageWiseEvents(.data$overallExpectedEvent[indices]) #.data$varianceEvent[indices] <<- # maybe implemented later } else { .data$logRank[indices] <<- .getStageWiseLogRanks( .data$overallLogRank[indices], .data$overallEvent[indices]) } .data$allocationRatio[indices] <<- .getStageWiseAllocationRatios(.data$overallAllocationRatio[indices], .data$event[indices], .data$overallEvent[indices]) } } .setDataToVariables() } ) ) # Dataset for non-stratified analysis DatasetEnrichmentSurvival <- setRefClass("DatasetEnrichmentSurvival", contains = "DatasetSurvival", fields = list( expectedEvents = "numeric", varianceEvents = "numeric", overallExpectedEvents = "numeric", overallVarianceEvents = "numeric" ), methods = list( .initByDataFrame = function(dataFrame) { callSuper(dataFrame) if (.paramExists(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS) || .paramExists(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) { if (!.paramExists(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'overallExpectedEvents' is missing") } if (!.paramExists(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'overallVarianceEvents' is missing") } .inputType <<- "overall" overallEvents <<- .getValidatedFloatingPointNumbers( .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), parameterName = "Cumulative events") .validateValues(overallEvents, "overallEvents") overallExpectedEvents <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS) .validateValues(overallExpectedEvents, "overallExpectedEvents") overallVarianceEvents <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS) .validateValues(overallVarianceEvents, "overallVarianceEvents") overallAllocationRatios <<- .getValuesByParameterName( dataFrame, parameterNameVariants = C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, defaultValues = .getAllocationRatioDefaultValues(stages, overallEvents, overallExpectedEvents)) .validateValues(overallAllocationRatios, "overallAllocationRatios") } else if (.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) || .paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { if (!.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'expectedEvents' is missing") } if (!.paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'varianceEvents' is missing") } .inputType <<- "stagewise" events <<- .getValidatedFloatingPointNumbers( .getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS), parameterName = "Events") .validateValues(events, "events") expectedEvents <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) .validateValues(expectedEvents, "expectedEvents") varianceEvents <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS) .validateValues(varianceEvents, "varianceEvents") allocationRatios <<- .getValuesByParameterName( dataFrame, parameterNameVariants = C_KEY_WORDS_ALLOCATION_RATIOS, defaultValues = .getAllocationRatioDefaultValues(stages, events, expectedEvents)) .validateValues(allocationRatios, "allocationRatios") } .setParameterType("groups", C_PARAM_NOT_APPLICABLE) if (.inputType == "stagewise") { n <- length(events) overallExpectedEvents <<- rep(NA_real_, n) overallVarianceEvents <<- rep(NA_real_, n) .setParameterType("events", C_PARAM_USER_DEFINED) .setParameterType("allocationRatios", C_PARAM_USER_DEFINED) .setParameterType("expectedEvents", C_PARAM_USER_DEFINED) .setParameterType("varianceEvents", C_PARAM_USER_DEFINED) .setParameterType("overallEvents", C_PARAM_GENERATED) .setParameterType("overallAllocationRatios", C_PARAM_GENERATED) .setParameterType("overallExpectedEvents", C_PARAM_GENERATED) .setParameterType("overallVarianceEvents", C_PARAM_GENERATED) .recreateDataFrame() .createOverallData() } else { n <- length(overallEvents) expectedEvents <<- rep(NA_real_, n) varianceEvents <<- rep(NA_real_, n) .setParameterType("events", C_PARAM_GENERATED) .setParameterType("allocationRatios", C_PARAM_GENERATED) .setParameterType("expectedEvents", C_PARAM_GENERATED) .setParameterType("varianceEvents", C_PARAM_GENERATED) .setParameterType("overallEvents", C_PARAM_USER_DEFINED) .setParameterType("overallAllocationRatios", C_PARAM_USER_DEFINED) .setParameterType("overallExpectedEvents", C_PARAM_USER_DEFINED) .setParameterType("overallVarianceEvents", C_PARAM_USER_DEFINED) .recreateDataFrame() .createStageWiseData() } }, .getVisibleFieldNames = function() { visibleFieldNames <- callSuper() visibleFieldNames <- visibleFieldNames[!(visibleFieldNames %in% c("logRanks", "overallLogRanks"))] return(visibleFieldNames) }, .setDataToVariables = function() { callSuper() overallExpectedEvents <<- .data$overallExpectedEvent overallVarianceEvents <<- .data$overallVarianceEvent expectedEvents <<- .data$expectedEvent }, getOverallExpectedEvent = function(stage, group = 1, subset = NA_character_) { return(.data$overallExpectedEvent[.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallExpectedEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$overallExpectedEvent[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getOverallExpectedEventsUpTo = function(to, group = 1, subset = NA_character_) { return(.data$overallExpectedEvent[.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallVarianceEvent = function(stage, group = 1, subset = NA_character_) { return(.data$overallVarianceEvent[.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallVarianceEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { return(.data$overallVarianceEvent[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) }, getOverallVarianceEventsUpTo = function(to, group = 1, subset = NA_character_) { return(.data$overallVarianceEvent[.getIndices(stage = c(1:to), group = group, subset = subset)]) } ) ) .isFloatingPointSampleSize <- function(object, param) { values <- object[[param]] if (is.null(values)) { return(FALSE) } values <- na.omit(values) if (length(values) == 0) { return(FALSE) } if (any(floor(values) != values)) { return(TRUE) } return(FALSE) } .getMaxDigits <- function(values) { values <- na.omit(values) if (length(values) == 0) { return(0) } values <- trimws(format(values, scientific = FALSE, digits = 15)) values <- gsub("^\\d*\\.", "", values) values <- gsub("\\D", "", values) max(nchar(values)) } #' #' @name Dataset_summary #' #' @title #' Dataset Summary #' #' @description #' Displays a summary of \code{\link{Dataset}} object. #' #' @param object A \code{\link{Dataset}} object. #' @inheritParams param_digits #' @inheritParams param_three_dots #' #' @details #' Summarizes the parameters and results of a dataset. #' #' @template details_summary #' #' @template return_object_summary #' @template how_to_get_help_for_generics #' #' @export #' #' @keywords internal #' summary.Dataset <- function(object, ..., type = 1, digits = NA_integer_) { .warnInCaseOfUnknownArguments(functionName = "summary", ...) if (type == 1 && inherits(object, "SummaryFactory")) { return(object) } if (type != 1) { return(summary.ParameterSet(object, type = type, digits = digits, ...)) } intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") .assertIsValidSummaryIntervalFormat(intervalFormat) summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat) s <- object$.toString() kMax <- object$getNumberOfStages() summaryFactory$title <- .firstCharacterToUpperCase(s) numberOfGroups <- object$getNumberOfGroups() if (numberOfGroups == 1) { groups <- "one sample" } else if (numberOfGroups == 2) { groups <- c("one treatment", "one control group") if (object$isDatasetSurvival()) { groups <- paste0(groups, c(" (1)", " (2)")) } } else { groups <- c(paste0(.integerToWrittenNumber(numberOfGroups - 1), " treatment groups"), "one control group") if (object$isDatasetSurvival()) { groups <- paste0(groups, c( paste0(" (", .arrayToString(1:(numberOfGroups - 1)), ")"), paste0(" (", numberOfGroups, ")"))) } } prefix <- "" if (object$isDatasetMeans()) { prefix <- "the sample sizes, means, and standard deviations of " } else if (object$isDatasetRates()) { prefix <- "the sample sizes and events of " } else if (object$isDatasetSurvival()) { prefix <- "the events and log rank statistics of the comparison of " } if (numberOfGroups > 1) { prefix <- paste0(prefix, "\n") } header <- paste0("The dataset contains ", prefix, paste0(groups, collapse = ifelse(object$isDatasetSurvival(), " with ", " and "))) if (object$.enrichmentEnabled) { header <- paste0(header, ". The data will be analyzed ", ifelse(object$isStratified(), "", "non-"), "stratified") } if (kMax > 1) { header <- paste0(header, ".\nThe total number of looks is ", .integerToWrittenNumber(kMax), "; stage-wise and cumulative data are included") } header <- paste0(header, ".") summaryFactory$header <- header digitSettings <- .getSummaryDigits(digits) digits <- digitSettings$digits digitsSampleSize <- 0 digitsGeneral <- digitSettings$digitsGeneral digitsProbabilities <- digitSettings$digitsProbabilities paramsToCheck <- character(0) if (object$isDatasetMeans() || object$isDatasetRates()) { paramsToCheck <- c(paramsToCheck, "sampleSizes") if (kMax > 1) { paramsToCheck <- c(paramsToCheck, "overallSampleSizes") } } else if (object$isDatasetRates() || object$isDatasetSurvival()) { paramsToCheck <- c(paramsToCheck, "events") if (kMax > 1) { paramsToCheck <- c(paramsToCheck, "overallEvents") } } if (length(paramsToCheck) > 0) { for (param in paramsToCheck) { if (.isFloatingPointSampleSize(object, param)) { digitsSampleSize <- max(digitsSampleSize, .getMaxDigits(object[[param]])) } } digitsSampleSize <- min(digitsSampleSize, digits) } summaryFactory$addItem("Stage", object$stages) if (numberOfGroups > 1) { groupNumbers <- object$groups if (object$isDatasetSurvival()) { groupNumbers <- paste0(object$groups, " vs ", numberOfGroups) summaryFactory$addItem("Comparison", groupNumbers) } else { summaryFactory$addItem("Group", groupNumbers) } } if (object$.enrichmentEnabled) { summaryFactory$addItem("Subset", object$subsets) } parameterCaptionPrefix <- ifelse(kMax == 1, "", "Stage-wise ") if (object$isDatasetMeans() || object$isDatasetRates()) { summaryFactory$addParameter(object, parameterName = "sampleSizes", parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "sample size"), roundDigits = digitsSampleSize) if (kMax > 1) { summaryFactory$addParameter(object, parameterName = "overallSampleSizes", parameterCaption = "Cumulative sample size", roundDigits = digitsSampleSize) } } if (object$isDatasetMeans()) { summaryFactory$addParameter(object, parameterName = "means", parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "mean"), roundDigits = digitsGeneral) if (kMax > 1) { summaryFactory$addParameter(object, parameterName = "overallMeans", parameterCaption = "Cumulative mean", roundDigits = digitsGeneral) } summaryFactory$addParameter(object, parameterName = "stDevs", parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "standard deviation"), roundDigits = digitsGeneral) if (kMax > 1) { summaryFactory$addParameter(object, parameterName = "overallStDevs", parameterCaption = "Cumulative standard deviation", roundDigits = digitsGeneral) } } else if (object$isDatasetRates()) { summaryFactory$addParameter(object, parameterName = "events", parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "number of events"), roundDigits = digitsSampleSize) if (kMax > 1) { summaryFactory$addParameter(object, parameterName = "overallEvents", parameterCaption = "Cumulative number of events", roundDigits = digitsSampleSize) } } else if (object$isDatasetSurvival()) { summaryFactory$addParameter(object, parameterName = "events", parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "number of events"), roundDigits = digitsSampleSize) if (kMax > 1) { summaryFactory$addParameter(object, parameterName = "overallEvents", parameterCaption = "Cumulative number of events", roundDigits = digitsSampleSize) } summaryFactory$addParameter(object, parameterName = "logRanks", parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "log rank statistic"), roundDigits = digitsGeneral) if (kMax > 1) { summaryFactory$addParameter(object, parameterName = "overallLogRanks", parameterCaption = "Overall log rank statistic", roundDigits = digitsGeneral) } if (!any(is.na(object$allocationRatios)) && any(object$allocationRatios != 1)) { summaryFactory$addParameter(object, parameterName = "allocationRatios", parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "allocation ratio"), roundDigits = digitsGeneral) if (kMax > 1) { summaryFactory$addParameter(object, parameterName = "overallAllocationRatios", parameterCaption = "Cumulative allocation ratio", roundDigits = digitsGeneral) } } } return(summaryFactory) } .getDatasetArgumentsRCodeLines <- function(x, complete = FALSE, digits = 4) { m <- getWideFormat(x) lines <- character(0) paramNames <- colnames(m) if (!complete) { if (x$.inputType == "stagewise") { paramNames <- paramNames[!grepl("^overall", paramNames)] } else { paramNames <- paramNames[grepl("^(stage|group|subset|overall)", paramNames)] } } for (paramName in paramNames) { encapsulate <- grepl("^subset", paramName) if (!encapsulate || isTRUE(x$.enrichmentEnabled)) { values <- m[[paramName]] if (!encapsulate && is.numeric(values) && !is.null(digits) && length(digits) == 1 && !is.na(digits)) { values <- round(values, digits = digits) } lines <- c(lines, paste0(paramName, " = ", .arrayToString(values, vectorLookAndFeelEnabled = TRUE, encapsulate = encapsulate, digits = NA_integer_))) } } return(lines) } #' #' @name Dataset_print #' #' @title #' Print Dataset Values #' #' @description #' \code{print} prints its \code{\link{Dataset}} argument and returns it invisibly (via \code{invisible(x)}). #' #' @param x A \code{\link{Dataset}} object. #' @param markdown If \code{TRUE}, the output will be created in Markdown. #' @param output A character defining the output type, default is "list". #' @inheritParams param_three_dots #' #' @details #' Prints the dataset. #' #' @export #' #' @keywords internal #' print.Dataset <- function(x, ..., markdown = FALSE, output = c("list", "long", "wide", "r", "rComplete")) { fCall = match.call(expand.dots = FALSE) datasetName <- deparse(fCall$x) output <- match.arg(output) if (markdown) { if (output != "list") { warning("'output' (\"", output, "\") will be ignored ", "because only \"list\" is supported yet if markdown is enabled", call. = FALSE) } x$.catMarkdownText() return(invisible(x)) } if (output == "long") { m <- getLongFormat(x) m <- prmatrix(m, rowlab = rep("", nrow(m))) print(m, quote = FALSE, right = FALSE) return(invisible(x)) } else if (output == "wide") { m <- getWideFormat(x) m <- prmatrix(m, rowlab = rep("", nrow(m))) print(m, quote = FALSE, right = FALSE) return(invisible(x)) } else if (output %in% c("r", "rComplete")) { lines <- .getDatasetArgumentsRCodeLines(x, complete = (output == "rComplete")) lines <- paste0("\t", lines) if (is.null(datasetName) || length(datasetName) != 1 || is.na(datasetName)) { datasetName <- "dataInput" } cat(datasetName, " <- getDataset(\n", sep = "") cat(paste0(lines, collapse = ",\n"), "\n") cat(")\n") return(invisible(x)) } x$show() return(invisible(x)) } rpact/R/class_design_plan.R0000644000175000017500000022234014145656364015532 0ustar nileshnilesh## | ## | *Trial design plan classes* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include f_core_constants.R #' @include f_design_utilities.R NULL C_VARIABLE_DESIGN_PLAN_PARAMETERS <- c("lambda1", "pi1", "median1", "alternative", "hazardRatio") C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS <- list( normalApproximation = FALSE, meanRatio = FALSE, thetaH0 = 0, alternative = seq(0.2, 1, 0.2), stDev = 1, groups = 2L, allocationRatioPlanned = 1 ) C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES <- list( normalApproximation = TRUE, riskRatio = FALSE, thetaH0 = 0, pi1 = C_PI_1_SAMPLE_SIZE_DEFAULT, pi2 = C_PI_2_DEFAULT, groups = 2L, allocationRatioPlanned = 1 ) C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL <- list( typeOfComputation = "Schoenfeld", thetaH0 = 1, pi2 = C_PI_2_DEFAULT, pi1 = C_PI_1_SAMPLE_SIZE_DEFAULT, allocationRatioPlanned = 1, accountForObservationTimes = NA, eventTime = 12, accrualTime = C_ACCRUAL_TIME_DEFAULT, accrualIntensity = C_ACCRUAL_INTENSITY_DEFAULT, kappa = 1, piecewiseSurvivalTime = NA_real_, lambda2 = NA_real_, lambda1 = NA_real_, followUpTime = C_FOLLOW_UP_TIME_DEFAULT, maxNumberOfSubjects = 0, dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12 ) #' #' @name TrialDesignPlan #' #' @title #' Basic Trial Design Plan #' #' @description #' Basic class for trial design plans. #' #' @details #' \code{TrialDesignPlan} is the basic class for #' \itemize{ #' \item \code{TrialDesignPlanMeans}, #' \item \code{TrialDesignPlanRates}, and #' \item \code{TrialDesignPlanSurvival}. #' } #' #' @include f_core_constants.R #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_design.R #' @include class_design_set.R #' @include f_core_plot.R #' #' @keywords internal #' #' @importFrom methods new #' TrialDesignPlan <- setRefClass("TrialDesignPlan", contains = "ParameterSet", fields = list( .plotSettings = "PlotSettings", .design = "TrialDesign", .objectType = "character" # "sampleSize" or "power" ), methods = list( initialize = function(design, ...) { callSuper(.design = design, ...) .plotSettings <<- PlotSettings() .parameterNames <<- .getParameterNames(design = design, designPlan = .self) .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS if (.isTrialDesignPlanMeans(.self)) { defaultValueList <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS } else if (.isTrialDesignPlanRates(.self)) { defaultValueList <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES } else if (.isTrialDesignPlanSurvival(.self)) { defaultValueList <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL } for (parameterName in .getVisibleFieldNames()) { defaultValue <- defaultValueList[[parameterName]] existingValue <- .self[[parameterName]] if (all(is.na(existingValue))) { .setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) } else if (!is.null(defaultValue) && length(defaultValue) == length(existingValue) && !any(is.na(defaultValue)) && !any(is.na(existingValue)) && sum(defaultValue == existingValue) == length(defaultValue)) { .setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) } else { .setParameterType(parameterName, C_PARAM_USER_DEFINED) } } .setParameterType("optimumAllocationRatio", C_PARAM_NOT_APPLICABLE) }, .setSampleSizeObject = function(objectType) { if (length(objectType) == 0 || !(objectType %in% c("sampleSize", "power"))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.objectType' (", objectType, ") must be specified as 'sampleSize' or 'power'") } .objectType <<- objectType }, .isSampleSizeObject = function() { if (length(.objectType) == 0 || !(.objectType %in% c("sampleSize", "power"))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.objectType' must be specified as 'sampleSize' or 'power'") } return(.objectType == "sampleSize") }, .isPowerObject = function() { if (length(.objectType) == 0 || !(.objectType %in% c("sampleSize", "power"))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.objectType' must be specified as 'sampleSize' or 'power'") } return(.objectType == "power") }, getPlotSettings = function() { return(.plotSettings) }, show = function(showType = 1, digits = NA_integer_) { .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { 'Method for automatically printing trial plan objects' .resetCat() if (showType == 3) { .createSummary(.self, digits = digits)$.show(showType = 1, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else if (showType == 2) { callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { .cat("Design plan parameters and output for ", .toString(), ":\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getDesignParametersToShow(.self), "Design parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getGeneratedParameters(), "Sample size and output", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) if (inherits(.self, "TrialDesignPlanSurvival") || groups == 2 || .design$kMax > 1) { .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) if (inherits(.self, "TrialDesignPlanSurvival") || groups == 2) { .cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) } if (.design$kMax > 1) { .cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) } } .cat("\n", consoleOutputEnabled = consoleOutputEnabled) } }, getAlpha = function() { return(.design$alpha) }, getBeta = function() { if (.isTrialDesignInverseNormalOrGroupSequential(.design)) { return(.design$beta) } return(NA_real_) }, getSided = function() { return(.design$sided) }, getTwoSidedPower = function() { if (.isTrialDesignInverseNormalOrGroupSequential(.design)) { return(.design$twoSidedPower) } return(NA) }, .toString = function(startWithUpperCase = FALSE) { if (.isTrialDesignPlanMeans(.self)) { s <- "means" } else if (.isTrialDesignPlanRates(.self)) { s <- "rates" } else if (.isTrialDesignPlanSurvival(.self)) { s <- "survival data" } else { s <- paste0("unknown data class '", class(.self), "'") } return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) } ) ) #' #' @name TrialDesignPlan_as.data.frame #' #' @title #' Coerce Trial Design Plan to a Data Frame #' #' @description #' Returns the \code{\link{TrialDesignPlan}} as data frame. #' #' @param x A \code{\link{TrialDesignPlan}} object. #' @inheritParams param_niceColumnNamesEnabled #' @inheritParams param_includeAllParameters #' @inheritParams param_three_dots #' #' @details #' Coerces the design plan to a data frame. #' #' @template return_dataframe #' #' @examples #' as.data.frame(getSampleSizeMeans()) #' #' @export #' #' @keywords internal #' as.data.frame.TrialDesignPlan <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { return(x$.getAsDataFrame(parameterNames = NULL, niceColumnNamesEnabled = niceColumnNamesEnabled, includeAllParameters = includeAllParameters)) } #' #' @name TrialDesignPlanMeans #' #' @title #' Trial Design Plan Means #' #' @description #' Trial design plan for means. #' #' @details #' This object cannot be created directly; use \code{\link{getSampleSizeMeans}} #' with suitable arguments to create a design plan for a dataset of means. #' #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_design_set.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' TrialDesignPlanMeans <- setRefClass("TrialDesignPlanMeans", contains = "TrialDesignPlan", fields = list( meanRatio = "logical", thetaH0 = "numeric", normalApproximation = "logical", alternative = "numeric", stDev = "numeric", groups = "numeric", allocationRatioPlanned = "numeric", optimumAllocationRatio = "logical", directionUpper = "logical", effect = "numeric", overallReject = "numeric", rejectPerStage = "matrix", futilityStop = "numeric", futilityPerStage = "matrix", earlyStop = "numeric", expectedNumberOfSubjects = "numeric", nFixed = "numeric", nFixed1 = "numeric", nFixed2 = "numeric", informationRates = "matrix", maxNumberOfSubjects = "numeric", maxNumberOfSubjects1 = "numeric", maxNumberOfSubjects2 = "numeric", numberOfSubjects = "matrix", numberOfSubjects1 = "matrix", numberOfSubjects2 = "matrix", expectedNumberOfSubjectsH0 = "numeric", expectedNumberOfSubjectsH01 = "numeric", expectedNumberOfSubjectsH1 = "numeric", criticalValuesEffectScale = "matrix", criticalValuesEffectScaleLower = "matrix", criticalValuesEffectScaleUpper = "matrix", criticalValuesPValueScale = "matrix", futilityBoundsEffectScale = "matrix", futilityBoundsEffectScaleLower = "matrix", futilityBoundsEffectScaleUpper = "matrix", futilityBoundsPValueScale = "matrix" ), methods = list( initialize = function(..., normalApproximation = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["normalApproximation"]], meanRatio = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["meanRatio"]], thetaH0 = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["thetaH0"]], alternative = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["alternative"]], stDev = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["stDev"]], groups = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["groups"]], allocationRatioPlanned = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["allocationRatioPlanned"]]) { callSuper(..., normalApproximation = normalApproximation, meanRatio = meanRatio, thetaH0 = thetaH0, alternative = alternative, stDev = stDev, groups = groups, allocationRatioPlanned = allocationRatioPlanned ) optimumAllocationRatio <<- FALSE visibleFieldNames <- .getVisibleFieldNames() startIndex <- which(visibleFieldNames == "directionUpper") for (i in startIndex:length(visibleFieldNames)) { .setParameterType(visibleFieldNames[i], C_PARAM_NOT_APPLICABLE) } if (groups == 1) { .setParameterType("meanRatio", C_PARAM_NOT_APPLICABLE) .setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) } .setParameterType("maxNumberOfSubjects1", C_PARAM_NOT_APPLICABLE) .setParameterType("maxNumberOfSubjects2", C_PARAM_NOT_APPLICABLE) .setParameterType("criticalValuesEffectScale", C_PARAM_NOT_APPLICABLE) .setParameterType("criticalValuesEffectScaleLower", C_PARAM_NOT_APPLICABLE) .setParameterType("criticalValuesEffectScaleUpper", C_PARAM_NOT_APPLICABLE) .setParameterType("futilityBoundsEffectScale", C_PARAM_NOT_APPLICABLE) .setParameterType("futilityBoundsEffectScaleLower", C_PARAM_NOT_APPLICABLE) .setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_NOT_APPLICABLE) }, clone = function(alternative = NA_real_) { alternativeTemp <- alternative if (any(is.na(alternative))) { alternativeTemp <- .self$alternative } if (.objectType == "sampleSize") { result <- getSampleSizeMeans(design = .self$.design, normalApproximation = .self$.getParameterValueIfUserDefinedOrDefault("normalApproximation"), meanRatio = .self$meanRatio, #.getParameterValueIfUserDefinedOrDefault("meanRatio"), thetaH0 = .self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), alternative = alternativeTemp, stDev = .self$.getParameterValueIfUserDefinedOrDefault("stDev"), groups = .self$.getParameterValueIfUserDefinedOrDefault("groups"), allocationRatioPlanned = .self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned")) } else { result <- getPowerMeans(design = .self$.design, normalApproximation = .self$.getParameterValueIfUserDefinedOrDefault("normalApproximation"), meanRatio = .self$meanRatio, #.getParameterValueIfUserDefinedOrDefault("meanRatio"), thetaH0 = .self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), alternative = alternativeTemp, stDev = .self$.getParameterValueIfUserDefinedOrDefault("stDev"), directionUpper = .self$.getParameterValueIfUserDefinedOrDefault("directionUpper"), maxNumberOfSubjects = .self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), groups = .self$.getParameterValueIfUserDefinedOrDefault("groups"), allocationRatioPlanned = .self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned")) } result$.plotSettings <- .self$.plotSettings return(result) }, show = function(showType = 1, digits = NA_integer_) { 'Method for automatically printing trial plan objects' callSuper(showType = showType, digits = digits) } ) ) #' #' @name TrialDesignPlanRates #' #' @title #' Trial Design Plan Rates #' #' @description #' Trial design plan for rates. #' #' @details #' This object cannot be created directly; use \code{\link{getSampleSizeRates}} #' with suitable arguments to create a design plan for a dataset of rates. #' #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_design_set.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' TrialDesignPlanRates <- setRefClass("TrialDesignPlanRates", contains = "TrialDesignPlan", fields = list( riskRatio = "logical", thetaH0 = "numeric", normalApproximation = "logical", pi1 = "numeric", pi2 = "numeric", groups = "numeric", allocationRatioPlanned = "numeric", optimumAllocationRatio = "logical", directionUpper = "logical", effect = "numeric", expectedNumberOfSubjects = "numeric", nFixed = "numeric", nFixed1 = "numeric", nFixed2 = "numeric", overallReject = "numeric", rejectPerStage = "matrix", futilityStop = "numeric", futilityPerStage = "matrix", earlyStop = "numeric", informationRates = "matrix", maxNumberOfSubjects = "numeric", maxNumberOfSubjects1 = "numeric", maxNumberOfSubjects2 = "numeric", numberOfSubjects = "matrix", numberOfSubjects1 = "matrix", numberOfSubjects2 = "matrix", expectedNumberOfSubjectsH0 = "numeric", expectedNumberOfSubjectsH01 = "numeric", expectedNumberOfSubjectsH1 = "numeric", criticalValuesEffectScale = "matrix", criticalValuesEffectScaleLower = "matrix", criticalValuesEffectScaleUpper = "matrix", criticalValuesPValueScale = "matrix", futilityBoundsEffectScale = "matrix", futilityBoundsEffectScaleLower = "matrix", futilityBoundsEffectScaleUpper = "matrix", futilityBoundsPValueScale = "matrix" ), methods = list( initialize = function(..., normalApproximation = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["normalApproximation"]], riskRatio = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["riskRatio"]], thetaH0 = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["thetaH0"]], pi1 = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["pi1"]], pi2 = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["pi2"]], groups = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["groups"]], allocationRatioPlanned = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["allocationRatioPlanned"]]) { callSuper(..., normalApproximation = normalApproximation, riskRatio = riskRatio, thetaH0 = thetaH0, pi1 = pi1, pi2 = pi2, groups = groups, allocationRatioPlanned = allocationRatioPlanned) optimumAllocationRatio <<- FALSE visibleFieldNames <- .getVisibleFieldNames() startIndex <- which(visibleFieldNames == "directionUpper") for (i in startIndex:length(visibleFieldNames)) { .setParameterType(visibleFieldNames[i], C_PARAM_NOT_APPLICABLE) } if (groups == 1) { .setParameterType("meanRatio", C_PARAM_NOT_APPLICABLE) .setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) } .setParameterType("maxNumberOfSubjects1", C_PARAM_NOT_APPLICABLE) .setParameterType("maxNumberOfSubjects2", C_PARAM_NOT_APPLICABLE) .setParameterType("criticalValuesEffectScale", C_PARAM_NOT_APPLICABLE) .setParameterType("criticalValuesEffectScaleLower", C_PARAM_NOT_APPLICABLE) .setParameterType("criticalValuesEffectScaleUpper", C_PARAM_NOT_APPLICABLE) .setParameterType("futilityBoundsEffectScale", C_PARAM_NOT_APPLICABLE) .setParameterType("futilityBoundsEffectScaleLower", C_PARAM_NOT_APPLICABLE) .setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_NOT_APPLICABLE) }, clone = function(pi1 = NA_real_) { pi1Temp <- pi1 if (any(is.na(pi1))) { pi1Temp <- .self$pi1 } if (.objectType == "sampleSize") { return(getSampleSizeRates(design = .self$.design, normalApproximation = .self$.getParameterValueIfUserDefinedOrDefault("normalApproximation"), riskRatio = .self$riskRatio, #.getParameterValueIfUserDefinedOrDefault("riskRatio"), thetaH0 = .self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), pi1 = pi1Temp, pi2 = .self$.getParameterValueIfUserDefinedOrDefault("pi2"), groups = .self$.getParameterValueIfUserDefinedOrDefault("groups"), allocationRatioPlanned = .self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned"))) } else { return(getPowerRates(design = .self$.design, riskRatio = .self$riskRatio, #.getParameterValueIfUserDefinedOrDefault("riskRatio"), thetaH0 = .self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), pi1 = pi1Temp, pi2 = .self$.getParameterValueIfUserDefinedOrDefault("pi2"), directionUpper = .self$.getParameterValueIfUserDefinedOrDefault("directionUpper"), maxNumberOfSubjects = .self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), groups = .self$.getParameterValueIfUserDefinedOrDefault("groups"), allocationRatioPlanned = .self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned"))) } }, show = function(showType = 1, digits = NA_integer_) { 'Method for automatically printing trial plan objects' callSuper(showType = showType, digits = digits) } ) ) #' #' @name TrialDesignPlanSurvival #' #' @title #' Trial Design Plan Survival #' #' @description #' Trial design plan for survival data. #' #' @details #' This object cannot be created directly; use \code{\link{getSampleSizeSurvival}} #' with suitable arguments to create a design plan for a dataset of survival data. #' #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_design_set.R #' @include class_time.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' TrialDesignPlanSurvival <- setRefClass("TrialDesignPlanSurvival", contains = "TrialDesignPlan", fields = list( .piecewiseSurvivalTime = "PiecewiseSurvivalTime", .accrualTime = "AccrualTime", .calculateFollowUpTime = "logical", thetaH0 = "numeric", typeOfComputation = "character", directionUpper = "logical", pi1 = "numeric", pi2 = "numeric", median1 = "numeric", median2 = "numeric", lambda1 = "numeric", lambda2 = "numeric", hazardRatio = "numeric", maxNumberOfSubjects = "numeric", maxNumberOfSubjects1 = "numeric", maxNumberOfSubjects2 = "numeric", maxNumberOfEvents = "numeric", allocationRatioPlanned = "numeric", optimumAllocationRatio = "logical", accountForObservationTimes = "logical", eventTime = "numeric", accrualTime = "numeric", totalAccrualTime = "numeric", accrualIntensity = "numeric", accrualIntensityRelative = "numeric", kappa = "numeric", piecewiseSurvivalTime = "numeric", followUpTime = "numeric", dropoutRate1 = "numeric", dropoutRate2 = "numeric", dropoutTime = "numeric", omega = "numeric", expectedNumberOfEvents = "numeric", eventsFixed = "numeric", nFixed = "numeric", nFixed1 = "numeric", nFixed2 = "numeric", overallReject = "numeric", rejectPerStage = "matrix", futilityStop = "numeric", futilityPerStage = "matrix", earlyStop = "numeric", informationRates = "matrix", analysisTime = "matrix", studyDurationH1 = "numeric", studyDuration = "numeric", maxStudyDuration = "numeric", eventsPerStage = "matrix", expectedEventsH0 = "numeric", expectedEventsH01 = "numeric", expectedEventsH1 = "numeric", numberOfSubjects = "matrix", numberOfSubjects1 = "matrix", numberOfSubjects2 = "matrix", expectedNumberOfSubjectsH1 = "numeric", expectedNumberOfSubjects = "numeric", criticalValuesEffectScale = "matrix", criticalValuesEffectScaleLower = "matrix", criticalValuesEffectScaleUpper = "matrix", criticalValuesPValueScale = "matrix", futilityBoundsEffectScale = "matrix", futilityBoundsEffectScaleLower = "matrix", futilityBoundsEffectScaleUpper = "matrix", futilityBoundsPValueScale = "matrix" ), methods = list( initialize = function(...) { callSuper(...) optimumAllocationRatio <<- FALSE visibleFieldNames <- .getVisibleFieldNames() startIndex <- which(visibleFieldNames == "hazardRatio") for (i in startIndex:length(visibleFieldNames)) { .setParameterType(visibleFieldNames[i], C_PARAM_NOT_APPLICABLE) } .setParameterType("maxNumberOfSubjects", C_PARAM_NOT_APPLICABLE) .setParameterType("maxNumberOfSubjects1", C_PARAM_NOT_APPLICABLE) .setParameterType("maxNumberOfSubjects2", C_PARAM_NOT_APPLICABLE) .setParameterType("median1", C_PARAM_NOT_APPLICABLE) .setParameterType("median2", C_PARAM_NOT_APPLICABLE) .setParameterType("accountForObservationTimes", C_PARAM_NOT_APPLICABLE) .setParameterType("omega", C_PARAM_NOT_APPLICABLE) .setParameterType("maxStudyDuration", C_PARAM_NOT_APPLICABLE) .setParameterType("accrualIntensityRelative", C_PARAM_NOT_APPLICABLE) .setParameterType("criticalValuesEffectScale", C_PARAM_NOT_APPLICABLE) .setParameterType("criticalValuesEffectScaleLower", C_PARAM_NOT_APPLICABLE) .setParameterType("criticalValuesEffectScaleUpper", C_PARAM_NOT_APPLICABLE) .setParameterType("futilityBoundsEffectScale", C_PARAM_NOT_APPLICABLE) .setParameterType("futilityBoundsEffectScaleLower", C_PARAM_NOT_APPLICABLE) .setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_NOT_APPLICABLE) # set default values for (parameterName in c("eventTime", "accrualTime", "accrualIntensity", "kappa", "piecewiseSurvivalTime", "lambda1", "lambda2", "followUpTime", "dropoutTime")) { .setDefaultValue(parameterName) } }, clone = function(hazardRatio = NA_real_, pi1 = NA_real_) { hr <- NA_real_ if (.getParameterType("hazardRatio") == C_PARAM_USER_DEFINED) { hr <- hazardRatio if (any(is.na(hazardRatio))) { hr <- .self$hazardRatio } } pi1Temp <- NA_real_ if (.getParameterType("pi1") == C_PARAM_USER_DEFINED) { pi1Temp <- pi1 if (any(is.na(pi1))) { pi1Temp <- .self$pi1 } } accrualTimeTemp <- .self$.getParameterValueIfUserDefinedOrDefault("accrualTime") if (!is.null(accrualTimeTemp) && length(accrualTimeTemp) > 0 && !all(is.na(accrualTimeTemp)) && accrualTimeTemp[1] != 0) { accrualTimeTemp <- c(0, accrualTimeTemp) } accrualIntensityTemp <- .self$.getParameterValueIfUserDefinedOrDefault("accrualIntensity") if (all(is.na(accrualIntensityTemp))) { accrualIntensityTemp <- C_ACCRUAL_INTENSITY_DEFAULT } if (.objectType == "sampleSize") { return(getSampleSizeSurvival(design = .self$.design, typeOfComputation = .self$.getParameterValueIfUserDefinedOrDefault("typeOfComputation"), thetaH0 = .self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), pi1 = pi1Temp, pi2 = .self$.getParameterValueIfUserDefinedOrDefault("pi2"), allocationRatioPlanned = .self$allocationRatioPlanned, accountForObservationTimes = .self$.getParameterValueIfUserDefinedOrDefault("accountForObservationTimes"), eventTime = .self$eventTime, accrualTime = accrualTimeTemp, accrualIntensity = accrualIntensityTemp, kappa = .self$kappa, piecewiseSurvivalTime = .self$.getParameterValueIfUserDefinedOrDefault("piecewiseSurvivalTime"), lambda2 = .self$.getParameterValueIfUserDefinedOrDefault("lambda2"), lambda1 = .self$.getParameterValueIfUserDefinedOrDefault("lambda1"), followUpTime = .self$.getParameterValueIfUserDefinedOrDefault("followUpTime"), maxNumberOfSubjects = .self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), dropoutRate1 = .self$dropoutRate1, dropoutRate2 = .self$dropoutRate2, dropoutTime = .self$dropoutTime, hazardRatio = hr)) } else { directionUpperTemp <- directionUpper if (length(directionUpperTemp) > 1) { directionUpperTemp <- directionUpperTemp[1] } return(getPowerSurvival(design = .self$.design, typeOfComputation = .self$.getParameterValueIfUserDefinedOrDefault("typeOfComputation"), thetaH0 = .self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), pi1 = pi1Temp, pi2 = .self$.getParameterValueIfUserDefinedOrDefault("pi2"), directionUpper = directionUpperTemp, allocationRatioPlanned = .self$allocationRatioPlanned, eventTime = .self$eventTime, accrualTime = accrualTimeTemp, accrualIntensity = accrualIntensityTemp, kappa = .self$kappa, piecewiseSurvivalTime = .self$.getParameterValueIfUserDefinedOrDefault("piecewiseSurvivalTime"), lambda2 = .self$.getParameterValueIfUserDefinedOrDefault("lambda2"), lambda1 = .self$.getParameterValueIfUserDefinedOrDefault("lambda1"), hazardRatio = hr, maxNumberOfSubjects = .self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), maxNumberOfEvents = .self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfEvents"), dropoutRate1 = .self$dropoutRate1, dropoutRate2 = .self$dropoutRate2, dropoutTime = .self$dropoutTime)) } }, .setDefaultValue = function(argumentName) { if (is.null(.self[[argumentName]]) || all(is.na(.self[[argumentName]]))) { .self[[argumentName]] <<- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL[[argumentName]] .setParameterType(argumentName, C_PARAM_DEFAULT_VALUE) } }, show = function(showType = 1, digits = NA_integer_) { 'Method for automatically printing trial plan objects' callSuper(showType = showType, digits = digits) }, .warnInCaseArgumentExists = function(argument, argumentName) { if (!all(is.na(argument)) && any(argument > 0)) { warning(sprintf("Specified '%s' (%s) not taken into account", argumentName, .arrayToString(argument)), call. = FALSE) } } ) ) .addPlotSubTitleItems <- function(designPlan, designMaster, items, type) { if (type %in% c(1, 3, 4)) { return(invisible()) } if (.isTrialDesignPlanMeans(designPlan)) { nMax <- designPlan$maxNumberOfSubjects[1] # use first value for plotting if (!(type %in% c(5))) { items$add("N", round(nMax, 1), "max") } if ((type %in% c(5)) && !(items$title == "Sample Size")) { items$add("N", round(nMax, 1), "max") } if (designPlan$meanRatio) { items$add("coefficient of variation", designPlan$stDev) } else { items$add("standard deviation", designPlan$stDev) } if (designPlan$groups == 1) { if (type %in% c(2,(5:9))) { items$add("H0: mu", designPlan$thetaH0) items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) } } else { if (type %in% c(2,(5:9))) { if (designPlan$meanRatio) { items$add("H0: mean ratio", designPlan$thetaH0) } else { items$add("H0: mean difference", designPlan$thetaH0) } items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) } } } else if (.isTrialDesignPlanRates(designPlan)) { nMax <- designPlan$maxNumberOfSubjects[1] # use first value for plotting if (!(type %in% c(5))) { items$add("N", round(nMax, 1), "max") } if ((type %in% c(5)) && !(items$title == "Sample Size")) { items$add("N", round(nMax, 1), "max") } if (designPlan$groups == 2 && !(type %in% c(3, 4)) && length(designPlan$pi2) == 1 && !is.na(designPlan$pi2)) { items$add("pi", designPlan$pi2, 2) } if (designPlan$groups == 1) { if (type %in% c(2,(5:9))) { items$add("H0: pi", designPlan$thetaH0) } } else { if (type %in% c(2,(5:9))) { if (designPlan$riskRatio) { items$add("H0: risk ratio", designPlan$thetaH0) } else { items$add("H0: risk difference", designPlan$thetaH0) } items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) } } } else if (.isTrialDesignPlanSurvival(designPlan)) { if (designPlan$.isPowerObject() && !(type %in% (13:14))) { items$add("maximum number of events", designPlan$maxNumberOfEvents[1]) } if (type %in% (10:12)) { items$add("maximum number of subjects", designPlan$maxNumberOfSubjects[1]) } if (type %in% c(2,(5:12))) { items$add("H0: hazard ratio", designPlan$thetaH0) items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) } } } .assertIsValidVariedParameterVectorForPlotting <- function(designPlan, plotType) { if (.isTrialDesignPlanMeans(designPlan)) { if (is.null(designPlan$alternative) || any(is.na(designPlan$alternative)) || length(designPlan$alternative) <= 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, " is only available if 'alternative' with length > 1 is defined") } } else if (.isTrialDesignPlanRates(designPlan)) { if (is.null(designPlan$pi1) || any(is.na(designPlan$pi1)) || length(designPlan$pi1) <= 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, " is only available if 'pi1' with length > 1 is defined") } } else if (.isTrialDesignPlanSurvival(designPlan)) { if (is.null(designPlan$hazardRatio) || any(is.na(designPlan$hazardRatio)) || length(designPlan$hazardRatio) <= 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, " is only available if 'hazardRatio' with length > 1 is defined") } } } .plotTrialDesignPlan <- function(designPlan, type = 1L, main = NA_character_, xlab = NA_character_, ylab = NA_character_, palette = "Set1", theta = seq(-1, 1, 0.02), plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, designPlanName = NA_character_, plotSettings = NULL, ...) { .assertGgplotIsInstalled() .assertIsTrialDesignPlan(designPlan) .assertIsValidLegendPosition(legendPosition) .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) theta <- .assertIsValidThetaRange(thetaRange = theta) nMax <- ifelse(.isTrialDesignPlanSurvival(designPlan), designPlan$maxNumberOfEvents[1], designPlan$maxNumberOfSubjects[1]) # use first value for plotting if (is.null(plotSettings)) { plotSettings <- designPlan$.plotSettings } designMaster <- designPlan$.design if (designMaster$kMax == 1 && (type %in% c(1:4))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not available for 'kMax' = 1") } if (designPlan$.isSampleSizeObject()) { if (.isTrialDesignPlanSurvival(designPlan)) { if (!(type %in% c(1:5, 13, 14))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, 3, 4, 5, 13 or 14") } } else { if (!(type %in% c(1:5))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, 3, 4, 5") } } } if (is.na(plotPointsEnabled)) { plotPointsEnabled <- type < 4 } ratioEnabled <- (.isTrialDesignPlanSurvival(designPlan) || (.isTrialDesignPlanMeans(designPlan) && designPlan$meanRatio) || (.isTrialDesignPlanRates(designPlan) && designPlan$riskRatio)) variedParameters <- logical(0) showSourceHint <- "" if (type %in% c(5:12)) { if (.isTrialDesignPlanMeans(designPlan) && length(designPlan$alternative) == 2 && designPlan$.getParameterType("alternative") == C_PARAM_USER_DEFINED) { if (!is.logical(showSource) || isTRUE(showSource)) { showSourceHint <- .getVariedParameterHint(designPlan$alternative, "alternative") } designPlan <- designPlan$clone(alternative = .getVariedParameterVector(designPlan$alternative, "alternative")) } else if ((.isTrialDesignPlanRates(designPlan) || .isTrialDesignPlanSurvival(designPlan)) && length(designPlan$pi1) == 2 && designPlan$.getParameterType("pi1") == C_PARAM_USER_DEFINED) { if (!is.logical(showSource) || isTRUE(showSource)) { showSourceHint <- .getVariedParameterHint(designPlan$pi1, "pi1") } designPlan <- designPlan$clone(pi1 = .getVariedParameterVector(designPlan$pi1, "pi1")) } else if (.isTrialDesignPlanSurvival(designPlan) && length(designPlan$hazardRatio) == 2 && designPlan$.getParameterType("hazardRatio") == C_PARAM_USER_DEFINED) { if (!is.logical(showSource) || isTRUE(showSource)) { showSourceHint <- .getVariedParameterHint(designPlan$hazardRatio, "hazardRatio") } designPlan <- designPlan$clone(hazardRatio = .getVariedParameterVector(designPlan$hazardRatio, "hazardRatio")) } } srcCmd <- NULL reducedParam <- NULL if (type %in% c(1:4)) { reducedParam <- .warnInCaseOfUnusedValuesForPlotting(designPlan) } if (type == 1) { # Boundary plot if (.isTrialDesignPlanSurvival(designPlan)) { if (is.na(main)) { main <- PlotSubTitleItems(title = "Boundaries Z Scale") .addPlotSubTitleItems(designPlan, designMaster, main, type) if (!is.null(reducedParam)) { main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) } } if (designMaster$sided == 1) { designPlan <- data.frame( eventsPerStage = designPlan$eventsPerStage[, 1], criticalValues = designMaster$criticalValues, futilityBounds = c(designMaster$futilityBounds, designMaster$criticalValues[designMaster$kMax]) ) } else { designPlan <- data.frame( eventsPerStage = designPlan$eventsPerStage[, 1], criticalValues = designMaster$criticalValues, criticalValuesMirrored = -designMaster$criticalValues ) } xParameterName <- "eventsPerStage" if (designMaster$sided == 1) { if (any(designMaster$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { yParameterNames <- c("futilityBounds", "criticalValues") } else { yParameterNames <- "criticalValues" } yParameterNamesSrc <- yParameterNames } else { yParameterNames <- c("criticalValues", "criticalValuesMirrored") yParameterNamesSrc <- c("criticalValues", paste0("-", designPlanName, "$.design$criticalValues")) } if (is.na(legendPosition)) { legendPosition <- C_POSITION_RIGHT_TOP } srcCmd <- .showPlotSourceInformation(objectName = paste0(designPlanName, "$.design"), xParameterName = paste0(designPlanName, "$", xParameterName, "[, 1]"), yParameterNames = yParameterNamesSrc, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) } else { if (is.na(main)) { main <- PlotSubTitleItems(title = "Boundaries") .addPlotSubTitleItems(designPlan, designMaster, main, type) if (!is.null(reducedParam)) { main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) } } designSet <- TrialDesignSet(design = designMaster, singleDesign = TRUE) designSet$.plotSettings <- designPlan$.plotSettings designPlanName <- paste0(designPlanName, "$.design") return(.plotTrialDesignSet(x = designSet, y = NULL, main = main, xlab = xlab, ylab = ylab, type = type, palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, designSetName = designPlanName, showSource = showSource, plotSettings = plotSettings, ...)) } } else if (type == 2) { # Effect Scale Boundary plot if (is.na(main)) { main <- PlotSubTitleItems(title = "Boundaries Effect Scale") .addPlotSubTitleItems(designPlan, designMaster, main, type) if (!is.null(reducedParam)) { main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) } } if (is.na(ylab)) { if (.isTrialDesignPlanMeans(designPlan)) { if (designPlan$groups == 1) { ylab <- "Mean" } else if (!designPlan$meanRatio) { ylab <- "Mean Difference" } else { ylab <- "Mean Ratio" } } else if (.isTrialDesignPlanRates(designPlan)) { if (designPlan$groups == 1) { ylab <- "Rate" } else if (!designPlan$riskRatio) { ylab <- "Rate Difference" } else { ylab <- "Risk Ratio" } } else if (.isTrialDesignPlanSurvival(designPlan)) { ylab <- "Hazard Ratio" } } groupedPlotEnabled <- FALSE yParameterNamesSrc <- c() if (designMaster$sided == 1) { if (any(designMaster$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { data <- data.frame( criticalValuesEffectScale = designPlan$criticalValuesEffectScale[, 1], futilityBoundsEffectScale = c(designPlan$futilityBoundsEffectScale[, 1], designPlan$criticalValuesEffectScale[designMaster$kMax, 1]) ) yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScale[, 1]") yParameterNamesSrc <- c(yParameterNamesSrc, paste0("c(", designPlanName, "$futilityBoundsEffectScale[, 1], ", designPlanName, "$criticalValuesEffectScale[nrow(", designPlanName, "$criticalValuesEffectScale), 1])")) } else { data <- data.frame( criticalValuesEffectScale = designPlan$criticalValuesEffectScale[, 1] ) yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScale[, 1]") } } else if (designMaster$typeOfDesign == C_TYPE_OF_DESIGN_PT) { data <- data.frame( criticalValues = designPlan$criticalValuesEffectScaleUpper[, 1], criticalValuesMirrored = designPlan$criticalValuesEffectScaleLower[, 1], futilityBounds = c(designPlan$futilityBoundsEffectScaleUpper[, 1], designPlan$criticalValuesEffectScaleUpper[designMaster$kMax, 1]), futilityBoundsMirrored = c(designPlan$futilityBoundsEffectScaleLower[, 1], designPlan$criticalValuesEffectScaleLower[designMaster$kMax, 1]) ) yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleUpper[, 1]") yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleLower[, 1]") yParameterNamesSrc <- c(yParameterNamesSrc, paste0("c(", designPlanName, "$futilityBoundsEffectScaleUpper[, 1], ", designPlanName, "$criticalValuesEffectScaleUpper[nrow(", designPlanName, "$criticalValuesEffectScaleUpper), 1])")) yParameterNamesSrc <- c(yParameterNamesSrc, paste0("c(", designPlanName, "$futilityBoundsEffectScaleLower[, 1], ", designPlanName, "$criticalValuesEffectScaleLower[nrow(", designPlanName, "$criticalValuesEffectScaleLower), 1])")) groupedPlotEnabled <- TRUE } else { data <- data.frame( criticalValuesEffectScale = designPlan$criticalValuesEffectScaleUpper[, 1], criticalValuesEffectScaleMirrored = designPlan$criticalValuesEffectScaleLower[, 1] ) yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleUpper[, 1]") yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleLower[, 1]") } if (.isTrialDesignPlanSurvival(designPlan)) { xParameterName <- "eventsPerStage" xParameterNameSrc <- paste0(designPlanName, "$", xParameterName, "[, 1]") data <- cbind(data.frame(eventsPerStage = designPlan$eventsPerStage[, 1]), data) } else { xParameterName <- "informationRates" xParameterNameSrc <- paste0(designPlanName, "$.design$", xParameterName) data <- cbind(data.frame(informationRates = designMaster$informationRates), data) } if (designMaster$sided == 1 || designMaster$typeOfDesign == C_TYPE_OF_DESIGN_PT) { if (any(designMaster$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { yParameterNames <- c("futilityBoundsEffectScale", "criticalValuesEffectScale") } else { yParameterNames <- "criticalValuesEffectScale" } } else { yParameterNames <- c("criticalValuesEffectScale", "criticalValuesEffectScaleMirrored") } if (is.na(legendPosition)) { legendPosition <- C_POSITION_RIGHT_TOP } if (is.na(legendPosition)) { legendPosition <- C_POSITION_RIGHT_TOP } srcCmd <- .showPlotSourceInformation(objectName = designPlanName, xParameterName = xParameterNameSrc, yParameterNames = yParameterNamesSrc, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) if (groupedPlotEnabled) { tableColumnNames <- C_TABLE_COLUMN_NAMES criticalValuesName <- designPlan$.getDataFrameColumnCaption("criticalValuesEffectScale", tableColumnNames, TRUE) futilityBoundsName <- designPlan$.getDataFrameColumnCaption("futilityBoundsEffectScale", tableColumnNames, TRUE) designPlan <- data.frame( xValues = rep(data[[xParameterName]], 4), yValues = c(data$criticalValues, data$criticalValuesMirrored, data$futilityBounds, data$futilityBoundsMirrored), categories = c(rep(criticalValuesName, nrow(data)), rep("criticalValuesMirrored", nrow(data)), rep(futilityBoundsName, nrow(data)), rep("futilityBoundsMirrored", nrow(data))), groups = c(rep(criticalValuesName, 2 * nrow(data)), rep(futilityBoundsName, 2 * nrow(data)))) } else { designPlan <- data } } else if (type == 3) { # Stage Levels if (is.na(main)) { main <- PlotSubTitleItems(title = "Boundaries p Values Scale") .addPlotSubTitleItems(designPlan, designMaster, main, type) if (!is.null(reducedParam)) { main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) } } if (.isTrialDesignPlanSurvival(designPlan)) { xParameterName <- "eventsPerStage" yParameterNames <- "stageLevels" designPlan <- data.frame( eventsPerStage = designPlan$eventsPerStage[, 1], stageLevels = designMaster$stageLevels ) xParameterNameSrc <- "eventsPerStage[, 1]" yParameterNamesSrc <- ".design$stageLevels" } else { xParameterName <- "informationRates" yParameterNames <- "stageLevels" designPlan <- TrialDesignSet(design = designMaster, singleDesign = TRUE) xParameterNameSrc <- ".design$informationRates" yParameterNamesSrc <- ".design$stageLevels" } srcCmd <- .showPlotSourceInformation(objectName = designPlanName, xParameterName = xParameterNameSrc, yParameterNames = yParameterNamesSrc, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) } else if (type == 4) { # Alpha Spending if (is.na(main)) { main <- PlotSubTitleItems(title = "Error Spending") .addPlotSubTitleItems(designPlan, designMaster, main, type) if (!is.null(reducedParam)) { main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) } } if (.isTrialDesignPlanSurvival(designPlan)) { xParameterName <- "eventsPerStage" yParameterNames <- "alphaSpent" designPlan <- data.frame( eventsPerStage = designPlan$eventsPerStage[, 1], alphaSpent = designMaster$alphaSpent ) xParameterNameSrc <- "eventsPerStage[, 1]" yParameterNamesSrc <- ".design$alphaSpent" } else { xParameterName <- "informationRates" yParameterNames <- "alphaSpent" designPlan <- TrialDesignSet(design = designMaster, singleDesign = TRUE) xParameterNameSrc <- ".design$informationRates" yParameterNamesSrc <- ".design$alphaSpent" } plotPointsEnabled <- ifelse(is.na(plotPointsEnabled), FALSE, plotPointsEnabled) srcCmd <- .showPlotSourceInformation(objectName = designPlanName, xParameterName = xParameterNameSrc, yParameterNames = yParameterNamesSrc, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) } else if (type == 5) { # Power and Stopping Probabilities .assertIsValidVariedParameterVectorForPlotting(designPlan, type) if (designPlan$.isSampleSizeObject()) { if (is.na(main)) { main <- PlotSubTitleItems(title = "Sample Size") .addPlotSubTitleItems(designPlan, designMaster, main, type) } yAxisScalingEnabled <- TRUE if (.isTrialDesignPlanMeans(designPlan)) { xParameterName <- "alternative" yParameterNames <- c("nFixed") if (designMaster$kMax > 1) { yParameterNames <- c(yParameterNames, "maxNumberOfSubjects", "expectedNumberOfSubjectsH1") } if (is.na(ylab)) { ylab <- "Sample Size" } yAxisScalingEnabled <- FALSE if (is.na(legendPosition)) { legendPosition <- C_POSITION_RIGHT_TOP } yParameterNamesSrc <- yParameterNames } else if (.isTrialDesignPlanRates(designPlan)) { xParameterName <- "pi1" yParameterNames <- c("nFixed") if (designMaster$kMax > 1) { yParameterNames <- c(yParameterNames, "maxNumberOfSubjects", "expectedNumberOfSubjectsH1") } if (is.na(ylab)) { ylab <- "Sample Size" } yAxisScalingEnabled <- FALSE if (is.na(legendPosition)) { legendPosition <- C_POSITION_RIGHT_TOP } yParameterNamesSrc <- yParameterNames } else if (.isTrialDesignPlanSurvival(designPlan)) { designPlan <- data.frame( hazardRatio = designPlan$hazardRatio, eventsFixed = designPlan$eventsFixed, maxNumberOfEvents = designPlan$eventsPerStage[designMaster$kMax, ], expectedEventsH1 = designPlan$expectedEventsH1 ) xParameterName <- "hazardRatio" yParameterNames <- c("eventsFixed") if (designMaster$kMax > 1) { yParameterNames <- c(yParameterNames, "maxNumberOfEvents", "expectedEventsH1") } if (is.na(ylab)) { ylab <- "# Events" } if (is.na(legendPosition)) { legendPosition <- C_POSITION_RIGHT_TOP } yParameterNamesSrc <- c("eventsFixed", paste0("eventsPerStage[", designMaster$kMax, ", ]"), "expectedEventsH1") } srcCmd <- .showPlotSourceInformation(objectName = designPlanName, xParameterName = xParameterName, yParameterNames = yParameterNamesSrc, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) if (!is.null(srcCmd)) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(srcCmd)) } return(srcCmd) } return(.plotParameterSet(parameterSet = designPlan, designMaster = designMaster, xParameterName = xParameterName, yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, variedParameters = variedParameters, qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, plotSettings = plotSettings, ...)) } else { if (is.na(main)) { main <- PlotSubTitleItems(title = "Overall Power and Early Stopping") .addPlotSubTitleItems(designPlan, designMaster, main, type) } if (.isTrialDesignPlanSurvival(designPlan)) { xParameterName <- "hazardRatio" } else { xParameterName <- "effect" } yParameterNames <- c("overallReject", "futilityStop", "earlyStop") if (is.na(ylab)) { ylab <- "" } if (is.na(legendPosition)) { legendPosition <- C_POSITION_LEFT_TOP } srcCmd <- .showPlotSourceInformation(objectName = designPlanName, xParameterName = xParameterName, yParameterNames = yParameterNames, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) if (!is.null(srcCmd)) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(srcCmd)) } return(srcCmd) } if (is.null(list(...)[["ylim"]])) { ylim <- c(0, 1) return(.plotParameterSet(parameterSet = designPlan, designMaster = designMaster, xParameterName = xParameterName, yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, variedParameters = variedParameters, qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, plotSettings = plotSettings, ylim = ylim, ...)) } else { return(.plotParameterSet(parameterSet = designPlan, designMaster = designMaster, xParameterName = xParameterName, yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, variedParameters = variedParameters, qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, plotSettings = plotSettings, ...)) } } } else if (type == 6) { # Average Sample Size / Average Event Number .assertIsValidVariedParameterVectorForPlotting(designPlan, type) if (is.na(main)) { titlePart <- ifelse(.isTrialDesignPlanSurvival(designPlan), "Number of Events", "Sample Size") main <- PlotSubTitleItems(title = paste0("Expected ", titlePart, " and Power / Early Stop")) .addPlotSubTitleItems(designPlan, designMaster, main, type) } if (.isTrialDesignPlanSurvival(designPlan)) { xParameterName <- "hazardRatio" yParameterNames <- "expectedNumberOfEvents" expectedNumberOfEvents <- designPlan[["expectedNumberOfEvents"]] if (is.null(expectedNumberOfEvents) || length(expectedNumberOfEvents) == 0) { yParameterNames <- "expectedEventsH1" } yParameterNames <- c(yParameterNames, "overallReject", "earlyStop") # overallReject = power if (is.na(legendPosition)) { legendPosition <- C_POSITION_RIGHT_CENTER } } else { xParameterName <- "effect" yParameterNames <- c("expectedNumberOfSubjects", "overallReject", "earlyStop") # overallReject = power } srcCmd <- .showPlotSourceInformation(objectName = designPlanName, xParameterName = xParameterName, yParameterNames = yParameterNames, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) } else if (type == 7) { .assertIsValidVariedParameterVectorForPlotting(designPlan, type) if (is.na(main)) { main <- PlotSubTitleItems(title = "Overall Power") .addPlotSubTitleItems(designPlan, designMaster, main, type) } if (.isTrialDesignPlanSurvival(designPlan)) { xParameterName <- "hazardRatio" } else { xParameterName <- "effect" } yParameterNames <- "overallReject" if (is.na(legendPosition)) { legendPosition <- C_POSITION_RIGHT_CENTER } srcCmd <- .showPlotSourceInformation(objectName = designPlanName, xParameterName = xParameterName, yParameterNames = yParameterNames, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) } else if (type == 8) { .assertIsValidVariedParameterVectorForPlotting(designPlan, type) if (is.na(main)) { main <- PlotSubTitleItems(title = "Overall Early Stopping") .addPlotSubTitleItems(designPlan, designMaster, main, type) } if (.isTrialDesignPlanSurvival(designPlan)) { xParameterName <- "hazardRatio" } else { xParameterName <- "effect" } yParameterNames <- c("earlyStop", "futilityStop") if (is.na(legendPosition)) { legendPosition <- C_POSITION_RIGHT_CENTER } srcCmd <- .showPlotSourceInformation(objectName = designPlanName, xParameterName = xParameterName, yParameterNames = yParameterNames, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) } else if (type == 9) { .assertIsValidVariedParameterVectorForPlotting(designPlan, type) if (is.na(main)) { if (.isTrialDesignPlanSurvival(designPlan)) { main <- PlotSubTitleItems(title = "Expected Number of Events") } else { main <- PlotSubTitleItems(title = "Expected Sample Size") } .addPlotSubTitleItems(designPlan, designMaster, main, type) } if (.isTrialDesignPlanSurvival(designPlan)) { xParameterName <- "hazardRatio" yParameterNames <- "expectedNumberOfEvents" expectedNumberOfEvents <- designPlan[["expectedNumberOfEvents"]] if (is.null(expectedNumberOfEvents) || length(expectedNumberOfEvents) == 0) { yParameterNames <- c("expectedEventsH0", "expectedEventsH1") if (is.na(legendPosition)) { legendPosition <- C_POSITION_RIGHT_CENTER } } } else { xParameterName <- "effect" yParameterNames <- "expectedNumberOfSubjects" } srcCmd <- .showPlotSourceInformation(objectName = designPlanName, xParameterName = xParameterName, yParameterNames = yParameterNames, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) } else if (.isTrialDesignPlanSurvival(designPlan)) { if (type == 10) { # Study Duration .assertIsValidVariedParameterVectorForPlotting(designPlan, type) if (is.na(main)) { main <- PlotSubTitleItems(title = "Study Duration") .addPlotSubTitleItems(designPlan, designMaster, main, type) } xParameterName <- "hazardRatio" yParameterNames <- "studyDuration" srcCmd <- .showPlotSourceInformation(objectName = designPlanName, xParameterName = xParameterName, yParameterNames = yParameterNames, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) } else if (type == 11) { .assertIsValidVariedParameterVectorForPlotting(designPlan, type) if (is.na(main)) { main <- PlotSubTitleItems(title = "Expected Number of Subjects") .addPlotSubTitleItems(designPlan, designMaster, main, type) } xParameterName <- "hazardRatio" yParameterNames <- "expectedNumberOfSubjects" srcCmd <- .showPlotSourceInformation(objectName = designPlanName, xParameterName = xParameterName, yParameterNames = yParameterNames, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) } else if (type == 12) { # Analysis Time .assertIsValidVariedParameterVectorForPlotting(designPlan, type) if (is.na(main)) { main <- PlotSubTitleItems(title = "Analysis Time") .addPlotSubTitleItems(designPlan, designMaster, main, type) } xParameterName <- "hazardRatio" yParameterNames <- "analysisTime" yParameterNamesSrc <- c() for (i in 1:nrow(designPlan[["analysisTime"]])) { yParameterNamesSrc <- c(yParameterNamesSrc, paste0("analysisTime[", i, ", ]")) } data <- NULL for (k in 1:designMaster$kMax) { part <- data.frame( categories = rep(k, length(designPlan$hazardRatio)), xValues = designPlan$hazardRatio, yValues = designPlan$analysisTime[k, ] ) if (is.null(data)) { data <- part } else { data <- rbind(data, part) } } srcCmd <- .showPlotSourceInformation(objectName = designPlanName, xParameterName = xParameterName, yParameterNames = yParameterNamesSrc, hint = showSourceHint, type = type, showSource = showSource) if (!is.null(srcCmd)) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(srcCmd)) } return(srcCmd) } return(.plotDataFrame(data, mainTitle = main, xlab = NA_character_, ylab = NA_character_, xAxisLabel = "Hazard Ratio", yAxisLabel1 = "Analysis Time", yAxisLabel2 = NA_character_, plotPointsEnabled = TRUE, legendTitle = "Stage", legendPosition = legendPosition, sided = designMaster$sided, plotSettings = plotSettings, ...)) } else if (type == 13 || type == 14) { # Cumulative Distribution Function / Survival function return(.plotSurvivalFunction(designPlan, designMaster = designMaster, type = type, main = main, xlab = xlab, ylab = ylab, palette = palette, legendPosition = legendPosition, showSource = showSource, designPlanName = designPlanName, plotSettings = plotSettings, ...)) } else { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, ..., 14") } } else { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, ..., 9") } if (!is.null(srcCmd)) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(srcCmd)) } return(srcCmd) } return(.plotParameterSet(parameterSet = designPlan, designMaster = designMaster, xParameterName = xParameterName, yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, variedParameters = variedParameters, qnormAlphaLineEnabled = (type != 2), ratioEnabled = ratioEnabled, plotSettings = plotSettings, ...)) } .getSurvivalFunctionPlotCommand <- function(functionType = c("pwExpDist", "lambdaStep"), timeValues, lambda, designPlan, type, piecewiseSurvivalEnabled, multiplyByHazardRatio = FALSE) { functionType <- match.arg(functionType) signPrefix <- ifelse(type == 13, "", "-") if (functionType == "pwExpDist") { functionName <- "getPiecewiseExponentialDistribution" } else { functionName <- "getLambdaStepFunction" } cmd <- paste0(signPrefix, functionName, "(", .reconstructSequenceCommand(timeValues), ", piecewiseLambda = ", .arrayToString(lambda, vectorLookAndFeelEnabled = TRUE)) if (piecewiseSurvivalEnabled) { cmd <- paste0(cmd, ", piecewiseSurvivalTime = ", .arrayToString(designPlan$piecewiseSurvivalTime, vectorLookAndFeelEnabled = TRUE)) } if (functionType == "pwExpDist") { cmd <- paste0(cmd, ", kappa = ", designPlan$kappa) } cmd <- paste0(cmd, ")") if (multiplyByHazardRatio) { cmd <- paste0(cmd, " * ", designPlan$hazardRatio[1]) } return(cmd) } # Cumulative Distribution Function / Survival function .plotSurvivalFunction <- function(designPlan, ..., designMaster, type = 1L, main = NA_character_, xlab = NA_character_, ylab = NA_character_, palette = "Set1", legendPosition = NA_integer_, showSource = FALSE, designPlanName = NA_character_, plotSettings = NULL) { if (is.null(designPlan$piecewiseSurvivalTime) || length(designPlan$piecewiseSurvivalTime) == 0) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'piecewiseSurvivalTime' must be specified") } lambda1 <- designPlan[["lambda1"]] lambda2 <- designPlan[["lambda2"]] if (is.null(lambda2) || length(lambda2) == 0) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lambda2' must be specified") } if (is.null(designPlan$kappa) || length(designPlan$kappa) == 0) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'kappa' must be specified") } if (is.null(designPlan$hazardRatio) || length(designPlan$hazardRatio) == 0) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'hazardRatio' must be specified") } piecewiseSurvivalEnabled <- designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled if (is.na(main)) { if (type == 13) { main <- PlotSubTitleItems(title = "Cumulative Distribution Function") } else { main <- PlotSubTitleItems(title = "Survival Function") } .addPlotSubTitleItems(designPlan, designMaster, main, type) if (!piecewiseSurvivalEnabled) { if (designPlan$.piecewiseSurvivalTime$.isLambdaBased(minNumberOfLambdas = 1)) { main$add("lambda", round(designPlan$lambda1[1],4), 1) main$add("lambda", round(designPlan$lambda2,4), 2) } else { main$add("pi", round(designPlan$pi1[1],3), 1) main$add("pi", round(designPlan$pi2,3), 2) } } else if (length(designPlan$hazardRatio) == 1) { main$add("Hazard Ratio", round(designPlan$hazardRatio[1],3)) } } if (!piecewiseSurvivalEnabled || (length(designPlan$piecewiseSurvivalTime) == 1 && designPlan$piecewiseSurvivalTime[1] == 0)) { timeTo <- max(designPlan$analysisTime[designMaster$kMax, ]) } else { timeTo <- max(designPlan$piecewiseSurvivalTime) } if (is.na(timeTo) || !is.numeric(timeTo) || is.infinite(timeTo)) { #warning("Unable to determine upper bound of time values", call. = FALSE) timeTo <- 0 } timeValues <- seq(0, timeTo + 10, 0.1) data <- data.frame( time = timeValues, lambdaGroup1 = rep(-1, length(timeValues)), lambdaGroup2 = rep(-1, length(timeValues)), survival1 = rep(-1, length(timeValues)), survival2 = rep(-1, length(timeValues)), survivalGroup1 = rep(-1, length(timeValues)), survivalGroup2 = rep(-1, length(timeValues)) ) signPrefix <- ifelse(type == 13, "", "-") if (piecewiseSurvivalEnabled) { data$survival2 <- .getPiecewiseExponentialDistribution(timeValues, lambda2, designPlan$piecewiseSurvivalTime, designPlan$kappa) yParameterNames <- .getSurvivalFunctionPlotCommand("pwExpDist", timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled) if (!is.null(lambda1) && !is.na(lambda1) && length(lambda1) == length(lambda2)) { data$survival1 <- .getPiecewiseExponentialDistribution(timeValues, lambda1, designPlan$piecewiseSurvivalTime, designPlan$kappa) yParameterNames <- c(yParameterNames, .getSurvivalFunctionPlotCommand("pwExpDist", timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled)) } else { .warnInCaseOfUnusedValuesForPlottingSurvival(designPlan$hazardRatio) data$survival1 <- data$survival2 * designPlan$hazardRatio[1] yParameterNames <- c(yParameterNames, .getSurvivalFunctionPlotCommand("pwExpDist", timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled, multiplyByHazardRatio = TRUE)) } yParameterNames <- c(yParameterNames, .getSurvivalFunctionPlotCommand("lambdaStep", timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled)) if (!is.null(lambda1) && !is.na(lambda1) && length(lambda1) == length(lambda2)) { yParameterNames <- c(yParameterNames, .getSurvivalFunctionPlotCommand("lambdaStep", timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled)) } else { yParameterNames <- c(yParameterNames, .getSurvivalFunctionPlotCommand("lambdaStep", timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled, multiplyByHazardRatio = TRUE)) } } else { if (designPlan$.piecewiseSurvivalTime$.isLambdaBased(minNumberOfLambdas = 1)) { if (length(designPlan$lambda1) > 1) { lambda1 <- designPlan$lambda1[1] warning("Only the first 'lambda1' (", round(lambda1, 4), ") was used for plotting", call. = FALSE) } } else { .warnInCaseOfUnusedValuesForPlottingRates(designPlan$pi1) } if (!is.na(designPlan$pi1) && !is.na(designPlan$pi2)) { lambda2 <- (-log(1 - designPlan$pi2))^(1 / designPlan$kappa) / designPlan$eventTime lambda1 <- (-log(1 - designPlan$pi1[1]))^(1 / designPlan$kappa) / designPlan$eventTime } data$survival2 <- .getPiecewiseExponentialDistribution(timeValues, lambda2, 0, designPlan$kappa) data$survival1 <- .getPiecewiseExponentialDistribution(timeValues, lambda1, 0, designPlan$kappa) yParameterNames <- .getSurvivalFunctionPlotCommand("pwExpDist", timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled) yParameterNames <- c(yParameterNames, .getSurvivalFunctionPlotCommand("pwExpDist", timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled)) yParameterNames <- c(yParameterNames, .getSurvivalFunctionPlotCommand("lambdaStep", timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled)) yParameterNames <- c(yParameterNames, .getSurvivalFunctionPlotCommand("lambdaStep", timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled)) } # two groups: 1 = treatment, 2 = control if (type == 14) { data$survival1 <- 1 - data$survival1 data$survival2 <- 1 - data$survival2 } if (piecewiseSurvivalEnabled) { data$lambdaGroup2 <- .getLambdaStepFunction(timeValues, designPlan$piecewiseSurvivalTime, lambda2) if (length(lambda1) == 1) { if (!is.na(lambda1)) { data$lambdaGroup1 <- rep(lambda1, length(data$lambdaGroup2)) } else { data$lambdaGroup1 <- data$lambdaGroup2 * designPlan$hazardRatio[1] } } else { data$lambdaGroup1 <- .getLambdaStepFunction(timeValues, designPlan$piecewiseSurvivalTime, lambda1) } } else { data$lambdaGroup2 <- .getLambdaStepFunction(timeValues, 0, lambda2) data$lambdaGroup1 <- .getLambdaStepFunction(timeValues, 0, lambda1) } scalingBaseValues1 <- na.omit(c(data$survival1, data$survival2)) scalingBaseValues2 <- na.omit(c(data$lambdaGroup1, data$lambdaGroup2)) scalingFactor <- 1 if (length(scalingBaseValues1) > 0 && length(scalingBaseValues2) > 0) { scalingFactor <- max(scalingBaseValues1) / max(.getNextHigherValue(scalingBaseValues2)) } data2 <- data.frame( categories = c( rep("Treatm. piecew. exp.", nrow(data)), rep("Control piecew. exp.", nrow(data)), rep("Treatm. piecew. lambda", nrow(data)), rep("Control piecew. lambda", nrow(data)) ), xValues = rep(data$time, 4), yValues = c( data$survival1, data$survival2, data$lambdaGroup1 * scalingFactor, data$lambdaGroup2 * scalingFactor ) ) if (is.na(legendPosition)) { if (type == 13) { legendPosition <- C_POSITION_LEFT_TOP } else { legendPosition <- C_POSITION_RIGHT_TOP } } if (is.na(palette) || palette == "Set1") { palette <- "Paired" } if (type == 13) { yAxisLabel1 <- "Cumulative Distribution Function" } else { yAxisLabel1 <- "Survival Function" } srcCmd <- .showPlotSourceInformation(objectName = designPlanName, xParameterName = "time", yParameterNames = yParameterNames, showSource = showSource, xValues = timeValues) if (!is.null(srcCmd)) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(srcCmd)) } return(srcCmd) } if (is.null(plotSettings)) { plotSettings <- designPlan$.plotSettings } return(.plotDataFrame(data2, mainTitle = main, xlab = xlab, ylab = ylab, xAxisLabel = "Time", yAxisLabel1 = yAxisLabel1, yAxisLabel2 = "Lambda", plotPointsEnabled = FALSE, legendTitle = NA_character_, legendPosition = legendPosition, scalingFactor1 = 1, scalingFactor2 = scalingFactor, palette = palette, sided = designMaster$sided, plotSettings = plotSettings)) } .warnInCaseOfUnusedValuesForPlottingMeans <- function(alternative) { if (length(alternative) > 1) { warning("Only the first 'alternative' (", round(alternative[1], 3), ") was used for plotting", call. = FALSE) return(list(title = "alternative", value = alternative[1], subscript = NA_character_)) } return(NULL) } .warnInCaseOfUnusedValuesForPlottingRates <- function(pi1) { if (length(pi1) > 1) { warning("Only the first 'pi1' (", round(pi1[1], 3), ") was used for plotting", call. = FALSE) return(list(title = "pi", value = pi1[1], subscript = "1")) } return(NULL) } .warnInCaseOfUnusedValuesForPlottingSurvival <- function(hazardRatio) { if (length(hazardRatio) > 1) { warning("Only the first 'hazardRatio' (", round(hazardRatio[1], 3), ") was used for plotting", call. = FALSE) return(list(title = "hazardRatio", value = hazardRatio[1], subscript = NA_character_)) } return(NULL) } .warnInCaseOfUnusedValuesForPlotting <- function(designPlan) { if (.isTrialDesignPlanMeans(designPlan) && designPlan$.isSampleSizeObject()) { return(.warnInCaseOfUnusedValuesForPlottingMeans(designPlan$alternative)) } if (.isTrialDesignPlanRates(designPlan) && designPlan$.isSampleSizeObject()) { return(.warnInCaseOfUnusedValuesForPlottingRates(designPlan$pi1)) } if (.isTrialDesignPlanSurvival(designPlan) && designPlan$.isSampleSizeObject()) { return(.warnInCaseOfUnusedValuesForPlottingSurvival(designPlan$hazardRatio)) } return(NULL) } #' #' @title #' Trial Design Plan Plotting #' #' @param x The trial design plan, obtained from \cr #' \code{\link{getSampleSizeMeans}}, \cr #' \code{\link{getSampleSizeRates}}, \cr #' \code{\link{getSampleSizeSurvival}}, \cr #' \code{\link{getPowerMeans}}, \cr #' \code{\link{getPowerRates}} or \cr #' \code{\link{getPowerSurvival}}. #' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). #' @param main The main title. #' @param xlab The x-axis label. #' @param ylab The y-axis label. #' @inheritParams param_palette #' @inheritParams param_theta #' @inheritParams param_plotPointsEnabled #' @inheritParams param_showSource #' @inheritParams param_plotSettings #' @inheritParams param_legendPosition #' @inheritParams param_grid #' @param type The plot type (default = \code{1}). The following plot types are available: #' \itemize{ #' \item \code{1}: creates a 'Boundaries' plot #' \item \code{2}: creates a 'Boundaries Effect Scale' plot #' \item \code{3}: creates a 'Boundaries p Values Scale' plot #' \item \code{4}: creates a 'Error Spending' plot #' \item \code{5}: creates a 'Sample Size' or 'Overall Power and Early Stopping' plot #' \item \code{6}: creates a 'Number of Events' or 'Sample Size' plot #' \item \code{7}: creates an 'Overall Power' plot #' \item \code{8}: creates an 'Overall Early Stopping' plot #' \item \code{9}: creates an 'Expected Number of Events' or 'Expected Sample Size' plot #' \item \code{10}: creates a 'Study Duration' plot #' \item \code{11}: creates an 'Expected Number of Subjects' plot #' \item \code{12}: creates an 'Analysis Times' plot #' \item \code{13}: creates a 'Cumulative Distribution Function' plot #' \item \code{14}: creates a 'Survival Function' plot #' \item \code{"all"}: creates all available plots and returns it as a grid plot or list #' } #' @inheritParams param_three_dots_plot #' #' @description #' Plots a trial design plan. #' #' @details #' Generic function to plot all kinds of trial design plans. #' #' @examples #' \donttest{ #' if (require(ggplot2)) plot(getSampleSizeMeans()) #' } #' #' @template return_object_ggplot #' #' @export #' plot.TrialDesignPlan <- function(x, y, ..., main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = ifelse(x$.design$kMax == 1, 5L, 1L), palette = "Set1", theta = seq(-1, 1, 0.01), plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, grid = 1, plotSettings = NULL) { fCall = match.call(expand.dots = FALSE) designPlanName <- deparse(fCall$x) .assertIsSingleInteger(grid, "grid", validateType = FALSE) nMax <- list(...)[["nMax"]] if (!is.null(nMax)) { warning(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'nMax' (", nMax, ") will be ignored because it will be taken from design plan") } typeNumbers <- .getPlotTypeNumber(type, x) if (is.null(plotSettings)) { plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) } p <- NULL plotList <- list() for (typeNumber in typeNumbers) { p <- .plotTrialDesignPlan(designPlan = x, main = main, xlab = xlab, ylab = ylab, type = typeNumber, palette = palette, theta = theta, plotPointsEnabled = plotPointsEnabled, legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), showSource = showSource, designPlanName = designPlanName, plotSettings = plotSettings, ...) .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) if (length(typeNumbers) > 1) { caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) plotList[[caption]] <- p } } if (length(typeNumbers) == 1) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(p)) } return(p) } if (length(plotList) == 0) { message("No plots available for the specified design plan for ", x$.toString()) } if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(plotList)) } return(.createPlotResultObject(plotList, grid)) } rpact/R/class_design.R0000644000175000017500000010207314145656364014520 0ustar nileshnilesh## | ## | *Trial design classes* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include f_core_constants.R #' @include f_core_plot.R NULL #' #' @name TrialDesign #' #' @title #' Basic Trial Design #' #' @description #' Basic class for trial designs. #' #' @details #' \code{TrialDesign} is the basic class for #' \itemize{ #' \item \code{\link{TrialDesignFisher}}, #' \item \code{\link{TrialDesignGroupSequential}}, and #' \item \code{\link{TrialDesignInverseNormal}}. #' } #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include f_core_constants.R #' @include f_core_plot.R #' #' @keywords internal #' #' @importFrom methods new #' TrialDesign <- setRefClass("TrialDesign", contains = "ParameterSet", fields = list( .plotSettings = "PlotSettings", kMax = "integer", alpha = "numeric", stages = "integer", informationRates = "numeric", userAlphaSpending = "numeric", criticalValues = "numeric", stageLevels = "numeric", alphaSpent = "numeric", bindingFutility = "logical", tolerance = "numeric" ), methods = list( initialize = function(..., alpha = NA_real_, informationRates = NA_real_, userAlphaSpending = NA_real_, criticalValues = NA_real_, stageLevels = NA_real_, alphaSpent = NA_real_, bindingFutility = NA, tolerance = 1e-06 # C_ANALYSIS_TOLERANCE_DEFAULT ) { callSuper(..., alpha = alpha, informationRates = informationRates, userAlphaSpending = userAlphaSpending, criticalValues = criticalValues, stageLevels = stageLevels, alphaSpent = alphaSpent, bindingFutility = bindingFutility, tolerance = tolerance) .plotSettings <<- PlotSettings() if (inherits(.self, "TrialDesignConditionalDunnett")) { .parameterNames <<- C_PARAMETER_NAMES } else { .parameterNames <<- .getSubListByNames(.getParameterNames(design = .self), c( "stages", "kMax", "alpha", "informationRates", "userAlphaSpending", "criticalValues", "stageLevels", "alphaSpent", "bindingFutility", "tolerance" )) } .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS .initStages() }, show = function(showType = 1, digits = NA_integer_) { .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { 'Method for automatically printing trial design objects' .resetCat() if (showType == 3) { .createSummary(.self, digits = digits)$.show(showType = 1, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else if (showType == 2) { callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { .cat("Design parameters and output of ", .toString(), ":\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getDerivedParameters(), "Derived from user defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getGeneratedParameters(), "Output", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) } }, .toString = function(startWithUpperCase = FALSE) { s <- "unknown trial design" if (.isTrialDesignGroupSequential(.self)) { s <- "group sequential design" } else if (.isTrialDesignInverseNormal(.self)) { s <- "inverse normal combination test design" } else if (.isTrialDesignFisher(.self)) { s <- "Fisher's combination test design" } else if (.isTrialDesignConditionalDunnett(.self)) { s <- "conditional Dunnett test design" } return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) }, .initStages = function() { if (length(kMax) == 1 && !is.na(kMax) && kMax > 0) { stages <<- c(1L:kMax) if (kMax == C_KMAX_DEFAULT) { .setParameterType("stages", C_PARAM_DEFAULT_VALUE) } else { type <- .getParameterType("kMax") .setParameterType("stages", ifelse(type != C_PARAM_TYPE_UNKNOWN, type, C_PARAM_USER_DEFINED)) } } else { .setParameterType("stages", C_PARAM_NOT_APPLICABLE) } }, .setParameterType = function(parameterName, parameterType) { parameterType <- callSuper(parameterName = parameterName, parameterType = parameterType) if (parameterName == "futilityBounds" && !is.null(bindingFutility) && length(bindingFutility) == 1 && !is.na(bindingFutility) && !bindingFutility) { .parameterNames$futilityBounds <<- C_PARAMETER_NAMES[["futilityBoundsNonBinding"]] } invisible(parameterType) }, .isTrialDesignFisher = function(design = .self) { return(class(design) == C_CLASS_NAME_TRIAL_DESIGN_FISHER) } ) ) #' #' @name TrialDesignCharacteristics #' #' @title #' Trial Design Characteristics #' #' @description #' Class for trial design characteristics. #' #' @details #' \code{TrialDesignCharacteristics} contains all fields required to collect the characteristics of a design. #' This object should not be created directly; use \code{getDesignCharacteristics} #' with suitable arguments to create it. #' #' @seealso \code{\link{getDesignCharacteristics}} for getting the design characteristics. #' #' @include class_core_parameter_set.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' TrialDesignCharacteristics <- setRefClass("TrialDesignCharacteristics", contains = "ParameterSet", fields = list( .design = "TrialDesign", .probs = "matrix", nFixed = "numeric", shift = "numeric", inflationFactor = "numeric", stages = "integer", information = "numeric", power = "numeric", rejectionProbabilities = "numeric", # efficacy probabilities futilityProbabilities = "numeric", averageSampleNumber1 = "numeric", averageSampleNumber01 = "numeric", averageSampleNumber0 = "numeric" ), methods = list( initialize = function(design, ...) { callSuper(.design = design, ...) .parameterNames <<- .getParameterNames(design = design) .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS .initStages() }, show = function(showType = 1, digits = NA_integer_) { .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { 'Method for automatically printing trial design characteristics objects' .resetCat() if (showType == 2) { callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { .showParametersOfOneGroup(.getGeneratedParameters(), title = .toString(startWithUpperCase = TRUE), orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) } }, .initStages = function() { if (!is.na(.design$kMax) && .design$kMax > 0) { stages <<- c(1L:.design$kMax) if (.design$kMax == C_KMAX_DEFAULT) { .setParameterType("stages", C_PARAM_DEFAULT_VALUE) } else { .setParameterType("stages", C_PARAM_USER_DEFINED) } } else { .setParameterType("stages", C_PARAM_NOT_APPLICABLE) } }, .toString = function(startWithUpperCase = FALSE) { return(paste(.design$.toString(startWithUpperCase = startWithUpperCase), "characteristics")) } ) ) #' #' @name TrialDesignCharacteristics_as.data.frame #' #' @title #' Coerce TrialDesignCharacteristics to a Data Frame #' #' @description #' Returns the \code{TrialDesignCharacteristics} as data frame. #' #' @param x A \code{\link{TrialDesignCharacteristics}} object. #' @inheritParams param_niceColumnNamesEnabled #' @inheritParams param_includeAllParameters #' @inheritParams param_three_dots #' #' @details #' Each element of the \code{\link{TrialDesignCharacteristics}} is converted to a column in the data frame. #' #' @template return_dataframe #' #' @examples #' as.data.frame(getDesignCharacteristics(getDesignGroupSequential())) #' #' @export #' #' @keywords internal #' as.data.frame.TrialDesignCharacteristics <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { if (x$.design$kMax > 1) { parameterNamesToBeExcluded = c("nFixed", "shift") } else { parameterNamesToBeExcluded = c("inflationFactor") } return(x$.getAsDataFrame(parameterNames = parameterNamesToBeExcluded, niceColumnNamesEnabled = niceColumnNamesEnabled, includeAllParameters = includeAllParameters, handleParameterNamesAsToBeExcluded = TRUE, tableColumnNames = .getTableColumnNames(design = x$.design))) } #' #' @name TrialDesignFisher #' #' @title #' Fisher Design #' #' @description #' Trial design for Fisher's combination test. #' #' @details #' This object should not be created directly; use \code{\link{getDesignFisher}} #' with suitable arguments to create a Fisher combination test design. #' #' @seealso \code{\link{getDesignFisher}} for creating a Fisher combination test design. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' TrialDesignFisher <- setRefClass(C_CLASS_NAME_TRIAL_DESIGN_FISHER, contains = "TrialDesign", fields = list( method = "character", alpha0Vec = "numeric", scale = "numeric", nonStochasticCurtailment = "logical", sided = "integer", simAlpha = "numeric", iterations = "integer", seed = "numeric" ), methods = list( initialize = function(..., method = NA_character_, alpha0Vec = NA_real_, scale = NA_real_, nonStochasticCurtailment = FALSE, sided = as.integer(C_SIDED_DEFAULT), simAlpha = NA_real_, iterations = 0L, seed = NA_real_, tolerance = C_ANALYSIS_TOLERANCE_FISHER_DEFAULT) { callSuper(..., method = method, alpha0Vec = alpha0Vec, scale = scale, nonStochasticCurtailment = nonStochasticCurtailment, sided = sided, simAlpha = simAlpha, iterations = iterations, seed = seed, tolerance = tolerance ) .parameterNames <<- c(.parameterNames, .getSubListByNames( .getParameterNames(design = .self), c( "method", "alpha0Vec", "scale", "nonStochasticCurtailment", "sided", "simAlpha" ))) .parameterFormatFunctions$criticalValues <<- ".formatCriticalValuesFisher" .initParameterTypes() .initStages() }, hasChanged = function(kMax, alpha, sided, method, informationRates, alpha0Vec, userAlphaSpending, bindingFutility) { informationRatesTemp <- informationRates if (any(is.na(informationRatesTemp))) { informationRatesTemp <- (1:kMax) / kMax } alpha0VecTemp <- alpha0Vec[1:(kMax - 1)] if (any(is.na(alpha0VecTemp))) { alpha0VecTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) } if (!identical(kMax, .self$kMax)) return(TRUE) if (!identical(alpha, .self$alpha)) return(TRUE) if (!identical(sided, .self$sided)) return(TRUE) if (!identical(method, .self$method)) return(TRUE) if (!identical(informationRatesTemp, .self$informationRates)) return(TRUE) if (!identical(alpha0VecTemp, .self$alpha0Vec)) return(TRUE) if (!identical(userAlphaSpending, .self$userAlphaSpending)) return(TRUE) if (!identical(bindingFutility, .self$bindingFutility)) return(TRUE) return(FALSE) }, # Defines the order of the parameter output .getParametersToShow = function() { return(c( "method", "kMax", "stages", "informationRates", "alpha", "alpha0Vec", "bindingFutility", "sided", "tolerance", "iterations", "seed", "alphaSpent", "userAlphaSpending", "criticalValues", "stageLevels", "scale", "simAlpha", "nonStochasticCurtailment" )) } ) ) #' #' @name TrialDesignInverseNormal #' #' @title #' Inverse Normal Design #' #' @description #' Trial design for inverse normal method. #' #' @details #' This object should not be created directly; use \code{\link{getDesignInverseNormal}} #' with suitable arguments to create a inverse normal design. #' #' @seealso \code{\link{getDesignInverseNormal}} for creating a inverse normal design. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' TrialDesignInverseNormal <- setRefClass(C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL, contains = "TrialDesign", fields = list( typeOfDesign = "character", beta = "numeric", deltaWT = "numeric", deltaPT1 = "numeric", deltaPT0 = "numeric", futilityBounds = "numeric", gammaA = "numeric", gammaB = "numeric", optimizationCriterion = "character", sided = "integer", betaSpent = "numeric", typeBetaSpending = "character", userBetaSpending = "numeric", power = "numeric", twoSidedPower = "logical", constantBoundsHP = "numeric" ), methods = list( initialize = function(..., beta = C_BETA_DEFAULT, betaSpent = NA_real_, sided = C_SIDED_DEFAULT, futilityBounds = NA_real_, typeOfDesign = C_DEFAULT_TYPE_OF_DESIGN, deltaWT = NA_real_, deltaPT1 = NA_real_, deltaPT0 = NA_real_, optimizationCriterion = C_OPTIMIZATION_CRITERION_DEFAULT, gammaA = NA_real_, gammaB = NA_real_, typeBetaSpending = C_TYPE_OF_DESIGN_BS_NONE, userBetaSpending = NA_real_, power = NA_real_, twoSidedPower = C_TWO_SIDED_POWER_DEFAULT, constantBoundsHP = NA_real_ ) { callSuper(..., beta = beta, betaSpent = betaSpent, sided = sided, futilityBounds = futilityBounds, typeOfDesign = typeOfDesign, deltaWT = deltaWT, deltaPT1 = deltaPT1, deltaPT0 = deltaPT0, optimizationCriterion = optimizationCriterion, gammaA = gammaA, gammaB = gammaB, typeBetaSpending = typeBetaSpending, userBetaSpending = userBetaSpending, power = power, twoSidedPower = twoSidedPower, constantBoundsHP = constantBoundsHP ) .parameterNames <<- c(.parameterNames, .getSubListByNames( .getParameterNames(design = .self), c( "beta", "betaSpent", "sided", "futilityBounds", "typeOfDesign", "deltaWT", "deltaPT1", "deltaPT0", "optimizationCriterion", "gammaA", "gammaB", "typeBetaSpending", "userBetaSpending", "power", "twoSidedPower", "constantBoundsHP" ))) .parameterFormatFunctions$criticalValues <<- ".formatCriticalValues" .initParameterTypes() .initStages() }, .formatComparisonResult = function(x) { if (is.null(x) || length(x) == 0 || !is.numeric(x)) { return(x) } s <- sprintf("%.9f", x) s <- sub("\\.0+", "", s) return(s) }, .pasteComparisonResult = function(name, newValue, oldValue) { return(paste0(name, "_new = ", .arrayToString(.formatComparisonResult(newValue)), " (", class(newValue), "), ", name, "_old = ", .arrayToString(.formatComparisonResult(oldValue)), " (", class(oldValue), ")")) }, hasChanged = function(..., kMax, alpha, beta, sided, typeOfDesign, deltaWT, deltaPT1, deltaPT0, informationRates, futilityBounds, optimizationCriterion, typeBetaSpending, gammaA, gammaB, bindingFutility, userAlphaSpending, userBetaSpending, twoSidedPower, constantBoundsHP) { informationRatesTemp <- informationRates if (any(is.na(informationRatesTemp))) { informationRatesTemp <- (1:kMax) / kMax } futilityBoundsTemp <- futilityBounds[1:(kMax - 1)] if (any(is.na(futilityBoundsTemp))) { futilityBoundsTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) } if (!identical(kMax, .self$kMax)) return(.pasteComparisonResult("kMax", kMax, .self$kMax)) if (!identical(alpha, .self$alpha)) return(.pasteComparisonResult("alpha", alpha, .self$alpha)) if (!identical(beta, .self$beta)) return(.pasteComparisonResult("beta", beta, .self$beta)) if (!identical(sided, .self$sided)) return(.pasteComparisonResult("sided", sided, .self$sided)) if (!identical(twoSidedPower, .self$twoSidedPower)) { return(.pasteComparisonResult("twoSidedPower", twoSidedPower, .self$twoSidedPower)) } if (kMax == 1) { return(FALSE) } if (!identical(typeOfDesign, .self$typeOfDesign)) { return(.pasteComparisonResult("typeOfDesign", typeOfDesign, .self$typeOfDesign)) } if (typeOfDesign == C_TYPE_OF_DESIGN_WT) { if (!identical(deltaWT, .self$deltaWT)) { return(.pasteComparisonResult("deltaWT", deltaWT, .self$deltaWT)) } } if (typeOfDesign == C_TYPE_OF_DESIGN_PT) { if (!identical(deltaPT1, .self$deltaPT1)) { return(.pasteComparisonResult("deltaPT1", deltaPT1, .self$deltaPT1)) } if (!identical(deltaPT0, .self$deltaPT0)) { return(.pasteComparisonResult("deltaPT0", deltaPT0, .self$deltaPT0)) } } if (!identical(informationRatesTemp, .self$informationRates)) { return(.pasteComparisonResult("informationRates", informationRatesTemp, .self$informationRates)) } if (.getParameterType("futilityBounds") != C_PARAM_GENERATED && (!grepl("^as.*", typeOfDesign) || typeBetaSpending == C_TYPE_OF_DESIGN_BS_NONE) && !identical(futilityBoundsTemp, .self$futilityBounds)) { return(.pasteComparisonResult("futilityBounds", futilityBoundsTemp, .self$futilityBounds)) } if (!identical(optimizationCriterion, .self$optimizationCriterion)) { return(.pasteComparisonResult("optimizationCriterion", optimizationCriterion, .self$optimizationCriterion)) } if (!identical(typeBetaSpending, .self$typeBetaSpending)) { return(.pasteComparisonResult("typeBetaSpending", typeBetaSpending, .self$typeBetaSpending)) } if (!identical(gammaA, .self$gammaA)) { return(.pasteComparisonResult("gammaA", gammaA, .self$gammaA)) } if (!identical(gammaB, .self$gammaB)) { return(.pasteComparisonResult("gammaB", gammaB, .self$gammaB)) } if ((typeOfDesign == C_TYPE_OF_DESIGN_PT && !identical(bindingFutility, .self$bindingFutility)) || (!identical(bindingFutility, .self$bindingFutility) && .getParameterType("futilityBounds") != C_PARAM_NOT_APPLICABLE && (sided == 1 || !grepl("^as.*", typeOfDesign) || typeBetaSpending == C_TYPE_OF_DESIGN_BS_NONE) && (any(na.omit(futilityBounds) > -6) || any(na.omit(.self$futilityBounds) > -6)) )) { return(.pasteComparisonResult("bindingFutility", bindingFutility, .self$bindingFutility)) } if (!identical(userAlphaSpending, .self$userAlphaSpending)) { return(.pasteComparisonResult("userAlphaSpending", userAlphaSpending, .self$userAlphaSpending)) } if (!identical(userBetaSpending, .self$userBetaSpending)) { return(.pasteComparisonResult("userBetaSpending", userBetaSpending, .self$userBetaSpending)) } if (!identical(twoSidedPower, .self$twoSidedPower)) { return(.pasteComparisonResult("twoSidedPower", twoSidedPower, .self$twoSidedPower)) } if (typeOfDesign == C_TYPE_OF_DESIGN_HP) { if (!identical(constantBoundsHP, .self$constantBoundsHP)) { return(.pasteComparisonResult("constantBoundsHP", constantBoundsHP, .self$constantBoundsHP)) } } return(FALSE) }, # Defines the order of the parameter output .getParametersToShow = function() { return(c( "typeOfDesign", "kMax", "stages", "informationRates", "alpha", "beta", "power", "twoSidedPower", "deltaWT", "deltaPT1", "deltaPT0", "futilityBounds", "bindingFutility", "constantBoundsHP", "gammaA", "gammaB", "optimizationCriterion", "sided", "tolerance", "alphaSpent", "userAlphaSpending", "betaSpent", "typeBetaSpending", "userBetaSpending", "criticalValues", "stageLevels" )) } ) ) #' #' @name TrialDesignGroupSequential #' #' @title #' Group Sequential Design #' #' @description #' Trial design for group sequential design. #' #' @details #' This object should not be created directly; use \code{\link{getDesignGroupSequential}} #' with suitable arguments to create a group sequential design. #' #' @seealso \code{\link{getDesignGroupSequential}} for creating a group sequential design. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' TrialDesignGroupSequential <- setRefClass( C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL, contains = C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL, methods = list( initialize = function(...) { callSuper(...) .parameterFormatFunctions$criticalValues <<- ".formatCriticalValues" .initStages() }, show = function(showType = 1, digits = NA_integer_) { 'Method for automatically printing trial design objects' callSuper(showType = showType, digits = digits) } ) ) #' #' @name TrialDesignConditionalDunnett #' #' @title #' Conditional Dunnett Design #' #' @description #' Trial design for conditional Dunnett tests. #' #' @details #' This object should not be created directly. # This object should not be created directly; use \code{\link{getDesignConditionalDunnett}} # with suitable arguments to create a conditional Dunnett test design. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' #' @seealso \code{\link{getDesignConditionalDunnett}} for creating a conditional Dunnett test design. TrialDesignConditionalDunnett <- setRefClass( C_CLASS_NAME_TRIAL_DESIGN_CONDITIONAL_DUNNETT, contains = "TrialDesign", fields = list( informationAtInterim = "numeric", secondStageConditioning = "logical", sided = "integer" ), methods = list( initialize = function(...) { callSuper(...) notApplicableParameters <- c( "kMax", "stages", "informationRates", "userAlphaSpending", "criticalValues", "stageLevels", "alphaSpent", "bindingFutility", "tolerance" ) for (notApplicableParameter in notApplicableParameters) { .setParameterType(notApplicableParameter, C_PARAM_NOT_APPLICABLE) } .setParameterType("alpha", ifelse( identical(alpha, C_ALPHA_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) .setParameterType("informationAtInterim", ifelse( identical(informationAtInterim, 0.5), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) .setParameterType("secondStageConditioning", ifelse( identical(secondStageConditioning, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) kMax <<- 2L sided <<- 1L .initStages() }, show = function(showType = 1, digits = NA_integer_) { 'Method for automatically printing trial design objects' callSuper(showType = showType, digits = digits) } ) ) #' #' @title #' Get Design Conditional Dunnett Test #' #' @description #' Defines the design to perform an analysis with the conditional Dunnett test. #' #' @inheritParams param_alpha #' @param informationAtInterim The information to be expected at interim, default is \code{informationAtInterim = 0.5}. #' @param secondStageConditioning The way the second stage p-values are calculated within the closed system of hypotheses. #' If \code{secondStageConditioning = FALSE} is specified, the unconditional adjusted p-values are used, otherwise #' conditional adjusted p-values are calculated, default is \code{secondStageConditioning = TRUE} #' (for details, see Koenig et al., 2008). #' #' @details #' For performing the conditional Dunnett test the design must be defined through this function. #' You can define the information fraction and the way of how to compute the second stage #' p-values only in the design definition, and not in the analysis call.\cr #' See \code{\link{getClosedConditionalDunnettTestResults}} for an example and Koenig et al. (2008) and #' Wassmer & Brannath (2016), chapter 11 for details of the test procedure. #' #' @template return_object_trial_design #' @template how_to_get_help_for_generics #' #' @family design functions #' #' @export #' getDesignConditionalDunnett <- function(alpha = 0.025, # C_ALPHA_DEFAULT informationAtInterim = 0.5, secondStageConditioning = TRUE) { .assertIsValidAlpha(alpha) .assertIsNumericVector(informationAtInterim, "informationAtInterim") return(TrialDesignConditionalDunnett(alpha = alpha, informationAtInterim = informationAtInterim, secondStageConditioning = secondStageConditioning)) } #' #' @title #' Trial Design Plotting #' #' @description #' Plots a trial design. #' #' @details #' Generic function to plot a trial design. #' #' @param x The trial design, obtained from \cr #' \code{\link{getDesignGroupSequential}}, \cr #' \code{\link{getDesignInverseNormal}} or \cr #' \code{\link{getDesignFisher}}. #' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). #' @param main The main title. #' @param xlab The x-axis label. #' @param ylab The y-axis label. #' @inheritParams param_palette #' @inheritParams param_theta #' @inheritParams param_nMax #' @inheritParams param_plotPointsEnabled #' @inheritParams param_showSource #' @inheritParams param_plotSettings #' @inheritParams param_legendPosition #' @inheritParams param_grid #' @param type The plot type (default = \code{1}). The following plot types are available: #' \itemize{ #' \item \code{1}: creates a 'Boundaries' plot #' \item \code{3}: creates a 'Stage Levels' plot #' \item \code{4}: creates a 'Error Spending' plot #' \item \code{5}: creates a 'Power and Early Stopping' plot #' \item \code{6}: creates an 'Average Sample Size and Power / Early Stop' plot #' \item \code{7}: creates an 'Power' plot #' \item \code{8}: creates an 'Early Stopping' plot #' \item \code{9}: creates an 'Average Sample Size' plot #' \item \code{"all"}: creates all available plots and returns it as a grid plot or list #' } #' @inheritParams param_three_dots_plot #' #' @details #' Generic function to plot a trial design. #' #' Note that \code{\link[=param_nMax]{nMax}} is not an argument that it passed to \code{ggplot2}. #' Rather, the underlying calculations (e.g. power for different theta's or average sample size) are based #' on calls to function \code{\link{getPowerAndAverageSampleNumber}} which has argument \code{\link[=param_nMax]{nMax}}. #' I.e., \code{\link[=param_nMax]{nMax}} is not an argument to ggplot2 but to \code{\link{getPowerAndAverageSampleNumber}} #' which is called prior to plotting. #' #' @seealso \code{\link{plot.TrialDesignSet}} to compare different designs or design parameters visual. #' #' @template return_object_ggplot #' #' @examples #' \donttest{ #' design <- getDesignInverseNormal(kMax = 3, alpha = 0.025, #' typeOfDesign = "asKD", gammaA = 2, #' informationRates = c(0.2, 0.7, 1), #' typeBetaSpending = "bsOF") #' if (require(ggplot2)) { #' plot(design) # default: type = 1 #' } #' } #' #' @export #' plot.TrialDesign <- function(x, y, ..., main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", theta = seq(-1, 1, 0.01), nMax = NA_integer_, plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, grid = 1, plotSettings = NULL) { fCall = match.call(expand.dots = FALSE) designName <- deparse(fCall$x) .assertIsSingleInteger(grid, "grid", validateType = FALSE) typeNumbers <- .getPlotTypeNumber(type, x) if (is.null(plotSettings)) { plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) } p <- NULL plotList <- list() for (typeNumber in typeNumbers) { p <- .plotTrialDesign(x = x, y = y, main = main, xlab = xlab, ylab = ylab, type = typeNumber, palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), showSource = showSource, designName = designName, plotSettings = plotSettings, ...) .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) if (length(typeNumbers) > 1) { caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) plotList[[caption]] <- p } } if (length(typeNumbers) == 1) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(p)) } return(p) } if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(plotList)) } return(.createPlotResultObject(plotList, grid)) } .plotTrialDesign <- function(..., x, y, main, xlab, ylab, type, palette, theta, nMax, plotPointsEnabled, legendPosition, showSource, designName, plotSettings = NULL) { .assertGgplotIsInstalled() .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) if (any(.isTrialDesignFisher(x)) && !(type %in% c(1, 3, 4))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed for Fisher designs; must be 1, 3 or 4") } .warnInCaseOfUnknownArguments(functionName = "plot", ignore = c("xlim", "ylim", "companyAnnotationEnabled", "variedParameters"), ...) if ((type < 5 || type > 9) && !identical(theta, seq(-1, 1, 0.01))) { warning("'theta' (", .reconstructSequenceCommand(theta), ") will be ignored for plot type ", type, call. = FALSE) } if (!missing(y) && !is.null(y) && length(y) == 1 && inherits(y, "TrialDesign")) { args <- list(...) variedParameters <- args[["variedParameters"]] if (is.null(variedParameters)) { if (.isTrialDesignInverseNormalOrGroupSequential(x) && .isTrialDesignInverseNormalOrGroupSequential(y) && x$typeOfDesign != y$typeOfDesign) { variedParameters <- "typeOfDesign" } else { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'variedParameters' needs to be specified, e.g., variedParameters = \"typeOfDesign\"") } } designSet <- getDesignSet(designs = c(x, y), variedParameters = variedParameters) } else { designSet <- TrialDesignSet(design = x, singleDesign = TRUE) if (!is.null(plotSettings)) { designSet$.plotSettings <- plotSettings } } .plotTrialDesignSet(x = designSet, y = y, main = main, xlab = xlab, ylab = ylab, type = type, palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, showSource = showSource, designSetName = designName, ...) } #' #' @name TrialDesign_as.data.frame #' #' @title #' Coerce TrialDesign to a Data Frame #' #' @description #' Returns the \code{TrialDesign} as data frame. #' #' @param x A \code{\link{TrialDesign}} object. #' @inheritParams param_niceColumnNamesEnabled #' @inheritParams param_includeAllParameters #' @inheritParams param_three_dots #' #' @details #' Each element of the \code{\link{TrialDesign}} is converted to a column in the data frame. #' #' @template return_dataframe #' #' @examples #' as.data.frame(getDesignGroupSequential()) #' #' @export #' #' @keywords internal #' as.data.frame.TrialDesign <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { .assertIsTrialDesign(x) if (includeAllParameters) { parameterNames <- NULL } else { parameterNames <- x$.getParametersToShow() } return(x$.getAsDataFrame(parameterNames = parameterNames, niceColumnNamesEnabled = niceColumnNamesEnabled, includeAllParameters = includeAllParameters, tableColumnNames = .getTableColumnNames(design = x))) } rpact/R/class_design_set.R0000644000175000017500000007655314145656364015410 0ustar nileshnilesh## | ## | *Trial design set classes* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include f_core_plot.R NULL #' @title #' Get Design Set #' #' @description #' Creates a trial design set object and returns it. #' #' @param ... \code{designs} or \code{design} and one or more design parameters, e.g., \code{deltaWT = c(0.1, 0.3, 0.4)}. #' \itemize{ #' \item \code{design} The master design (optional, you need to specify an #' additional parameter that shall be varied). #' \item \code{designs} The designs to compare (optional, you need to specify the variable \code{variedParameters}). #' } #' #' @details #' Specify a master design and one or more design parameters or a list of designs. #' #' @return Returns a \code{\link{TrialDesignSet}} object. #' The following generics (R generic functions) are available for this result object: #' \itemize{ #' \item \code{\link[=names.TrialDesignSet]{names}} to obtain the field names, #' \item \code{\link[=length.TrialDesignSet]{length}} to obtain the number of design, #' \item \code{\link[=print.FieldSet]{print}} to print the object, #' \item \code{\link[=summary.TrialDesignSet]{summary}} to display a summary of the object, #' \item \code{\link[=plot.TrialDesignSet]{plot}} to plot the object, #' \item \code{\link[=as.data.frame.TrialDesignSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, #' \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. #' } #' @template how_to_get_help_for_generics #' #' @examples #' # Example 1 #' design <- getDesignGroupSequential(alpha = 0.05, kMax = 6, #' sided = 2, typeOfDesign = "WT", deltaWT = 0.1) #' designSet <- getDesignSet() #' designSet$add(design = design, deltaWT = c(0.3, 0.4)) #' \donttest{ #' if (require(ggplot2)) plot(designSet, type = 1) #' } #' #' # Example 2 (shorter script) #' design <- getDesignGroupSequential(alpha = 0.05, kMax = 6, #' sided = 2, typeOfDesign = "WT", deltaWT = 0.1) #' designSet <- getDesignSet(design = design, deltaWT = c(0.3, 0.4)) #' \donttest{ #' if (require(ggplot2)) plot(designSet, type = 1) #' } #' #' # Example 3 (use of designs instead of design) #' d1 <- getDesignGroupSequential(alpha = 0.05, kMax = 2, #' sided = 1, beta = 0.2, typeOfDesign = "asHSD", #' gammaA = 0.5, typeBetaSpending = "bsHSD", gammaB = 0.5) #' d2 <- getDesignGroupSequential(alpha = 0.05, kMax = 4, #' sided = 1, beta = 0.2, typeOfDesign = "asP", #' typeBetaSpending = "bsP") #' designSet <- getDesignSet (designs = c(d1, d2), #' variedParameters = c("typeOfDesign", "kMax")) #' \donttest{ #' if (require(ggplot2)) plot(designSet, type = 8, nMax = 20) #' } #' #' @export #' getDesignSet <- function(...) { return(TrialDesignSet(...)) } #' #' @name Trial_Design_Set_summary #' #' @title #' Trial Design Set Summary #' #' @description #' Displays a summary of \code{\link{ParameterSet}} object. #' #' @param object A \code{\link{ParameterSet}} object. #' @inheritParams param_digits #' @inheritParams param_three_dots #' #' @details #' Summarizes the trial designs. #' #' @template details_summary #' #' @template return_object_summary #' @template how_to_get_help_for_generics #' #' @export #' #' @keywords internal #' summary.TrialDesignSet <- function(object, ..., type = 1, digits = NA_integer_) { .warnInCaseOfUnknownArguments(functionName = "summary.TrialDesignSet", ...) .assertIsTrialDesignSet(object) if (object$isEmpty()) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot create summary because the design set is empty") } summaries <- list() for (design in object$designs) { s <- .createSummary(design, digits = digits) summaries <- c(summaries, s) } return(summaries) } #' #' @name TrialDesignSet #' #' @title #' Class for trial design sets. #' #' @description #' \code{TrialDesignSet} is a class for creating a collection of different trial designs. #' #' @field designs The designs (optional). #' @field design The master design (optional). #' #' @details #' This object cannot be created directly; better use \code{\link{getDesignSet}} #' with suitable arguments to create a set of designs. #' #' @seealso \code{\link{getDesignSet}} #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include f_core_plot.R #' #' @keywords internal #' #' @importFrom methods new #' TrialDesignSet <- setRefClass("TrialDesignSet", contains = "FieldSet", fields = list( .plotSettings = "PlotSettings", designs = "list", variedParameters = "character" ), methods = list( # # @param ... 'designs' OR 'design' and one or more design parameters, e.g., deltaWT = c(0.1, 0.3, 0.4) # initialize = function(...) { .plotSettings <<- PlotSettings() designs <<- list() variedParameters <<- character(0) if (length(list(...)) > 0) { add(...) } if (length(designs) > 0) { masterDesign <- designs[[1]] if (inherits(masterDesign, "ParameterSet")) { .self$.plotSettings <<- masterDesign$.plotSettings } } }, getPlotSettings = function() { return(.plotSettings) }, show = function(showType = 1, digits = NA_integer_) { .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { 'Method for automatically printing trial design sets' .resetCat() .cat("Trial design set with ", length(designs), " designs\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled) for (design in designs) { design$.show(showType = showType, consoleOutputEnabled = consoleOutputEnabled) } }, isEmpty = function() { return(length(designs) == 0) }, getSize = function() { return(length(designs)) }, getDesignMaster = function() { if (length(designs) == 0) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "no design master defined") } return(designs[[1]]) }, .validateDesignsArgument = function(designsToAdd, args) { if (!is.list(designsToAdd)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'designsToAdd' must be a list") } if (length(designsToAdd) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'designsToAdd' must be not empty") } designsToAddValidated <- list() for (d in designsToAdd) { if (.isTrialDesign(d)) { designsToAddValidated <- c(designsToAddValidated, d) } else { parentDesign <- d[[".design"]] if (is.null(parentDesign)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'designsToAdd' must be a list of trial designs (found '", class(d), "')") } warning("Only the parent design of ", class(d), " was added to trial design set", call. = FALSE) designsToAddValidated <- c(designsToAddValidated, parentDesign) } } varPar <- args[["variedParameters"]] if (!is.null(varPar) && length(varPar) > 0) { variedParameters <<- c(variedParameters, varPar) } args <- args[!(names(args) %in% c("designs", "variedParameters"))] if (length(args) > 0) { warning("Argument", ifelse(length(args) > 1, "s", ""), " ", .arrayToString(args, encapsulate = TRUE), " will be ignored ", "because for 'designs' only argument 'variedParameters' will be respected", call. = FALSE) } designs <<- c(designs, designsToAddValidated) }, addVariedParameters = function(varPar) { if (is.null(varPar) || !is.character(varPar)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'varPar' must be a valid character vector") } variedParameters <<- c(variedParameters, varPar) }, .validateOptionalArguments = function(...) { args <- list(...) designsToAdd <- .getOptionalArgument(optionalArgumentName = "designs", ...) if (!is.null(designsToAdd)) { .validateDesignsArgument(designsToAdd = designsToAdd, args = args) return(NULL) } design <- .getOptionalArgument(optionalArgumentName = "design", ...) optionalArgumentsDefined = (length(args) > 0) if (is.null(design) && !optionalArgumentsDefined) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "please specify a 'design' to add and/or a design parameter, ", "e.g., deltaWT = c(0.1, 0.3, 0.4)") } if (is.null(design) && optionalArgumentsDefined && length(designs) == 0) { stop(C_EXCEPTION_TYPE_INCOMPLETE_ARGUMENTS, "at least one design (master) must be defined in this ", "design set to respect any design parameters") } if (!is.null(design)) { designs <<- c(designs, design) } else if (length(designs) > 0) { design <- designs[[1]] # use design master } if (!.isTrialDesign(design)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' (", class(design), ") must be an instance of class 'TrialDesign'") } .getArgumentNames(validatedDesign = design, ...) invisible(design) }, .getArgumentNames = function(validatedDesign, ...) { args <- list(...) if (length(args) == 0) { return(character(0)) } argumentNames <- names(args) if (length(argumentNames) == 0) { warning("No argument names available for ", paste(args, collapse = ", "), call. = FALSE) return(character(0)) } argumentNames <- argumentNames[nchar(argumentNames) != 0] argumentNames <- argumentNames[!(argumentNames %in% c("design", "designs", "singleDesign"))] visibleFieldNames <- validatedDesign$.getVisibleFieldNames() for (arg in argumentNames) { if (!(arg %in% visibleFieldNames)) { stop(sprintf(paste0(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'%s' does not contain a field with name '%s'"), class(validatedDesign), arg)) } } invisible(argumentNames) }, add = function(...) { "Adds 'designs' OR a 'design' and/or a design parameter, e.g., deltaWT = c(0.1, 0.3, 0.4)" design <- .validateOptionalArguments(...) args <- list(...) singleDesign <- args[["singleDesign"]] if (!is.null(singleDesign) && is.logical(singleDesign) && singleDesign) { return(invisible()) } if (!is.null(design)) { d <- .createDesignVariants(validatedDesign = design, ...) designs <<- c(designs, d) } }, assertHaveEqualSidedValues = function() { if (length(designs) == 0) { return(invisible()) } sided = getDesignMaster()$sided for (design in designs) { if (sided != design$sided) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "designs have different directions of alternative (design master is ", ifelse(sided == 1, "one", "two"), " sided)") } } }, .createDesignVariants = function(validatedDesign, ...) { .assertIsTrialDesign(validatedDesign) argumentNames <- .getArgumentNames(validatedDesign = validatedDesign, ...) if (length(argumentNames) == 0) { warning("Creation of design variants stopped: no valid design parameters found", call. = FALSE) return(list()) } if (length(argumentNames) > 2) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "too many arguments (", .arrayToString(argumentNames, encapsulate = TRUE), "): up to 2 design parameters are allowed") } designVariants <- .createDesignVariantsRecursive(designMaster = validatedDesign, args = list(...), argumentIndex = 1, argumentNames = argumentNames) return(designVariants) }, .designSettingExists = function(parameterName, parameterValue, numberOfArguments = 1, parameterNameBefore = NULL, parameterValueBefore = NULL) { if (length(designs) == 0) { return(FALSE) } for (design in designs) { if (!is.null(parameterNameBefore) && !is.null(parameterValueBefore)) { if (design[[parameterNameBefore]] == parameterValueBefore && design[[parameterName]] == parameterValue) { return(TRUE) } } else if (numberOfArguments == 1) { if (design[[parameterName]] == parameterValue) { return(TRUE) } } } return(FALSE) }, .createDesignVariantsRecursive = function(designMaster, args, argumentIndex, argumentNames, parameterNameBefore = NULL, parameterValueBefore = NULL) { if (argumentIndex > length(argumentNames)) { return(list()) } designVariants <- list() argumentName <- argumentNames[argumentIndex] variedParameters <<- unique(c(variedParameters, argumentName)) argumentValues <- args[[argumentName]] for (argumentValue in argumentValues) { if (.designSettingExists(argumentName, argumentValue, numberOfArguments = length(argumentNames), parameterNameBefore, parameterValueBefore)) { if (!is.null(parameterNameBefore) && !is.null(parameterValueBefore)) { warning(sprintf("Argument ignored: there exists already a design with %s = %s (%s = %s)", argumentName, argumentValue, parameterNameBefore, parameterValueBefore), call. = FALSE) } else { warning(sprintf("Argument ignored: there exists already a design with %s = %s", argumentName, argumentValue), call. = FALSE) } } else { designMaster2 <- .createDesignVariant(designMaster = designMaster, argumentName = argumentName, argumentValue = argumentValue) if (argumentIndex == length(argumentNames)) { if (is.null(parameterNameBefore) || is.null(parameterValueBefore)) { .logDebug("Create design variant %s = %s", argumentName, argumentValue) } else { .logDebug("Create design variant %s = %s (%s = %s)", argumentName, argumentValue, parameterNameBefore, parameterValueBefore) } designVariants <- c(designVariants, designMaster2) } designCopies2 <- .createDesignVariantsRecursive(designMaster = designMaster2, args = args, argumentIndex = argumentIndex + 1, argumentNames = argumentNames, parameterNameBefore = argumentName, parameterValueBefore = argumentValue) if (length(designCopies2) > 0) { designVariants <- c(designVariants, designCopies2) } } } return(designVariants) }, .createDesignVariant = function(designMaster, argumentName, argumentValue) { if (.isTrialDesignGroupSequential(designMaster)) { defaultValues <- .getDesignGroupSequentialDefaultValues() } else if (.isTrialDesignInverseNormal(designMaster)) { defaultValues <- .getDesignInverseNormalDefaultValues() } else if (.isTrialDesignFisher(designMaster)) { defaultValues <- .getDesignFisherDefaultValues() } for (userDefinedParamName in designMaster$.getUserDefinedParameters()) { defaultValues[[userDefinedParamName]] <- designMaster[[userDefinedParamName]] } defaultValues[[argumentName]] <- argumentValue if (.isTrialDesignGroupSequential(designMaster)) { result <- getDesignGroupSequential( kMax = defaultValues$kMax, alpha = defaultValues$alpha, beta = defaultValues$beta, sided = defaultValues$sided, informationRates = defaultValues$informationRates, futilityBounds = defaultValues$futilityBounds, typeOfDesign = defaultValues$typeOfDesign, deltaWT = defaultValues$deltaWT, optimizationCriterion = defaultValues$optimizationCriterion, gammaA = defaultValues$gammaA, typeBetaSpending = defaultValues$typeBetaSpending, userAlphaSpending = defaultValues$userAlphaSpending, userBetaSpending = defaultValues$userBetaSpending, gammaB = defaultValues$gammaB, tolerance = defaultValues$tolerance) } else if (.isTrialDesignInverseNormal(designMaster)) { result <- getDesignInverseNormal( kMax = defaultValues$kMax, alpha = defaultValues$alpha, beta = defaultValues$beta, sided = defaultValues$sided, informationRates = defaultValues$informationRates, futilityBounds = defaultValues$futilityBounds, typeOfDesign = defaultValues$typeOfDesign, deltaWT = defaultValues$deltaWT, optimizationCriterion = defaultValues$optimizationCriterion, gammaA = defaultValues$gammaA, typeBetaSpending = defaultValues$typeBetaSpending, userAlphaSpending = defaultValues$userAlphaSpending, userBetaSpending = defaultValues$userBetaSpending, gammaB = defaultValues$gammaB, tolerance = defaultValues$tolerance) } else if (.isTrialDesignFisher(designMaster)) { result <- getDesignFisher( kMax = defaultValues$kMax, alpha = defaultValues$alpha, method = defaultValues$method, userAlphaSpending = defaultValues$userAlphaSpending, informationRates = defaultValues$informationRates, alpha0Vec = defaultValues$alpha0Vec, sided = defaultValues$sided, tolerance = defaultValues$tolerance, iterations = defaultValues$iterations, seed = defaultValues$seed) } result$.plotSettings <- designMaster$.plotSettings return(result) } ) ) #' #' @title #' Access Trial Design by Index #' #' @description #' Function to the \code{TrialDesign} at position \code{i} in a \code{TrialDesignSet} object. #' #' @details #' Can be used to iterate with "[index]"-syntax over all designs in a design set. #' #' @examples #' designSet <- getDesignSet(design = getDesignFisher(), alpha = c(0.01, 0.05)) #' for (i in 1:length(designSet)) { #' print(designSet[i]$alpha) #' } #' #' @export #' #' @keywords internal #' setMethod("[", "TrialDesignSet", function(x, i, j = NA_character_, ...) { if (length(x$designs) == 0) { return(NULL) } design <- x$designs[[i]] if (!missing(j) && !is.na(j) && is.character(j)) { return(design[[j]]) } return(design) } ) #' #' @name TrialDesignSet_names #' #' @title #' Names of a Trial Design Set Object #' #' @description #' Function to get the names of a \code{\link{TrialDesignSet}} object. #' #' @param x A \code{\link{TrialDesignSet}} object. #' #' @details #' Returns the names of a design set that can be accessed by the user. #' #' @template return_names #' #' @examples #' designSet <- getDesignSet(design = getDesignGroupSequential(), alpha = c(0.01, 0.05)) #' names(designSet) #' #' @export #' #' @keywords internal #' names.TrialDesignSet <- function(x) { return(x$.getVisibleFieldNames()) } #' #' @name TrialDesignSet_length #' #' @title #' Length of Trial Design Set #' #' @description #' Returns the number of designs in a \code{TrialDesignSet}. #' #' @param x A \code{\link{TrialDesignSet}} object. #' #' @details #' Is helpful for iteration over all designs in a design set with "[index]"-syntax. #' #' @return Returns a non-negative \code{\link[base]{integer}} of length 1 #' representing the number of design in the \code{TrialDesignSet}. #' #' @examples #' designSet <- getDesignSet(design = getDesignGroupSequential(), alpha = c(0.01, 0.05)) #' length(designSet) #' #' @export #' #' @keywords internal #' length.TrialDesignSet <- function(x) { return(length(x$designs)) } #' #' @name TrialDesignSet_as.data.frame #' #' @title #' Coerce Trial Design Set to a Data Frame #' #' @description #' Returns the \code{TrialDesignSet} as data frame. #' #' @param x A \code{\link{TrialDesignSet}} object. #' @inheritParams param_niceColumnNamesEnabled #' @inheritParams param_includeAllParameters #' @param addPowerAndAverageSampleNumber If \code{TRUE}, power and average sample size will #' be added to data frame, default is \code{FALSE}. #' @inheritParams param_theta #' @inheritParams param_nMax #' @inheritParams param_three_dots #' #' @details #' Coerces the design set to a data frame. #' #' @template return_dataframe #' #' @examples #' designSet <- getDesignSet(design = getDesignGroupSequential(), alpha = c(0.01, 0.05)) #' as.data.frame(designSet) #' #' @export #' #' @keywords internal #' as.data.frame.TrialDesignSet <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, addPowerAndAverageSampleNumber = FALSE, theta = seq(-1, 1, 0.02), nMax = NA_integer_, ...) { .assertIsTrialDesignSet(x) if (x$isEmpty()) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot create data.frame because the design set is empty") } fCall = match.call(expand.dots = FALSE) theta <- .assertIsValidThetaRange(thetaRange = theta, thetaAutoSeqEnabled = (as.character(fCall$theta)[1] != "seq")) if (addPowerAndAverageSampleNumber) { .assertAssociatedArgumentsAreDefined( addPowerAndAverageSampleNumber = addPowerAndAverageSampleNumber, theta = theta, nMax = nMax) } fisherDesignEnabled <- .isTrialDesignFisher(x$getDesignMaster()) dataFrame <- NULL for (design in x$designs) { if (fisherDesignEnabled != .isTrialDesignFisher(design)) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "all trial designs must be from the same type ", "('", class(x$designs[[1]]), "' != '", class(design), ")'") } df <- as.data.frame(design, niceColumnNamesEnabled = niceColumnNamesEnabled, includeAllParameters = includeAllParameters) if (.isTrialDesignWithValidFutilityBounds(design)) { futilityBoundsName <- "futilityBounds" if (niceColumnNamesEnabled) { futilityBoundsName <- .getTableColumnNames(design = design)[["futilityBounds"]] } kMax <- design$kMax df[[futilityBoundsName]][kMax] <- design$criticalValues[kMax] } if (.isTrialDesignWithValidAlpha0Vec(design)) { alpha0VecName <- "alpha0Vec" if (niceColumnNamesEnabled) { alpha0VecName <- .getTableColumnNames(design = design)[["alpha0Vec"]] } kMax <- design$kMax df[[alpha0VecName]][kMax] <- design$criticalValues[kMax] } if (addPowerAndAverageSampleNumber) { results <- PowerAndAverageSampleNumberResult(design, theta = theta, nMax = nMax) df2 <- as.data.frame(results, niceColumnNamesEnabled = niceColumnNamesEnabled, includeAllParameters = includeAllParameters) df <- merge(df, df2, all.y = TRUE) } if (is.null(dataFrame)) { if (niceColumnNamesEnabled) { dataFrame <- cbind("Design number" = rep(1, nrow(df)), df) } else { dataFrame <- cbind(designNumber = rep(1, nrow(df)), df) } } else { if (niceColumnNamesEnabled) { df <- cbind("Design number" = rep(max(dataFrame$"Design number") + 1, nrow(df)), df) } else { df <- cbind(designNumber = rep(max(dataFrame$designNumber) + 1, nrow(df)), df) } dataFrame <- rbind(dataFrame, df) } } return(dataFrame) } #' #' @title #' Trial Design Set Plotting #' #' @description #' Plots a trial design set. #' #' @param x The trial design set, obtained from \code{\link{getDesignSet}}. #' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). #' @param main The main title. #' @param xlab The x-axis label. #' @param ylab The y-axis label. #' @inheritParams param_palette #' @inheritParams param_theta #' @inheritParams param_nMax #' @inheritParams param_plotPointsEnabled #' @inheritParams param_showSource #' @inheritParams param_plotSettings #' @inheritParams param_legendPosition #' @inheritParams param_grid #' @param type The plot type (default = \code{1}). The following plot types are available: #' \itemize{ #' \item \code{1}: creates a 'Boundaries' plot #' \item \code{3}: creates a 'Stage Levels' plot #' \item \code{4}: creates a 'Error Spending' plot #' \item \code{5}: creates a 'Power and Early Stopping' plot #' \item \code{6}: creates an 'Average Sample Size and Power / Early Stop' plot #' \item \code{7}: creates an 'Power' plot #' \item \code{8}: creates an 'Early Stopping' plot #' \item \code{9}: creates an 'Average Sample Size' plot #' \item \code{"all"}: creates all available plots and returns it as a grid plot or list #' } #' @inheritParams param_three_dots_plot #' #' @details #' Generic function to plot a trial design set. #' Is, e.g., useful to compare different designs or design parameters visual. #' #' @template return_object_ggplot #' #' @examples #' design <- getDesignInverseNormal(kMax = 3, alpha = 0.025, #' typeOfDesign = "asKD", gammaA = 2, #' informationRates = c(0.2, 0.7, 1), typeBetaSpending = "bsOF") #' #' # Create a set of designs based on the master design defined above #' # and varied parameter 'gammaA' #' designSet <- getDesignSet(design = design, gammaA = 4) #' #' if (require(ggplot2)) plot(designSet, type = 1, legendPosition = 6) #' #' @export #' plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, xlab = NA_character_, ylab = NA_character_, palette = "Set1", theta = seq(-1, 1, 0.02), nMax = NA_integer_, plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, grid = 1, plotSettings = NULL) { fCall = match.call(expand.dots = FALSE) designSetName <- deparse(fCall$x) .assertIsSingleInteger(grid, "grid", validateType = FALSE) typeNumbers <- .getPlotTypeNumber(type, x) if (is.null(plotSettings)) { plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) } p <- NULL plotList <- list() for (typeNumber in typeNumbers) { p <- .plotTrialDesignSet(x = x, y = y, type = typeNumber, main = main, xlab = xlab, ylab = ylab, palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), showSource = showSource, designSetName = designSetName, plotSettings = plotSettings, ...) .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) if (length(typeNumbers) > 1) { caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) plotList[[caption]] <- p } } if (length(typeNumbers) == 1) { return(p) } return(.createPlotResultObject(plotList, grid)) } .plotTrialDesignSet <- function(..., x, y, type = 1L, main = NA_character_, xlab = NA_character_, ylab = NA_character_, palette = "Set1", theta = seq(-1, 1, 0.02), nMax = NA_integer_, plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, designSetName = NA_character_, plotSettings = NULL) { .assertGgplotIsInstalled() if (!is.call(main) && !isS4(main)) { .assertIsSingleCharacter(main, "main", naAllowed = TRUE) } .assertIsSingleCharacter(xlab, "xlab", naAllowed = TRUE) .assertIsSingleCharacter(ylab, "ylab", naAllowed = TRUE) .assertIsSingleCharacter(palette, "palette", naAllowed = TRUE) theta <- .assertIsValidThetaRange(thetaRange = theta) .assertIsSingleNumber(nMax, "nMax", naAllowed = TRUE) .assertIsSingleLogical(plotPointsEnabled, "plotPointsEnabled", naAllowed = TRUE) .assertIsValidLegendPosition(legendPosition) .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) parameterSet <- x designMaster <- parameterSet$getDesignMaster() .assertIsTrialDesign(designMaster) if (type == 1) { main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Boundaries" else main xParameterName <- "informationRates" yParameterNames <- c("criticalValues") if (designMaster$sided == 1 || (.isTrialDesignInverseNormalOrGroupSequential(designMaster) && designMaster$typeOfDesign == C_TYPE_OF_DESIGN_PT)) { if (.isTrialDesignWithValidFutilityBounds(designMaster)) { yParameterNames <- c("futilityBounds", "criticalValues") } if (.isTrialDesignWithValidAlpha0Vec(designMaster)) { yParameterNames <- c("alpha0Vec", "criticalValues") } } } else if (type == 2) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "designs with undefined endpoint do not support plot type 2") } else if (type == 3) { main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Stage Levels" else main xParameterName <- "informationRates" yParameterNames <- "stageLevels" } else if (type == 4) { main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Error Spending" else main xParameterName <- "informationRates" yParameterNames <- c("alphaSpent") if (!.isTrialDesignFisher(designMaster) && designMaster$typeBetaSpending != C_TYPE_OF_DESIGN_BS_NONE) { yParameterNames <- c(yParameterNames, "betaSpent") palette <- "Paired" } plotPointsEnabled <- ifelse(is.na(plotPointsEnabled), FALSE, plotPointsEnabled) } else if (type == 5) { if (!is.call(main) && !isS4(main) && is.na(main)) { main <- PlotSubTitleItems(title = "Power and Early Stopping") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- c("overallEarlyStop", "calculatedPower") } else if (type == 6) { if (!is.call(main) && !isS4(main) && is.na(main)) { main <- PlotSubTitleItems(title = "Average Sample Size and Power / Early Stop") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- c("averageSampleNumber", "overallEarlyStop", "calculatedPower") } else if (type == 7) { if (!is.call(main) && !isS4(main) && is.na(main)) { main <- PlotSubTitleItems(title = "Power") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- "calculatedPower" } else if (type == 8) { if (!is.call(main) && !isS4(main) && is.na(main)) { main <- PlotSubTitleItems(title = "Early Stopping") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- "overallEarlyStop" } else if (type == 9) { if (!is.call(main) && !isS4(main) && is.na(main)) { main <- PlotSubTitleItems(title = "Average Sample Size") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- "averageSampleNumber" } else { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, ..., 9") } if (type >= 5 && type <= 9) { designSetName <- paste0("getPowerAndAverageSampleNumber(", designSetName, ", theta = ", .reconstructSequenceCommand(theta), ", nMax = ", nMax, ")") } xValues <- NA_real_ if (xParameterName == "theta") { xValues <- theta } srcCmd <- .showPlotSourceInformation(objectName = designSetName, xParameterName = xParameterName, yParameterNames = yParameterNames, nMax = nMax, type = type, showSource = showSource, xValues = xValues) if (!is.null(srcCmd)) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(srcCmd)) } return(srcCmd) } return(.plotParameterSet(parameterSet = parameterSet, designMaster = designMaster, xParameterName = xParameterName, yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, plotSettings = plotSettings, ...)) } rpact/R/parameter_descriptions.R0000644000175000017500000011030314153335003016602 0ustar nileshnilesh## | ## | *Parameters* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5612 $ ## | Last changed: $Date: 2021-12-02 17:34:44 +0100 (Do, 02 Dez 2021) $ ## | Last changed by: $Author: wassmer $ ## | #' Parameter Description: "..." #' @param ... Ensures that all arguments (starting from the "...") are to be named and #' that a warning will be displayed if unknown arguments are passed. #' @name param_three_dots #' @keywords internal NULL #' Parameter Description: "..." (optional plot arguments) #' @param ... Optional plot arguments. At the moment \code{xlim} and \code{ylim} are implemented #' for changing x or y axis limits without dropping data observations. #' @name param_three_dots_plot #' @keywords internal NULL #' Parameter Description: Maximum Number of Stages #' @param kMax The maximum number of stages \code{K}. #' \code{K = 1, 2, 3, ...} (default is \code{3}). #' The maximum selectable \code{kMax} is \code{20} for group sequential or inverse normal and #' \code{6} for Fisher combination test designs. #' @name param_kMax #' @keywords internal NULL #' Parameter Description: Alpha #' @param alpha The significance level alpha, default is \code{0.025}. #' @name param_alpha #' @keywords internal NULL #' Parameter Description: Beta #' @param beta Type II error rate, necessary for providing sample size calculations \cr #' (e.g., \code{\link{getSampleSizeMeans}}), beta spending function designs, #' or optimum designs, default is \code{0.20}. #' @name param_beta #' @keywords internal NULL #' Parameter Description: Sided #' @param sided Is the alternative one-sided (\code{1}) or two-sided (\code{2}), default is \code{1}. #' @name param_sided #' @keywords internal NULL #' Parameter Description: Information Rates #' @param informationRates The information rates (that must be fixed prior to the trial), #' default is \code{(1:kMax) / kMax}. #' @name param_informationRates #' @keywords internal NULL #' Parameter Description: Binding Futility #' @param bindingFutility If \code{bindingFutility = TRUE} is specified the calculation of #' the critical values is affected by the futility bounds and the futility threshold is binding in the #' sense that the study must be stopped if the futility condition was reached (default is \code{FALSE}). #' @name param_bindingFutility #' @keywords internal NULL #' Parameter Description: Type of Design #' @param typeOfDesign The type of design. Type of design is one of the following: #' O'Brien & Fleming (\code{"OF"}), Pocock (\code{"P"}), Wang & Tsiatis Delta class (\code{"WT"}), #' Pampallona & Tsiatis (\code{"PT"}), Haybittle & Peto ("HP"), #' Optimum design within Wang & Tsiatis class (\code{"WToptimum"}), #' O'Brien & Fleming type alpha spending (\code{"asOF"}), Pocock type alpha spending (\code{"asP"}), #' Kim & DeMets alpha spending (\code{"asKD"}), Hwang, Shi & DeCani alpha spending (\code{"asHSD"}), #' user defined alpha spending (\code{"asUser"}), no early efficacy stop (\code{"noEarlyEfficacy"}), #' default is \code{"OF"}. #' @name param_typeOfDesign #' @keywords internal NULL #' Parameter Description: Design #' @param design The trial design. #' @name param_design #' @keywords internal NULL #' Parameter Description: Design with Default #' @param design The trial design. If no trial design is specified, a fixed sample size design is used. #' In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, #' and \code{sided} can be directly entered as argument where necessary. #' @name param_design_with_default #' @keywords internal NULL #' Parameter Description: N_max #' @param nMax The maximum sample size. #' @name param_nMax #' @keywords internal NULL #' Parameter Description: Theta #' @param theta A vector of standardized effect sizes (theta values), default is a sequence from -1 to 1. #' @name param_theta #' @keywords internal NULL #' Parameter Description: User Alpha Spending #' @param userAlphaSpending The user defined alpha spending. #' Numeric vector of length \code{kMax} containing the cumulative #' alpha-spending (Type I error rate) up to each interim stage: \code{0 <= alpha_1 <= ... <= alpha_K <= alpha}. #' @name param_userAlphaSpending #' @keywords internal NULL ## ## Sample Size and Power ## #' Parameter Description: Effect Under Alternative #' @param thetaH1 If specified, the value of the alternative under which #' the conditional power or sample size recalculation calculation is performed. #' @name param_thetaH1 #' @keywords internal NULL #' Parameter Description: Standard Deviation #' @param stDev The standard deviation under which the sample size or power #' calculation is performed, default is \code{1}. #' If \code{meanRatio = TRUE} is specified, \code{stDev} defines #' the coefficient of variation \code{sigma / mu2}. #' @name param_stDev #' @keywords internal NULL #' Parameter Description: Lambda (1) #' @param lambda1 The assumed hazard rate in the treatment group, there is no default. #' \code{lambda1} can also be used to define piecewise exponentially distributed survival times (see details). #' @name param_lambda1 #' @keywords internal NULL #' Parameter Description: Lambda (2) #' @param lambda2 The assumed hazard rate in the reference group, there is no default. #' \code{lambda2} can also be used to define piecewise exponentially distributed survival times (see details). #' @name param_lambda2 #' @keywords internal NULL #' Parameter Description: Pi (1) for Rates #' @param pi1 A numeric value or vector that represents the assumed probability in #' the active treatment group if two treatment groups #' are considered, or the alternative probability for a one treatment group design, #' default is \code{seq(0.2, 0.5, 0.1)} (power calculations and simulations) or #' \code{seq(0.4, 0.6, 0.1)} (sample size calculations). #' @name param_pi1_rates #' @keywords internal NULL #' Parameter Description: Pi (1) for Survival Data #' @param pi1 A numeric value or vector that represents the assumed event rate in the treatment group, #' default is \code{seq(0.2, 0.5, 0.1)} (power calculations and simulations) or #' \code{seq(0.4, 0.6, 0.1)} (sample size calculations). #' @name param_pi1_survival #' @keywords internal NULL #' Parameter Description: Pi (2) for Rates #' @param pi2 A numeric value that represents the assumed probability in the reference group if two treatment #' groups are considered, default is \code{0.2}. #' @name param_pi2_rates #' @keywords internal NULL #' Parameter Description: Pi (2) for Survival Data #' @param pi2 A numeric value that represents the assumed event rate in the control group, default is \code{0.2}. #' @name param_pi2_survival #' @keywords internal NULL #' Parameter Description: Median (1) #' @param median1 The assumed median survival time in the treatment group, there is no default. #' @name param_median1 #' @keywords internal NULL #' Parameter Description: Median (2) #' @param median2 The assumed median survival time in the reference group, there is no default. #' @name param_median2 #' @keywords internal NULL #' Parameter Description: Hazard Ratio #' @param hazardRatio The vector of hazard ratios under consideration. #' If the event or hazard rates in both treatment groups are defined, the hazard ratio needs #' not to be specified as it is calculated, there is no default. #' @name param_hazardRatio #' @keywords internal NULL #' Parameter Description: Event Time #' @param eventTime The assumed time under which the event rates are calculated, default is \code{12}. #' @name param_eventTime #' @keywords internal NULL #' Parameter Description: Piecewise Survival Time #' @param piecewiseSurvivalTime A vector that specifies the time intervals for the piecewise #' definition of the exponential survival time cumulative distribution function \cr #' (for details see \code{\link{getPiecewiseSurvivalTime}}). #' @name param_piecewiseSurvivalTime #' @keywords internal NULL #' Parameter Description: Kappa #' @param kappa A numeric value > 0. A \code{kappa != 1} will be used for the specification #' of the shape of the Weibull distribution. #' Default is \code{1}, i.e., the exponential survival distribution is used instead of the Weibull distribution. #' Note that the Weibull distribution cannot be used for the piecewise definition of #' the survival time distribution, i.e., only \code{piecewiselambda} (as a single value) and \code{kappa} #' can be specified. #' This function is equivalent to \code{pweibull(t, shape = kappa, scale = 1 / lambda)} #' of the \code{stats} package, i.e., the scale parameter is \code{1 / 'hazard rate'}.\cr #' For example, #' \code{getPiecewiseExponentialDistribution(time = 130, piecewiseLambda = 0.01, kappa = 4.2)} #' and \code{pweibull(q = 130, shape = 4.2, scale = 1 / 0.01)} provide the sample result. #' @name param_kappa #' @keywords internal NULL #' Parameter Description: Type Of Computation #' @param typeOfComputation Three options are available: \code{"Schoenfeld"}, \code{"Freedman"}, \code{"HsiehFreedman"}, #' the default is \code{"Schoenfeld"}. For details, see Hsieh (Statistics in Medicine, 1992). #' For non-inferiority testing (i.e., \code{thetaH0 != 1}), only Schoenfeld's formula can be used. #' @name param_typeOfComputation #' @keywords internal NULL #' Parameter Description: Dropout Rate (1) #' @param dropoutRate1 The assumed drop-out rate in the treatment group, default is \code{0}. #' @name param_dropoutRate1 #' @keywords internal NULL #' Parameter Description: Dropout Rate (2) #' @param dropoutRate2 The assumed drop-out rate in the control group, default is \code{0}. #' @name param_dropoutRate2 #' @keywords internal NULL #' Parameter Description: Dropout Time #' @param dropoutTime The assumed time for drop-out rates in the control and the #' treatment group, default is \code{12}. #' @name param_dropoutTime #' @keywords internal NULL ## ## Sample Size / Power ## #' Parameter Description: Alternative #' @param alternative The alternative hypothesis value for testing means. This can be a vector of assumed #' alternatives, default is \code{seq(0, 1, 0.2)} (power calculations) or \code{seq(0.2, 1, 0.2)} (sample size calculations). #' @name param_alternative #' @keywords internal NULL #' Parameter Description: Alternative for Simulation #' @param alternative The alternative hypothesis value for testing means under which the data is simulated. #' This can be a vector of assumed alternatives, default is \code{seq(0, 1, 0.2)}. #' @name param_alternative_simulation #' @keywords internal NULL ## ## Analysis ## #' Parameter Description: Stage Results #' @param stageResults The results at given stage, obtained from \code{\link{getStageResults}}. #' @name param_stageResults #' @keywords internal NULL #' Parameter Description: Stage #' @param stage The stage number (optional). Default: total number of existing stages in the data input. #' @name param_stage #' @keywords internal NULL #' Parameter Description: N Planned #' @param nPlanned The additional (i.e., "new" and not cumulative) sample size planned for each of the subsequent stages. #' The argument must be a vector with length equal to the number of remaining stages and contain #' the combined sample size from both treatment groups if two groups are considered. For survival outcomes, #' it should contain the planned number of additional events. #' For multi-arm designs, it is the per-comparison (combined) sample size. #' For enrichment designs, it is the (combined) sample size for the considered sub-population. #' @name param_nPlanned #' @keywords internal NULL #' Parameter Description: Allocation Ratio Planned #' @param allocationRatioPlanned The planned allocation ratio \code{n1 / n2} for a two treatment groups #' design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. #' @name param_allocationRatioPlanned #' @keywords internal NULL #' Parameter Description: Allocation Ratio Planned With Optimum Option #' @param allocationRatioPlanned The planned allocation ratio \code{n1 / n2} for a two treatment groups #' design, default is \code{1}. If \code{allocationRatioPlanned = 0} is entered, #' the optimal allocation ratio yielding the smallest overall sample size is determined. #' @name param_allocationRatioPlanned_sampleSize #' @keywords internal NULL #' Parameter Description: Direction Upper #' @param directionUpper Specifies the direction of the alternative, #' only applicable for one-sided testing; default is \code{TRUE} #' which means that larger values of the test statistics yield smaller p-values. #' @name param_directionUpper #' @keywords internal NULL #' Parameter Description: Data Input #' @param dataInput The summary data used for calculating the test results. #' This is either an element of \code{DatasetMeans}, of \code{DatasetRates}, or of \code{DatasetSurvival} #' and should be created with the function \code{getDataset}. #' For more information see \code{\link{getDataset}}. #' @name param_dataInput #' @keywords internal NULL #' Parameter Description: Normal Approximation #' @param normalApproximation The type of computation of the p-values. Default is \code{FALSE} for #' testing means (i.e., the t test is used) and \code{TRUE} for testing rates and the hazard ratio. #' For testing rates, if \code{normalApproximation = FALSE} is specified, the binomial test #' (one sample) or the exact test of Fisher (two samples) is used for calculating the p-values. #' In the survival setting \code{normalApproximation = FALSE} has no effect. #' @name param_normalApproximation #' @keywords internal NULL #' Parameter Description: Theta H0 #' @param thetaH0 The null hypothesis value, #' default is \code{0} for the normal and the binary case (testing means and rates, respectively), #' it is \code{1} for the survival case (testing the hazard ratio).\cr\cr #' For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. #' That is, in case of (one-sided) testing of #' \itemize{ #' \item \emph{means}: a value \code{!= 0} #' (or a value \code{!= 1} for testing the mean ratio) can be specified. #' \item \emph{rates}: a value \code{!= 0} #' (or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. #' \item \emph{survival data}: a bound for testing H0: \code{hazard ratio = thetaH0 != 1} can be specified. #' } #' For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for #' defining the null hypothesis H0: \code{pi = thetaH0}. #' @name param_thetaH0 #' @keywords internal NULL #' Parameter Description: Legend Position On Plots #' @param legendPosition The position of the legend. #' By default (\code{NA_integer_}) the algorithm tries to find a suitable position. #' Choose one of the following values to specify the position manually: #' \itemize{ #' \item \code{-1}: no legend will be shown #' \item \code{NA}: the algorithm tries to find a suitable position #' \item \code{0}: legend position outside plot #' \item \code{1}: legend position left top #' \item \code{2}: legend position left center #' \item \code{3}: legend position left bottom #' \item \code{4}: legend position right top #' \item \code{5}: legend position right center #' \item \code{6}: legend position right bottom #' } #' @name param_legendPosition #' @keywords internal NULL #' Parameter Description: Grid (Output Specification Of Multiple Plots) #' @param grid An integer value specifying the output of multiple plots. #' By default (\code{1}) a list of \code{ggplot} objects will be returned. #' If a \code{grid} value > 1 was specified, a grid plot will be returned #' if the number of plots is <= specified \code{grid} value; #' a list of \code{ggplot} objects will be returned otherwise. #' If \code{grid = 0} is specified, all plots will be created using \code{\link[base]{print}} command #' and a list of \code{ggplot} objects will be returned invisible. #' Note that one of the following packages must be installed to create a grid plot: #' 'ggpubr', 'gridExtra', or 'cowplot'. #' @name param_grid #' @keywords internal NULL ## ## Simulation ## #' Parameter Description: Min Number Of Events Per Stage #' @param minNumberOfEventsPerStage When performing a data driven sample size recalculation, #' the vector \code{minNumberOfEventsPerStage} with length kMax determines the #' minimum number of events per stage (i.e., not cumulated), the first element #' is not taken into account. #' @name param_minNumberOfEventsPerStage #' @keywords internal NULL #' Parameter Description: Max Number Of Events Per Stage #' @param maxNumberOfEventsPerStage When performing a data driven sample size recalculation, #' the vector \code{maxNumberOfEventsPerStage} with length kMax determines the maximum number #' of events per stage (i.e., not cumulated), the first element is not taken into account. #' @name param_maxNumberOfEventsPerStage #' @keywords internal NULL #' Parameter Description: Planned Subjects #' @param plannedSubjects \code{plannedSubjects} is a vector of length \code{kMax} (the number of stages of the design) #' that determines the number of cumulated (overall) subjects when the interim stages are planned. #' For two treatment arms, it is the number of subjects for both treatment arms. #' For multi-arm designs, \code{plannedSubjects} refers to the number of subjects per selected active arm. #' @name param_plannedSubjects #' @keywords internal NULL #' Parameter Description: Planned Events #' @param plannedEvents \code{plannedEvents} is a vector of length \code{kMax} (the number of stages of the design) #' that determines the number of cumulated (overall) events in survival designs when the interim stages are planned. #' For two treatment arms, it is the number of events for both treatment arms. #' For multi-arm designs, \code{plannedEvents} refers to the overall number of events for the selected arms plus control. #' @name param_plannedEvents #' @keywords internal NULL #' Parameter Description: Minimum Number Of Subjects Per Stage #' @param minNumberOfSubjectsPerStage When performing a data driven sample size recalculation, #' the vector \code{minNumberOfSubjectsPerStage} with length kMax determines the #' minimum number of subjects per stage (i.e., not cumulated), the first element #' is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms. #' For multi-arm designs \code{minNumberOfSubjectsPerStage} refers #' to the minimum number of subjects per selected active arm. #' @name param_minNumberOfSubjectsPerStage #' @keywords internal NULL #' Parameter Description: Maximum Number Of Subjects Per Stage #' @param maxNumberOfSubjectsPerStage When performing a data driven sample size recalculation, #' the vector \code{maxNumberOfSubjectsPerStage} with length kMax determines the maximum number #' of subjects per stage (i.e., not cumulated), the first element is not taken into account. #' For two treatment arms, it is the number of subjects for both treatment arms. #' For multi-arm designs \code{maxNumberOfSubjectsPerStage} refers #' to the maximum number of subjects per selected active arm. #' @name param_maxNumberOfSubjectsPerStage #' @keywords internal NULL #' Parameter Description: Conditional Power #' @param conditionalPower The conditional power for the subsequent stage #' under which the sample size recalculation is performed. #' @name param_conditionalPower #' @keywords internal NULL #' Parameter Description: Conditional Power #' @param conditionalPower If \code{conditionalPower} together with \code{minNumberOfSubjectsPerStage} and #' \code{maxNumberOfSubjectsPerStage} (or \code{minNumberOfEventsPerStage} and \code{maxNumberOfEventsPerStage} #' for survival designs) is specified, a sample size recalculation based on the specified conditional power is performed. #' It is defined as the power for the subsequent stage given the current data. By default, #' the conditional power will be calculated under the observed effect size. Optionally, you can also specify \code{thetaH1} and #' \code{stDevH1} (for simulating means), \code{pi1H1} and \code{pi2H1} (for simulating rates), or \code{thetaH1} (for simulating #' hazard ratios) as parameters under which it is calculated and the sample size recalculation is performed. #' @name param_conditionalPowerSimulation #' @keywords internal NULL #' Parameter Description: Maximum Number Of Iterations #' @param maxNumberOfIterations The number of simulation iterations, default is \code{1000}. #' @name param_maxNumberOfIterations #' @keywords internal NULL #' Parameter Description: Calculate Subjects Function #' @param calcSubjectsFunction Optionally, a function can be entered that defines the way of performing the sample size #' recalculation. By default, sample size recalculation is performed with conditional power with specified #' \code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (see details and examples). #' @name param_calcSubjectsFunction #' @keywords internal NULL #' Parameter Description: Calculate Events Function #' @param calcEventsFunction Optionally, a function can be entered that defines the way of performing the sample size #' recalculation. By default, sample size recalculation is performed with conditional power with specified #' \code{minNumberOfEventsPerStage} and \code{maxNumberOfEventsPerStage} (see details and examples). #' @name param_calcEventsFunction #' @keywords internal NULL #' Parameter Description: Seed #' @param seed The seed to reproduce the simulation, default is a random seed. #' @name param_seed #' @keywords internal NULL #' Parameter Description: Show Statistics #' @param showStatistics If \code{TRUE}, summary statistics of the simulated data #' are displayed for the \code{print} command, otherwise the output is suppressed, default #' is \code{FALSE}. #' @name param_showStatistics #' @keywords internal NULL #' Parameter Description: Maximum Number Of Subjects #' @param maxNumberOfSubjects \code{maxNumberOfSubjects > 0} needs to be specified. #' For two treatment arms, it is the maximum number of subjects for both treatment arms. #' @name param_maxNumberOfSubjects #' @keywords internal NULL #' Parameter Description: Maximum Number Of Subjects For Survival Endpoint #' @param maxNumberOfSubjects \code{maxNumberOfSubjects > 0} needs to be specified. #' If accrual time and accrual intensity is specified, this will be calculated. #' @name param_maxNumberOfSubjects_survival #' @keywords internal NULL #' Parameter Description: Accrual Time #' @param accrualTime The assumed accrual time intervals for the study, default is #' \code{c(0, 12)} (for details see \code{\link{getAccrualTime}}). #' @name param_accrualTime #' @keywords internal NULL #' Parameter Description: Accrual Intensity #' @param accrualIntensity A vector of accrual intensities, default is the relative #' intensity \code{0.1} (for details see \code{\link{getAccrualTime}}). #' @name param_accrualIntensity #' @keywords internal NULL #' Parameter Description: Accrual Intensity Type #' @param accrualIntensityType A character value specifying the accrual intensity input type. #' Must be one of \code{"auto"}, \code{"absolute"}, or \code{"relative"}; default is \code{"auto"}, #' i.e., if all values are < 1 the type is \code{"relative"}, otherwise it is \code{"absolute"}. #' @name param_accrualIntensityType #' @keywords internal NULL #' Parameter Description: Standard Deviation Under Alternative #' @param stDevH1 If specified, the value of the standard deviation under which #' the conditional power or sample size recalculation calculation is performed, #' default is the value of \code{stDev}. #' @name param_stDevH1 #' @keywords internal NULL #' Parameter Description: Standard Deviation for Simulation #' @param stDev The standard deviation under which the data is simulated, #' default is \code{1}. #' If \code{meanRatio = TRUE} is specified, \code{stDev} defines #' the coefficient of variation \code{sigma / mu2}. #' @name param_stDevSimulation #' @keywords internal NULL #' Parameter Description: Number Of Treatment Groups #' @param groups The number of treatment groups (1 or 2), default is \code{2}. #' @name param_groups #' @keywords internal NULL ## ## Other ## #' Parameter Description: Nice Column Names Enabled #' @param niceColumnNamesEnabled Logical. If \code{TRUE}, nice looking column #' names will be used; syntactic names (variable names) otherwise #' (see \code{\link[base]{make.names}}). #' @name param_niceColumnNamesEnabled #' @keywords internal NULL #' Parameter Description: Include All Parameters #' @param includeAllParameters Logical. If \code{TRUE}, all available #' parameters will be included in the data frame; #' a meaningful parameter selection otherwise, default is \code{FALSE}. #' @name param_includeAllParameters #' @keywords internal NULL #' Parameter Description: Digits #' @param digits Defines how many digits are to be used for numeric values. #' @name param_digits #' @keywords internal NULL #' Parameter Description: Tolerance #' @param tolerance The numerical tolerance, default is \code{1e-06}. #' @name param_tolerance #' @keywords internal NULL ## ## Plots ## #' Parameter Description: Plot Points Enabled #' @param plotPointsEnabled If \code{TRUE}, additional points will be plotted. #' @name param_plotPointsEnabled #' @keywords internal NULL #' Parameter Description: Palette #' @param palette The palette, default is \code{"Set1"}. #' @name param_palette #' @keywords internal NULL ## ## Multi-Arm and Enrichment Designs ## #' Parameter Description: Intersection Test #' @param intersectionTest Defines the multiple test for the intersection #' hypotheses in the closed system of hypotheses. #' Five options are available in multi-arm designs: \code{"Dunnett"}, \code{"Bonferroni"}, \code{"Simes"}, #' \code{"Sidak"}, and \code{"Hierarchical"}, default is \code{"Dunnett"}. #' @name param_intersectionTest_MultiArm #' @keywords internal NULL #' Parameter Description: Intersection Test #' @param intersectionTest Defines the multiple test for the intersection #' hypotheses in the closed system of hypotheses. #' Four options are available in enrichment designs: \code{"SpiessensDebois"}, \code{"Bonferroni"}, \code{"Simes"}, #' and \code{"Sidak"}, default is \code{"Simes"}. #' @name param_intersectionTest_Enrichment #' @keywords internal NULL #' Parameter Description: Type of Selection #' @param typeOfSelection The way the treatment arms or populations are selected at interim. #' Five options are available: \code{"best"}, \code{"rbest"}, \code{"epsilon"}, \code{"all"}, and \code{"userDefined"}, #' default is \code{"best"}.\cr #' For \code{"rbest"} (select the \code{rValue} best treatment arms/populations), the parameter \code{rValue} has to be specified, #' for \code{"epsilon"} (select treatment arm/population not worse than epsilon compared to the best), the parameter #' \code{epsilonValue} has to be specified. #' If \code{"userDefined"} is selected, \code{"selectArmsFunction"} or \code{"selectPopulationsFunction"} has to be specified. #' @name param_typeOfSelection #' @keywords internal NULL #' Parameter Description: Effect Measure #' @param effectMeasure Criterion for treatment arm/population selection, either based on test statistic #' (\code{"testStatistic"}) or effect estimate (difference for means and rates or ratio for survival) (\code{"effectEstimate"}), #' default is \code{"effectEstimate"}. #' @name param_effectMeasure #' @keywords internal NULL #' Parameter Description: Adaptations #' @param adaptations A vector of length \code{kMax - 1} indicating whether or not an adaptation takes #' place at interim k, default is \code{rep(TRUE, kMax - 1)}. #' @name param_adaptations #' @keywords internal NULL #' Parameter Description: Threshold #' @param threshold Selection criterion: treatment arm / population is selected only if \code{effectMeasure} #' exceeds \code{threshold}, default is \code{-Inf}. #' \code{threshold} can also be a vector of length \code{activeArms} referring to #' a separate threshold condition over the treatment arms. #' @name param_threshold #' @keywords internal NULL #' Parameter Description: Effect Matrix #' @param effectMatrix Matrix of effect sizes with \code{activeArms} columns and number of rows #' reflecting the different situations to consider. #' @name param_effectMatrix #' @keywords internal NULL #' Parameter Description: Effect List #' @param effectList List of effect sizes with columns and number of rows #' reflecting the different situations to consider (see examples). #' @name param_effectList #' @keywords internal NULL #' Parameter Description: Active Arms #' @param activeArms The number of active treatment arms to be compared with control, default is \code{3}. #' @name param_activeArms #' @keywords internal NULL #' Parameter Description: Populations #' @param populations The number of populations in a two-sample comparison, default is \code{3}. #' @name param_populations #' @keywords internal NULL #' Parameter Description: Success Criterion #' @param successCriterion Defines when the study is stopped for efficacy at interim. #' Two options are available: \code{"all"} stops the trial #' if the efficacy criterion is fulfilled for all selected treatment arms/populations, #' \code{"atLeastOne"} stops if at least one of the selected treatment arms/populations is shown to be #' superior to control at interim, default is \code{"all"}. #' @name param_successCriterion #' @keywords internal NULL #' Parameter Description: Type Of Shape #' @param typeOfShape The shape of the dose-response relationship over the treatment groups. #' This can be either \code{"linear"}, \code{"sigmoidEmax"}, or \code{"userDefined"}. #' If \code{"sigmoidEmax"} is selected, \code{"gED50"} and \code{"slope"} has to be entered #' to specify the ED50 and the slope of the sigmoid Emax model. #' For \code{"linear"} and \code{"sigmoidEmax"}, \code{"muMaxVector"} specifies the range #' of effect sizes for the treatment group with highest response. #' If \code{"userDefined"} is selected, \code{"effectMatrix"} has to be entered. #' @name param_typeOfShape #' @keywords internal NULL #' Parameter Description: Variance Option #' @param varianceOption Defines the way to calculate the variance in multiple treatment arms (> 2) #' or population enrichment designs for testing means. For multiple arms, three options are available: #' \code{"overallPooled"}, \code{"pairwisePooled"}, and \code{"notPooled"}, default is \code{"overallPooled"}. #' For enrichment designs, the options are: \code{"pooled"}, \code{"pooledFromFull"} (one subset only), #' and \code{"notPooled"}, default is \code{"pooled"}. #' @name param_varianceOption #' @keywords internal NULL #' Parameter Description: Select Arms Function #' @param selectArmsFunction Optionally, a function can be entered that defines the way of how treatment arms #' are selected. This function is allowed to depend on \code{effectVector} with length \code{activeArms} #' and \code{stage} (see examples). #' @name param_selectArmsFunction #' @keywords internal NULL #' Parameter Description: Select Populations Function #' @param selectPopulationsFunction Optionally, a function can be entered that defines the way of how populations #' are selected. This function is allowed to depend on \code{effectVector} with length \code{populations} #' and \code{stage} (see examples). #' @name param_selectPopulationsFunction #' @keywords internal NULL #' Parameter Description: Stratified Analysis #' @param stratifiedAnalysis For enrichment designs, typically a stratified analysis should be chosen. #' For testing rates, also a non-stratified analysis based on overall data can be performed. #' For survival data, only a stratified analysis is possible (see Brannath et al., 2009), #' default is \code{TRUE}. #' @name param_stratifiedAnalysis #' @keywords internal NULL #' Parameter Description: Show Source #' @param showSource If \code{TRUE}, the parameter names of the object will #' be printed which were used to create the plot; that may be, e.g., #' useful to check the values or to create own plots with the base R \code{plot} function. #' Alternatively \code{showSource} can be defined as one of the following character values: #' \itemize{ #' \item \code{"commands"}: returns a character vector with plot commands #' \item \code{"axes"}: returns a list with the axes definitions #' \item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and #' returned as character vector (function does not stop if an error occurs) #' \item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and #' returned as character vector (function stops if an error occurs) #' } #' Note: no plot object will be returned if \code{showSource} is a character. #' @name param_showSource #' @keywords internal NULL #' Parameter Description: RValue #' @param rValue For \code{typeOfSelection = "rbest"} (select the \code{rValue} best treatment arms / populations), #' the parameter \code{rValue} has to be specified. #' @name param_rValue #' @keywords internal NULL #' Parameter Description: EpsilonValue #' @param epsilonValue For \code{typeOfSelection = "epsilon"} (select treatment arm / population not worse than #' epsilon compared to the best), the parameter \code{epsilonValue} has to be specified. #' @name param_epsilonValue #' @keywords internal NULL #' Parameter Description: G ED50 #' @param gED50 If \code{typeOfShape = "sigmoidEmax"} is selected, \code{"gED50"} has to be entered #' to specify the ED50 of the sigmoid Emax model. #' @name param_gED50 #' @keywords internal NULL #' Parameter Description: Slope #' @param slope If \code{typeOfShape = "sigmoidEmax"} is selected, \code{"slope"} can be entered #' to specify the slope of the sigmoid Emax model, default is 1. #' @name param_slope #' @keywords internal NULL #' Parameter Description: Maximum Information #' @param maxInformation Positive integer value specifying the maximum information. #' @name param_maxInformation #' @keywords internal NULL #' Parameter Description: Information Epsilon #' @param informationEpsilon Positive integer value specifying the absolute information epsilon, which #' defines the maximum distance from the observed information to the maximum information that causes the final analysis. #' Updates at the final analysis in case the observed information at the final #' analysis is smaller ("under-running") than the planned maximum information \code{maxInformation}, default is 0. #' Alternatively, a floating-point number > 0 and < 1 can be specified to define a relative information epsilon. #' @name param_informationEpsilon #' @keywords internal NULL #' Parameter Description: Plot Settings #' @param plotSettings An object of class \code{PlotSettings} created by \code{\link{getPlotSettings}}. #' @name param_plotSettings #' @keywords internal NULL rpact/R/f_parameter_set_utilities.R0000644000175000017500000001457514145656365017327 0ustar nileshnilesh## | ## | *Parameter set utilities* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | .isMatrix <- function(param) { if (missing(param) || is.null(param) || is.list(param)) { return(FALSE) } return(is.matrix(param)) } .isArray <- function(param) { if (missing(param) || is.null(param) || is.list(param)) { return(FALSE) } return(is.array(param)) } .isVector <- function(param) { if (missing(param) || is.null(param) || is.list(param)) { return(FALSE) } return(length(param) > 1) } .getMatrixFormatted = function(paramValueFormatted, enforceListOuput = FALSE) { if (!is.matrix(paramValueFormatted) && enforceListOuput) { paramValueFormatted <- matrix(paramValueFormatted, nrow = 1) } if (!is.matrix(paramValueFormatted)) { return(list( paramValueFormatted = matrix(as.character(paramValueFormatted), ncol = 1), type = "matrix" )) } matrixFormatted <- paramValueFormatted paramValueFormatted <- .arrayToString(matrixFormatted[1, ]) type <- "vector" if (nrow(matrixFormatted) > 1 && ncol(matrixFormatted) > 0) { type <- "matrix" paramValueFormatted <- list(paramValueFormatted) for (i in 2:nrow(matrixFormatted)) { paramValueFormatted <- c(paramValueFormatted, .arrayToString(matrixFormatted[i, ])) } } return(list( paramValueFormatted = paramValueFormatted, type = type )) } .getParameterValueFormatted <- function(obj, parameterName) { tryCatch({ result <- obj$.extractParameterNameAndValue(parameterName) parameterName <- result$parameterName paramValue <- result$paramValue if (isS4(paramValue)) { return(NULL) } if (is.function(paramValue)) { valueStr <- ifelse(obj$.getParameterType(parameterName) == C_PARAM_USER_DEFINED, "user defined", "default") return(list( paramName = parameterName, paramValue = valueStr, paramValueFormatted = valueStr, type = "function" )) } if (is.list(paramValue)) { resultList <- list() for (listParamName in names(paramValue)) { listParamValue <- paramValue[[listParamName]] type <- "vector" paramValueFormatted <- listParamValue if (.isMatrix(listParamValue)) { m <- .getMatrixFormatted(paramValueFormatted) paramValueFormatted <- m$paramValueFormatted type <- m$type } else if (.isVector(listParamValue)) { paramValueFormatted <- .arrayToString(listParamValue) } entry <- list( paramName = paste0(parameterName, "$", listParamName), paramValue = listParamValue, paramValueFormatted = paramValueFormatted, type = type ) resultList[[length(resultList) + 1]] <- entry } return(resultList) } paramValueFormatted <- paramValue if (obj$.getParameterType(parameterName) == C_PARAM_USER_DEFINED && (!is.numeric(paramValue) || identical(paramValue, round(paramValue)))) { if (inherits(obj, C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL) && parameterName == "typeOfDesign") { paramValueFormatted <- C_TYPE_OF_DESIGN_LIST[[paramValue]] } if (inherits(obj, C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL) && parameterName == "typeBetaSpending") { paramValueFormatted <- C_TYPE_OF_DESIGN_BS_LIST[[paramValue]] } } else { formatFunctionName <- obj$.parameterFormatFunctions[[parameterName]] if (!is.null(formatFunctionName)) { paramValueFormatted <- eval(call(formatFunctionName, paramValueFormatted)) if (.isArray(paramValue) && length(dim(paramValue)) == 2) { paramValueFormatted <- matrix(paramValueFormatted, ncol = ncol(paramValue)) } } else if (inherits(obj, C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL) && parameterName == "typeOfDesign") { paramValueFormatted <- C_TYPE_OF_DESIGN_LIST[[paramValue]] } else if (inherits(obj, C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL) && parameterName == "typeBetaSpending") { paramValueFormatted <- C_TYPE_OF_DESIGN_BS_LIST[[paramValue]] } } type <- "vector" if (.isArray(paramValue) && length(dim(paramValue)) == 3) { arrayFormatted <- paramValueFormatted numberOfEntries <- dim(arrayFormatted)[3] numberOfCols <- dim(arrayFormatted)[2] numberOfRows <- dim(arrayFormatted)[1] enforceListOuput <- numberOfCols > 1 m <- .getMatrixFormatted(arrayFormatted[, , 1], enforceListOuput = enforceListOuput) paramValueFormatted <- m$paramValueFormatted type <- m$type if (numberOfEntries > 1 && numberOfRows > 0) { type <- "array" for (i in 2:numberOfEntries) { m <- .getMatrixFormatted(arrayFormatted[, , i], enforceListOuput = enforceListOuput) paramValueFormatted <- c(paramValueFormatted, m$paramValueFormatted) } } } else if (.isMatrix(paramValue) || .isArray(paramValue)) { m <- .getMatrixFormatted(paramValueFormatted) paramValueFormatted <- m$paramValueFormatted type <- m$type } else if (.isVector(paramValue)) { paramValueFormatted <- .arrayToString(paramValueFormatted) } else if (parameterName == "sided") { paramValueFormatted <- ifelse(paramValue == 1, "one-sided", "two-sided") } # if (type == "array" && length(dim(paramValue)) == 3 && length(paramValue) != length(paramValueFormatted)) { # stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, # sprintf("length of 'paramValue' (%s) != length of 'paramValueFormatted' (%s)", # length(paramValue), length(paramValueFormatted))) # } return(list( paramName = parameterName, paramValue = paramValue, paramValueFormatted = paramValueFormatted, type = type )) }, error = function(e) { .logError(paste0("Error in '.getParameterValueFormatted'. ", "Failed to show parameter '%s' (class '%s'): %s"), parameterName, class(obj), e) }) return(NULL) }rpact/R/class_simulation_results.R0000644000175000017500000024172714154651323017214 0ustar nileshnilesh ## | ## | *Simulation result classes* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5644 $ ## | Last changed: $Date: 2021-12-10 14:14:55 +0100 (Fr, 10 Dez 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' #' @name SimulationResults_names #' #' @title #' Names of a Simulation Results Object #' #' @description #' Function to get the names of a \code{\link{SimulationResults}} object. #' #' @param x A \code{\link{SimulationResults}} object created by \code{getSimulationResults[MultiArm/Enrichment][Means/Rates/Survival]}. #' #' @details #' Returns the names of a simulation results that can be accessed by the user. #' #' @template return_names #' #' @export #' #' @keywords internal #' names.SimulationResults <- function(x) { namesToShow <- c(".design", ".data", ".rawData") if (inherits(x, "SimulationResultsSurvival")) { namesToShow <- c(namesToShow, ".piecewiseSurvivalTime", ".accrualTime") } namesToShow <- c(namesToShow, x$.getVisibleFieldNames()) return(namesToShow) } #' #' @name SimulationResults #' #' @title #' Class for Simulation Results #' #' @description #' A class for simulation results. #' #' @details #' \code{SimulationResults} is the basic class for #' \itemize{ #' \item \code{\link{SimulationResultsMeans}}, #' \item \code{\link{SimulationResultsRates}}, #' \item \code{\link{SimulationResultsSurvival}}, #' \item \code{\link{SimulationResultsMultiArmMeans}}, #' \item \code{\link{SimulationResultsMultiArmRates}}, and #' \item \code{\link{SimulationResultsMultiArmSurvival}}. #' } #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_design.R #' @include f_core_constants.R #' @include class_time.R #' @include f_simulation_base_survival.R #' @include f_simulation_utilities.R #' #' @keywords internal #' #' @importFrom methods new #' SimulationResults <- setRefClass("SimulationResults", contains = "ParameterSet", fields = list( .plotSettings = "PlotSettings", .design = "TrialDesign", .data = "data.frame", .rawData = "data.frame", .showStatistics = "logical", maxNumberOfIterations = "integer", seed = "numeric", allocationRatioPlanned = "numeric", conditionalPower = "numeric", iterations = "matrix", futilityPerStage = "matrix", futilityStop = "numeric" ), methods = list( initialize = function(design, ..., showStatistics = FALSE) { callSuper(.design = design, .showStatistics = showStatistics, ...) .plotSettings <<- PlotSettings() .parameterNames <<- .getParameterNames(design = design, designPlan = .self) .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS }, getPlotSettings = function() { return(.plotSettings) }, setShowStatistics = function(showStatistics) { .assertIsSingleLogical(showStatistics, "showStatistics") .showStatistics <<- showStatistics }, show = function(showType = 1, digits = NA_integer_, showStatistics = FALSE) { .show(showType = showType, digits = digits, showStatistics = showStatistics, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, showStatistics = FALSE, consoleOutputEnabled = TRUE) { 'Method for automatically printing simulation result objects' .resetCat() if (showType == 3) { .createSummary(.self, digits = digits)$.show(showType = 1, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else if (showType == 2) { callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { if (is.null(showStatistics) || length(showStatistics) != 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'showStatistics' (", .arrayToString(showStatistics), ") must be a single logical or character") } if (!is.character(showStatistics) || showStatistics != "exclusive") { .cat(.toString(startWithUpperCase = TRUE), ":\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getDesignParametersToShow(.self), "Design parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) userDefinedParameters <- .getUserDefinedParameters() if (inherits(.self, "SimulationResultsSurvival") && .self$.piecewiseSurvivalTime$delayedResponseEnabled) { userDefinedParameters <- c(userDefinedParameters, ".piecewiseSurvivalTime$delayedResponseEnabled") } .showParametersOfOneGroup(userDefinedParameters, "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) derivedParameters <- .getDerivedParameters() if (length(derivedParameters) > 0) { .showParametersOfOneGroup(derivedParameters, "Derived from user defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) } .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getGeneratedParameters(), "Results", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) } ## statistics of simulated data if (isTRUE(showStatistics) || .showStatistics || (is.character(showStatistics) && showStatistics == "exclusive")) { .cat("Simulated data:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) params <- c() if (inherits(.self, "SimulationResultsMeans")) { params <- c( "effectMeasure", "numberOfSubjects", "testStatistic") } else if (inherits(.self, "SimulationResultsRates")) { params <- c( "effectMeasure", "numberOfSubjects", "testStatistic") } else if (inherits(.self, "SimulationResultsSurvival")) { params <- c( "effectMeasure", "analysisTime", "numberOfSubjects", "eventsPerStage1", "eventsPerStage2", "eventsPerStage", "testStatistic", "logRankStatistic", "hazardRatioEstimateLR") } else if (inherits(.self, "SimulationResultsMultiArmMeans") || inherits(.self, "SimulationResultsMultiArmRates")) { params <- c( "effectMeasure", "subjectsActiveArm", "testStatistic", "conditionalCriticalValue", "rejectPerStage", "successStop", "futilityPerStage" ) } else if (inherits(.self, "SimulationResultsEnrichmentMeans") || inherits(.self, "SimulationResultsEnrichmentRates")) { params <- c( "effectMeasure", "subjectsPopulation", "testStatistic", "conditionalCriticalValue", "rejectPerStage", "successStop", "futilityPerStage" ) } else if (inherits(.self, "SimulationResultsMultiArmSurvival") || inherits(.self, "SimulationResultsEnrichmentSurvival")) { params <- c( "effectMeasure", "numberOfEvents", "singleNumberOfEventsPerStage", "testStatistic", "conditionalCriticalValue", "rejectPerStage", "successStop", "futilityPerStage" ) } if (!is.null(.self[["conditionalPowerAchieved"]]) && !all(is.na(conditionalPowerAchieved)) && any(!is.na(conditionalPowerAchieved)) && any(na.omit(conditionalPowerAchieved) != 0)) { params <- c(params, "conditionalPowerAchieved") } stages <- sort(unique(.self$.data$stageNumber)) variedParameterName1 <- NA_character_ variedParameterName2 <- NA_character_ if (inherits(.self, "SimulationResultsMeans")) { variedParameterName1 <- "alternative" } else if (inherits(.self, "SimulationResultsRates") || inherits(.self, "SimulationResultsSurvival")) { variedParameterName1 <- "pi1" } else if (grepl("MultiArm", class(.self))) { if (inherits(.self, "SimulationResultsMultiArmMeans")) { variedParameterName1 <- "muMax" } else if (inherits(.self, "SimulationResultsMultiArmRates")) { variedParameterName1 <- "piMax" } else if (inherits(.self, "SimulationResultsMultiArmSurvival")) { variedParameterName1 <- "omegaMax" } variedParameterName2 <- "armNumber" } parameterValues1 <- .getVariedParameterValues(variedParameterName1) parameterValues2 <- .getVariedParameterValues(variedParameterName2) for (parameterName in params) { paramCaption <- .parameterNames[[parameterName]] if (is.null(paramCaption)) { paramCaption <- paste0("%", parameterName, "%") } for (parameterValue1 in parameterValues1) { for (parameterValue2 in parameterValues2) { for (stage in stages) { if (length(parameterValues1) > 1) { .catStatisticsLine(stage = stage, parameterName = parameterName, paramCaption = paramCaption, parameterValue1 = parameterValue1, variedParameterName1 = variedParameterName1, parameterValue2 = parameterValue2, variedParameterName2 = variedParameterName2, consoleOutputEnabled = consoleOutputEnabled) } else { .catStatisticsLine(stage = stage, parameterName = parameterName, paramCaption = paramCaption, parameterValue1 = parameterValue2, variedParameterName1 = variedParameterName2, consoleOutputEnabled = consoleOutputEnabled) } } } if (parameterName == "subjectsActiveArm" && variedParameterName2 == "armNumber") { parameterName2 <- "subjectsControlArm" paramCaption2 <- .parameterNames[[parameterName2]] if (is.null(paramCaption2)) { paramCaption2 <- paste0("%", parameterName2, "%") } for (stage in stages) { .catStatisticsLine(stage = stage, parameterName = parameterName2, paramCaption = paramCaption2, parameterValue1 = parameterValue1, variedParameterName1 = variedParameterName1, parameterValue2 = unique(parameterValues2), variedParameterName2 = variedParameterName2, consoleOutputEnabled = consoleOutputEnabled) } } } } .cat("\n", consoleOutputEnabled = consoleOutputEnabled) } twoGroupsEnabled <- !inherits(.self, "SimulationResultsMeans") multiArmSurvivalEnabled <- inherits(.self, "SimulationResultsMultiArmSurvival") enrichmentEnabled <- grepl("SimulationResultsEnrichment", class(.self)) if (.design$kMax > 1 || twoGroupsEnabled || multiArmSurvivalEnabled) { .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) if (multiArmSurvivalEnabled) { .cat(" (i): values of treatment arm i compared to control\n", consoleOutputEnabled = consoleOutputEnabled) .cat(" {j}: values of treatment arm j\n", consoleOutputEnabled = consoleOutputEnabled) } else if (enrichmentEnabled) { matrixName <- .getSimulationEnrichmentEffectMatrixName(.self) if (nrow(.self$effectList[[matrixName]]) > 1) { .cat(" (i): results of situation i\n", consoleOutputEnabled = consoleOutputEnabled) } } else if (twoGroupsEnabled) { .cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) } if (.design$kMax > 1) { .cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) } if (enrichmentEnabled) { if (length(.self$effectList$subGroups) > 1) { .cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) } .cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) if (length(.self$effectList$subGroups) > 1) { .cat(paste0(" R: remaining population\n"), consoleOutputEnabled = consoleOutputEnabled) } } .cat("\n", consoleOutputEnabled = consoleOutputEnabled) } } }, .getVariedParameterValues = function(variedParameterName) { if (is.na(variedParameterName)) { return(NA_real_) } parameterValues <- .self$.data[[variedParameterName]] if (is.null(parameterValues)) { return(NA_real_) } parameterValues <- unique(parameterValues) if (length(parameterValues) > 1 && !any(is.na(parameterValues))) { parameterValues <- sort(parameterValues) } return(parameterValues) }, .getVariedParameterValueString = function(variedParameterName, parameterValue) { if (variedParameterName %in% c("armNumber")) { return(paste0(" (", parameterValue[1], ")")) } variedParameterName <- sub("Max$", "_max", variedParameterName) return(paste0(", ", variedParameterName, " = ", round(parameterValue[1], 4))) }, .catStatisticsLine = function(..., stage, parameterName, paramCaption, parameterValue1, variedParameterName1, parameterValue2 = NA_real_, variedParameterName2 = NA_character_, consoleOutputEnabled = TRUE) { if (stage == 1 && parameterName == "conditionalPowerAchieved") { return(invisible()) } postfix <- "" if (!is.na(parameterValue1)) { if (!all(is.na(parameterValue2))) { postfix <- paste0(postfix, .getVariedParameterValueString( variedParameterName1, parameterValue1)) if (parameterName != "subjectsControlArm") { postfix <- paste0(postfix, .getVariedParameterValueString( variedParameterName2, parameterValue2)) } paramValue <- .self$.data[[parameterName]][ .self$.data$stageNumber == stage & .self$.data[[variedParameterName1]] == parameterValue1 & .self$.data[[variedParameterName2]] %in% parameterValue2] } else { postfix <- paste0(postfix, .getVariedParameterValueString( variedParameterName1, parameterValue1)) paramValue <- .self$.data[[parameterName]][ .self$.data$stageNumber == stage & .self$.data[[variedParameterName1]] == parameterValue1] } } else { paramValue <- .self$.data[[parameterName]][ .self$.data$stageNumber == stage] } if (.design$kMax > 1) { postfix <- paste0(postfix, " [", stage, "]") } if (!consoleOutputEnabled) { paramCaption <- paste0("*", paramCaption, "*") } variableNameFormatted <- .getFormattedVariableName(name = paramCaption, n = .getNChar(), prefix = "", postfix = postfix) if (!is.null(paramValue)) { paramValue <- stats::na.omit(paramValue) if (length(paramValue) > 0 && is.numeric(paramValue)) { paramValueFormatted <- paste0("median [range]: ", round(stats::median(paramValue), 3), " [", paste(round(base::range(paramValue), 3), collapse = " - "), "]; ", "mean +/-sd: ", round(base::mean(paramValue), 3), " +/-", round(stats::sd(paramValue), 3)) } else { paramValueFormatted <- "median [range]: NA [NA - NA]; mean +/sd: NA +/-NA" } output <- paste(variableNameFormatted, paramValueFormatted, "\n") if (!grepl(": median \\[range\\]: NA \\[NA - NA\\]", output)) { .cat(output, consoleOutputEnabled = consoleOutputEnabled) } } }, .toString = function(startWithUpperCase = FALSE) { s <- "simulation of" if (grepl("MultiArm", class(.self)) && !is.null(.self[["activeArms"]]) && .self$activeArms > 1) { s <- paste(s, "multi-arm") } if (grepl("Enrichment", class(.self)) && !is.null(.self[["populations"]]) && .self$populations > 1) { s <- paste(s, "enrichment") } if (inherits(.self, "SimulationResultsBaseMeans")) { s <- paste(s, "means") } else if (inherits(.self, "SimulationResultsBaseRates")) { s <- paste(s, "rates") } else if (inherits(.self, "SimulationResultsBaseSurvival")) { s <- paste(s, "survival data") } else { s <- paste(s, "results") } if (.design$kMax > 1) { if (.isTrialDesignGroupSequential(.design)) { s <- paste(s, "(group sequential design)") } else if (.isTrialDesignInverseNormal(.design)) { s <- paste(s, "(inverse normal combination test design)") } else if (.isTrialDesignFisher(.design)) { s <- paste(s, "(Fisher's combination test design)") } else if (.isTrialDesignConditionalDunnett(.design)) { s <- paste(s, "(conditional Dunnett design)") } } else { s <- paste(s, "(fixed sample size design)") } return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) }, .getParametersToShow = function() { parametersToShow <- .getVisibleFieldNames() y <- c( "iterations", "overallReject", # base "rejectAtLeastOne", "rejectPerStage", "rejectedArmsPerStage", "rejectedPopulationsPerStage" ) if (.design$kMax > 2) { y <- c(y, "futilityStop") } y <- c(y, "futilityPerStage", "earlyStop", # base "successPerStage", "selectedArms", "selectedPopulations", "numberOfActiveArms", "numberOfPopulations", "expectedNumberOfSubjects", "expectedNumberOfEvents", "sampleSizes", "eventsPerStage", "singleNumberOfEventsPerStage", "conditionalPowerAchieved" # base ) parametersToShow <- c(parametersToShow[!(parametersToShow %in% y)], y[y %in% parametersToShow]) return(parametersToShow) }, .isSampleSizeObject = function() { return(FALSE) } ) ) SimulationResultsBaseMeans <- setRefClass("SimulationResultsBaseMeans", contains = "SimulationResults", fields = list( stDev = "numeric", plannedSubjects = "numeric", minNumberOfSubjectsPerStage = "numeric", maxNumberOfSubjectsPerStage = "numeric", thetaH1 = "numeric", stDevH1 = "numeric", calcSubjectsFunction = "function", expectedNumberOfSubjects = "numeric" ), methods = list( initialize = function(design, ...) { callSuper(design = design, ...) generatedParams <- c( "iterations", "expectedNumberOfSubjects", "sampleSizes", "overallReject", "rejectPerStage", "futilityPerStage", "earlyStop") if (design$kMax > 2) { generatedParams <- c(generatedParams, "futilityStop") } for (generatedParam in generatedParams) { .setParameterType(generatedParam, C_PARAM_GENERATED) } } ) ) #' #' @name SimulationResultsMeans #' #' @title #' Class for Simulation Results Means #' #' @description #' A class for simulation results means. #' #' @details #' Use \code{\link{getSimulationMeans}} to create an object of this type. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_design.R #' @include f_core_constants.R #' @include class_time.R #' @include f_simulation_base_survival.R #' #' @keywords internal #' #' @importFrom methods new #' SimulationResultsMeans <- setRefClass("SimulationResultsMeans", contains = "SimulationResultsBaseMeans", fields = list( meanRatio = "logical", thetaH0 = "numeric", normalApproximation = "logical", alternative = "numeric", groups = "integer", directionUpper = "logical", thetaH1 = "numeric", srDevH1 = "numeric", effect = "numeric", earlyStop = "numeric", sampleSizes = "matrix", overallReject = "numeric", # = rejectedArmsPerStage in multi-arm rejectPerStage = "matrix", conditionalPowerAchieved = "matrix" ), methods = list( initialize = function(design, ...) { callSuper(design = design, ...) } ) ) #' #' @name SimulationResultsMultiArmMeans #' #' @title #' Class for Simulation Results Multi-Arm Means #' #' @description #' A class for simulation results means in multi-arm designs. #' #' @details #' Use \code{\link{getSimulationMultiArmMeans}} to create an object of this type. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_design.R #' @include f_core_constants.R #' @include class_time.R #' @include f_simulation_base_survival.R #' #' @keywords internal #' #' @importFrom methods new #' SimulationResultsMultiArmMeans <- setRefClass("SimulationResultsMultiArmMeans", contains = "SimulationResultsBaseMeans", fields = list( activeArms = "integer", effectMatrix = "matrix", typeOfShape = "character", muMaxVector = "numeric", gED50 = "numeric", slope = "numeric", intersectionTest = "character", adaptations = "logical", typeOfSelection = "character", effectMeasure = "character", successCriterion = "character", epsilonValue = "numeric", rValue = "numeric", threshold = "numeric", selectArmsFunction = "function", earlyStop = "matrix", selectedArms = "array", numberOfActiveArms = "matrix", rejectAtLeastOne = "numeric", rejectedArmsPerStage = "array", successPerStage = "matrix", sampleSizes = "array", conditionalPowerAchieved = "matrix" ), methods = list( initialize = function(design, ...) { callSuper(design = design, ...) for (generatedParam in c( "rejectAtLeastOne", "selectedArms", "numberOfActiveArms", "rejectedArmsPerStage", "successPerStage")) { .setParameterType(generatedParam, C_PARAM_GENERATED) } } ) ) SimulationResultsBaseRates <- setRefClass("SimulationResultsBaseRates", contains = "SimulationResults", fields = list( directionUpper = "logical", plannedSubjects = "numeric", minNumberOfSubjectsPerStage = "numeric", maxNumberOfSubjectsPerStage = "numeric", calcSubjectsFunction = "function", expectedNumberOfSubjects = "numeric" ), methods = list( initialize = function(design, ...) { callSuper(design = design, ...) generatedParams <- c( "iterations", "expectedNumberOfSubjects", "sampleSizes", "overallReject", "rejectPerStage", "futilityPerStage", "earlyStop") if (design$kMax > 2) { generatedParams <- c(generatedParams, "futilityStop") } for (generatedParam in generatedParams) { .setParameterType(generatedParam, C_PARAM_GENERATED) } } ) ) #' #' @name SimulationResultsRates #' #' @title #' Class for Simulation Results Rates #' #' @description #' A class for simulation results rates. #' #' @details #' Use \code{\link{getSimulationRates}} to create an object of this type. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_design.R #' @include f_core_constants.R #' @include class_time.R #' @include f_simulation_base_survival.R #' #' @keywords internal #' #' @importFrom methods new #' SimulationResultsRates <- setRefClass("SimulationResultsRates", contains = "SimulationResultsBaseRates", fields = list( riskRatio = "logical", thetaH0 = "numeric", normalApproximation = "logical", pi1 = "numeric", pi2 = "numeric", groups = "integer", directionUpper = "logical", pi1H1 = "numeric", pi2H1 = "numeric", effect = "numeric", earlyStop = "numeric", sampleSizes = "matrix", overallReject = "numeric", rejectPerStage = "matrix", conditionalPowerAchieved = "matrix" ), methods = list( initialize = function(design, ...) { callSuper(design = design, ...) generatedParams <- c( "effect", "iterations", "sampleSizes", "eventsNotAchieved", "expectedNumberOfSubjects", "overallReject", "rejectPerStage", "futilityPerStage", "earlyStop", "analysisTime", "studyDuration") if (design$kMax > 2) { generatedParams <- c(generatedParams, "futilityStop") } for (generatedParam in generatedParams) { .setParameterType(generatedParam, C_PARAM_GENERATED) } } ) ) #' #' @name SimulationResultsMultiArmRates #' #' @title #' Class for Simulation Results Multi-Arm Rates #' #' @description #' A class for simulation results rates in multi-arm designs. #' #' @details #' Use \code{\link{getSimulationMultiArmRates}} to create an object of this type. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_design.R #' @include f_core_constants.R #' @include class_time.R #' @include f_simulation_base_survival.R #' #' @keywords internal #' #' @importFrom methods new #' SimulationResultsMultiArmRates <- setRefClass("SimulationResultsMultiArmRates", contains = "SimulationResultsBaseRates", fields = list( activeArms = "integer", effectMatrix = "matrix", typeOfShape = "character", piMaxVector = "numeric", piControl = "numeric", piH1 = "numeric", piControlH1 = "numeric", gED50 = "numeric", slope = "numeric", intersectionTest = "character", adaptations = "logical", typeOfSelection = "character", effectMeasure = "character", successCriterion = "character", epsilonValue = "numeric", rValue = "numeric", threshold = "numeric", selectArmsFunction = "function", earlyStop = "matrix", selectedArms = "array", numberOfActiveArms = "matrix", rejectAtLeastOne = "numeric", rejectedArmsPerStage = "array", successPerStage = "matrix", sampleSizes = "array", conditionalPowerAchieved = "matrix" ), methods = list( initialize = function(design, ...) { callSuper(design = design, ...) for (generatedParam in c( "rejectAtLeastOne", "selectedArms", "numberOfActiveArms", "rejectedArmsPerStage", "successPerStage")) { .setParameterType(generatedParam, C_PARAM_GENERATED) } } ) ) SimulationResultsBaseSurvival <- setRefClass("SimulationResultsBaseSurvival", contains = "SimulationResults", fields = list( directionUpper = "logical", plannedEvents = "numeric", minNumberOfEventsPerStage = "numeric", maxNumberOfEventsPerStage = "numeric", thetaH1 = "numeric", calcEventsFunction = "function", expectedNumberOfEvents = "numeric" ), methods = list( initialize = function(design, ...) { callSuper(design = design, ...) generatedParams <- c( "iterations", "expectedNumberOfEvents", "eventsPerStage", "overallReject", "rejectPerStage", "futilityPerStage", "earlyStop") if (design$kMax > 2) { generatedParams <- c(generatedParams, "futilityStop") } for (generatedParam in generatedParams) { .setParameterType(generatedParam, C_PARAM_GENERATED) } } ) ) #' #' @name SimulationResultsSurvival #' #' @title #' Class for Simulation Results Survival #' #' @description #' A class for simulation results survival. #' #' @details #' Use \code{\link{getSimulationSurvival}} to create an object of this type. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_design.R #' @include f_core_constants.R #' @include class_time.R #' @include f_simulation_base_survival.R #' #' @keywords internal #' #' @importFrom methods new #' SimulationResultsSurvival <- setRefClass("SimulationResultsSurvival", contains = "SimulationResultsBaseSurvival", fields = list( .piecewiseSurvivalTime = "PiecewiseSurvivalTime", .accrualTime = "AccrualTime", pi1 = "numeric", pi2 = "numeric", median1 = "numeric", median2 = "numeric", maxNumberOfSubjects = "numeric", accrualTime = "numeric", accrualIntensity = "numeric", dropoutRate1 = "numeric", dropoutRate2 = "numeric", dropoutTime = "numeric", eventTime = "numeric", thetaH0 = "numeric", allocation1 = "numeric", allocation2 = "numeric", kappa = "numeric", piecewiseSurvivalTime = "numeric", lambda1 = "numeric", lambda2 = "numeric", earlyStop = "numeric", hazardRatio = "numeric", analysisTime = "matrix", studyDuration = "numeric", eventsNotAchieved = "matrix", numberOfSubjects = "matrix", numberOfSubjects1 = "matrix", numberOfSubjects2 = "matrix", eventsPerStage = "matrix", expectedNumberOfSubjects = "numeric", rejectPerStage = "matrix", overallReject = "numeric", conditionalPowerAchieved = "matrix" ), methods = list( initialize = function(design, ...) { callSuper(design = design, ...) generatedParams <- c( "hazardRatio", "iterations", "eventsPerStage", "singleNumberOfEventsPerStage", "expectedNumberOfEvents", "eventsNotAchieved", "numberOfSubjects", "expectedNumberOfSubjects", "overallReject", "rejectPerStage", "futilityPerStage", "earlyStop", "analysisTime", "studyDuration", "allocationRatioPlanned") if (design$kMax > 2) { generatedParams <- c(generatedParams, "futilityStop") } for (generatedParam in generatedParams) { .setParameterType(generatedParam, C_PARAM_GENERATED) } .setParameterType("numberOfSubjects1", C_PARAM_NOT_APPLICABLE) .setParameterType("numberOfSubjects2", C_PARAM_NOT_APPLICABLE) .setParameterType("median1", C_PARAM_NOT_APPLICABLE) .setParameterType("median2", C_PARAM_NOT_APPLICABLE) } ) ) #' #' @name SimulationResultsMultiArmSurvival #' #' @title #' Class for Simulation Results Multi-Arm Survival #' #' @description #' A class for simulation results survival in multi-arm designs. #' #' @details #' Use \code{\link{getSimulationMultiArmSurvival}} to create an object of this type. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_design.R #' @include f_core_constants.R #' @include class_time.R #' @include f_simulation_base_survival.R #' #' @keywords internal #' #' @importFrom methods new #' SimulationResultsMultiArmSurvival <- setRefClass("SimulationResultsMultiArmSurvival", contains = "SimulationResultsBaseSurvival", fields = list( activeArms = "integer", effectMatrix = "matrix", typeOfShape = "character", omegaMaxVector = "numeric", gED50 = "numeric", slope = "numeric", intersectionTest = "character", adaptations = "logical", typeOfSelection = "character", effectMeasure = "character", successCriterion = "character", epsilonValue = "numeric", rValue = "numeric", threshold = "numeric", selectArmsFunction = "function", correlationComputation = "character", earlyStop = "matrix", selectedArms = "array", numberOfActiveArms = "matrix", rejectAtLeastOne = "numeric", rejectedArmsPerStage = "array", successPerStage = "matrix", eventsPerStage = "array", singleNumberOfEventsPerStage = "array", conditionalPowerAchieved = "matrix" ), methods = list( initialize = function(design, ...) { callSuper(design = design, ...) for (generatedParam in c( "rejectAtLeastOne", "selectedArms", "numberOfActiveArms", "rejectedArmsPerStage", "successPerStage")) { .setParameterType(generatedParam, C_PARAM_GENERATED) } } ) ) #' #' @name SimulationResultsEnrichmentMeans #' #' @title #' Class for Simulation Results Enrichment Means #' #' @description #' A class for simulation results means in enrichment designs. #' #' @details #' Use \code{\link{getSimulationEnrichmentMeans}} to create an object of this type. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_design.R #' @include f_core_constants.R #' @include class_time.R #' @include f_simulation_base_survival.R #' @include class_simulation_results.R #' #' @keywords internal #' #' @importFrom methods new #' SimulationResultsEnrichmentMeans <- setRefClass("SimulationResultsEnrichmentMeans", contains = "SimulationResultsBaseMeans", fields = list( populations = "integer", effectList = "list", intersectionTest = "character", stratifiedAnalysis = "logical", adaptations = "logical", typeOfSelection = "character", effectMeasure = "character", successCriterion = "character", epsilonValue = "numeric", rValue = "numeric", threshold = "numeric", selectPopulationsFunction = "function", earlyStop = "matrix", selectedPopulations = "array", numberOfPopulations = "matrix", rejectAtLeastOne = "numeric", rejectedPopulationsPerStage = "array", successPerStage = "matrix", sampleSizes = "array", conditionalPowerAchieved = "matrix" ), methods = list( initialize = function(design, ...) { callSuper(design = design, ...) for (generatedParam in c( "rejectAtLeastOne", "selectedPopulations", "numberOfPopulations", "rejectedPopulationsPerStage", "successPerStage")) { .setParameterType(generatedParam, C_PARAM_GENERATED) } } ) ) #' #' @name SimulationResultsEnrichmentRates #' #' @title #' Class for Simulation Results Enrichment Rates #' #' @description #' A class for simulation results rates in enrichment designs. #' #' @details #' Use \code{\link{getSimulationEnrichmentRates}} to create an object of this type. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_design.R #' @include f_core_constants.R #' @include class_time.R #' @include f_simulation_base_survival.R #' @include class_simulation_results.R #' #' @keywords internal #' #' @importFrom methods new #' SimulationResultsEnrichmentRates <- setRefClass("SimulationResultsEnrichmentRates", contains = "SimulationResultsBaseRates", fields = list( populations = "integer", effectList = "list", intersectionTest = "character", stratifiedAnalysis = "logical", adaptations = "logical", piTreatmentH1 = "numeric", piControlH1 = "numeric", typeOfSelection = "character", effectMeasure = "character", successCriterion = "character", epsilonValue = "numeric", rValue = "numeric", threshold = "numeric", selectArmsFunction = "function", earlyStop = "matrix", selectedPopulations = "array", numberOfPopulations = "matrix", rejectAtLeastOne = "numeric", rejectedPopulationsPerStage = "array", successPerStage = "matrix", sampleSizes = "array", conditionalPowerAchieved = "matrix" ), methods = list( initialize = function(design, ...) { callSuper(design = design, ...) for (generatedParam in c( "rejectAtLeastOne", "selectedPopulations", "numberOfPopulations", "rejectedPopulationsPerStage", "successPerStage")) { .setParameterType(generatedParam, C_PARAM_GENERATED) } } ) ) #' #' @name SimulationResultsEnrichmentSurvival #' #' @title #' Class for Simulation Results Enrichment Survival #' #' @description #' A class for simulation results survival in enrichment designs. #' #' @details #' Use \code{\link{getSimulationEnrichmentSurvival}} to create an object of this type. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_design.R #' @include f_core_constants.R #' @include class_time.R #' @include f_simulation_base_survival.R #' @include class_simulation_results.R #' #' @keywords internal #' #' @importFrom methods new #' SimulationResultsEnrichmentSurvival <- setRefClass("SimulationResultsEnrichmentSurvival", contains = "SimulationResultsBaseSurvival", fields = list( populations = "integer", effectList = "list", intersectionTest = "character", stratifiedAnalysis = "logical", adaptations = "logical", typeOfSelection = "character", effectMeasure = "character", successCriterion = "character", epsilonValue = "numeric", rValue = "numeric", threshold = "numeric", selectArmsFunction = "function", correlationComputation = "character", earlyStop = "matrix", selectedPopulations = "array", numberOfPopulations = "matrix", rejectAtLeastOne = "numeric", rejectedPopulationsPerStage = "array", successPerStage = "matrix", eventsPerStage = "array", singleNumberOfEventsPerStage = "array", conditionalPowerAchieved = "matrix" ), methods = list( initialize = function(design, ...) { callSuper(design = design, ...) for (generatedParam in c( "rejectAtLeastOne", "selectedPopulations", "numberOfPopulations", "rejectedPopulationsPerStage", "successPerStage")) { .setParameterType(generatedParam, C_PARAM_GENERATED) } } ) ) .assertIsValidVariedParameterVectorForSimulationResultsPlotting <- function(simulationResults, plotType) { if (inherits(simulationResults, "SimulationResultsMeans")) { if (is.null(simulationResults$alternative) || any(is.na(simulationResults$alternative)) || length(simulationResults$alternative) <= 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, " is only available if 'alternative' with length > 1 is defined") } } else if (inherits(simulationResults, "SimulationResultsRates")) { if (is.null(simulationResults$pi1) || any(is.na(simulationResults$pi1)) || length(simulationResults$pi1) <= 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, " is only available if 'pi1' with length > 1 is defined") } } else if (inherits(simulationResults, "SimulationResultsSurvival")) { if (is.null(simulationResults$hazardRatio) || any(is.na(simulationResults$hazardRatio)) || length(simulationResults$hazardRatio) <= 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, " is only available if 'hazardRatio' with length > 1 is defined or derived") } if (length(simulationResults$hazardRatio) != length(simulationResults$overallReject)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, " is not available for piecewise survival (only type 13 and 14)") } } } .getSimulationPlotXAxisParameterName <- function(simulationResults, showSource = FALSE, simulationResultsName = NA_character_) { if (grepl("SimulationResultsEnrichment", class(simulationResults))) { effectDataList <- .getSimulationEnrichmentEffectData(simulationResults) if (ncol(effectDataList$effectData) == 1) { if (showSource) { return(paste0(simulationResultsName, "$effectList$", effectDataList$effectMatrixName, "[, 1]")) } return(sub("s$", "", effectDataList$effectMatrixName)) } if (showSource) { numberOfSituations <- nrow(simulationResults$effectList[[effectDataList$effectMatrixName]]) return(paste0("c(1:", numberOfSituations, ")")) } return("situation") } survivalEnabled <- grepl("Survival", class(simulationResults)) meansEnabled <- grepl("Means", class(simulationResults)) if (grepl("MultiArm", class(simulationResults))) { if (showSource) { gMax <- nrow(simulationResults$effectMatrix) return(paste0(simulationResultsName, "$effectMatrix[", gMax, ", ]")) } return("effectMatrix") } if (grepl("Survival", class(simulationResults))) { return("hazardRatio") } return("effect") } .getSimulationPlotXAxisLabel <- function(simulationResults, xlab = NULL) { if (grepl("SimulationResultsEnrichment", class(simulationResults))) { effectDataList <- .getSimulationEnrichmentEffectData(simulationResults) if (ncol(effectDataList$effectData) == 1) { xLabel <- simulationResults$.parameterNames[[effectDataList$effectMatrixName]] return(sub("s$", "", xLabel)) } return("Situation") } multiArmEnabled <- grepl("MultiArm", class(simulationResults)) userDefinedEffectMatrix <- multiArmEnabled && simulationResults$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED if (!is.null(xlab) && !is.na(xlab)) { return(xlab) } if (!multiArmEnabled) { return("Effect") } return(ifelse(userDefinedEffectMatrix, "Effect Matrix Row", "Maximum Effect")) } .getPowerAndStoppingProbabilities <- function(simulationResults, xValues, parameters) { yParameterNames <- c() if ("expectedNumberOfEvents" %in% parameters) { yParameterNames <- c(yParameterNames, "expectedNumberOfEvents") } if ("expectedNumberOfSubjects" %in% parameters) { yParameterNames <- c(yParameterNames, "expectedNumberOfSubjects") } if ("rejectAtLeastOne" %in% parameters) { yParameterNames <- c(yParameterNames, "rejectAtLeastOne") } if ("futilityStop" %in% parameters) { yParameterNames <- c(yParameterNames, "futilityStop") } yParameterNamesSrc <- yParameterNames data <- NULL for (yParameterName in yParameterNames) { category <- simulationResults$.parameterNames[[yParameterName]] part <- data.frame( categories = rep(category, length(xValues)), xValues = xValues, yValues = simulationResults[[yParameterName]] ) if (is.null(data)) { data <- part } else { data <- rbind(data, part) } } if ("earlyStop" %in% parameters) { yParameterNames <- c(yParameterNames, "earlyStop") maxEarlyStoppingStages <- nrow(simulationResults$earlyStop) for (k in 1:maxEarlyStoppingStages) { category <- "Early stop" if (maxEarlyStoppingStages > 1) { category <- paste0(category, ", stage ", k) } part <- data.frame( categories = rep(category, ncol(simulationResults$earlyStop)), xValues = xValues, yValues = simulationResults$earlyStop[k, ] ) data <- rbind(data, part) yParameterNamesSrc <- c(yParameterNamesSrc, paste0("earlyStop[", k, ", ]")) } } return(list( data = data, yParameterNames = yParameterNames, yParameterNamesSrc = yParameterNamesSrc )) } .plotSimulationResults <- function(simulationResults, designMaster, type = 5L, main = NA_character_, xlab = NA_character_, ylab = NA_character_, palette = "Set1", theta = seq(-1, 1, 0.02), plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, simulationResultsName = NA_character_, plotSettings = NULL, ...) { .assertGgplotIsInstalled() .assertIsSimulationResults(simulationResults) .assertIsValidLegendPosition(legendPosition) .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) theta <- .assertIsValidThetaRange(thetaRange = theta) if (is.null(plotSettings)) { plotSettings <- simulationResults$.plotSettings } survivalEnabled <- grepl("Survival", class(simulationResults)) meansEnabled <- grepl("Means", class(simulationResults)) multiArmEnabled <- grepl("MultiArm", class(simulationResults)) enrichmentEnabled <- grepl("Enrichment", class(simulationResults)) userDefinedEffectMatrix <- multiArmEnabled && simulationResults$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED gMax <- NA_integer_ if (multiArmEnabled || enrichmentEnabled) { gMax <- ifelse(multiArmEnabled, simulationResults$activeArms, simulationResults$populations) } if (survivalEnabled) { nMax <- simulationResults$expectedNumberOfEvents[1] # use first value for plotting } else { nMax <- simulationResults$expectedNumberOfSubjects[1] # use first value for plotting } if (type %in% c(1:3) && !multiArmEnabled && !enrichmentEnabled) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not available for non-multi-arm/non-enrichment simulation results (type must be > 3)") } if ((!survivalEnabled || multiArmEnabled || enrichmentEnabled) && type %in% c(10:14)) { if (multiArmEnabled || enrichmentEnabled) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is only available for non-multi-arm/non-enrichment survival simulation results") } else { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is only available for survival simulation results") } } variedParameters <- logical(0) if (is.na(plotPointsEnabled)) { plotPointsEnabled <- userDefinedEffectMatrix } showSourceHint <- "" discreteXAxis <- FALSE effectData <- NULL xValues <- NA_integer_ if (multiArmEnabled) { effectData <- simulationResults$effectMatrix effectDataParamName <- paste0("effectMatrix", "[", gMax, ", ]") xParameterNameSrc <- paste0(simulationResultsName, "$", effectDataParamName) xValues <- effectData[gMax, ] } else { if (enrichmentEnabled) { effectDataList <- .getSimulationEnrichmentEffectData(simulationResults) xValues <- effectDataList$xValues discreteXAxis <- effectDataList$discreteXAxis if (length(xValues) <= 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "2 ore more situations must be specifed in ", sQuote(paste0("effectList$", effectDataList$effectMatrixName))) } } xParameterNameSrc <- .getSimulationPlotXAxisParameterName(simulationResults, showSource = showSource, simulationResultsName = simulationResultsName) } armCaption <- ifelse(enrichmentEnabled, "Population", "Arm") armsCaption <- paste0(armCaption, "s") srcCmd <- NULL if (type == 1) { # Multi-arm, Overall Success .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { main <- PlotSubTitleItems(title = "Overall Success") .addPlotSubTitleItems(simulationResults, designMaster, main, type) } data <- data.frame( xValues = xValues, yValues = colSums(simulationResults$successPerStage) ) if (userDefinedEffectMatrix) { data$xValues <- 1:nrow(data) } legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_CENTER, legendPosition) srcCmd <- .showPlotSourceInformation(objectName = simulationResultsName, xParameterName = xParameterNameSrc, yParameterNames = paste0("colSums(", simulationResultsName, "$successPerStage)"), hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) if (!is.null(srcCmd)) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(srcCmd)) } return(srcCmd) } return(.plotDataFrame(data, mainTitle = main, xlab = NA_character_, ylab = NA_character_, xAxisLabel = .getSimulationPlotXAxisLabel(simulationResults), yAxisLabel1 = "Overall Success", yAxisLabel2 = NA_character_, plotPointsEnabled = plotPointsEnabled, legendTitle = NA_character_, legendPosition = legendPosition, sided = designMaster$sided, palette = palette, plotSettings = plotSettings, discreteXAxis = discreteXAxis)) } else if (type == 2) { # Multi-arm, Success per Stage .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { main <- PlotSubTitleItems(title = "Success per Stage") .addPlotSubTitleItems(simulationResults, designMaster, main, type) } yParameterNamesSrc <- c() data <- NULL if (designMaster$kMax > 1) { for (k in 1:designMaster$kMax) { part <- data.frame( categories = rep(k, length(xValues)), xValues = xValues, yValues = simulationResults$successPerStage[k, ] ) if (userDefinedEffectMatrix) { part$xValues <- 1:nrow(part) } if (is.null(data)) { data <- part } else { data <- rbind(data, part) } yParameterNamesSrc <- c(yParameterNamesSrc, paste0("successPerStage[", k, ", ]")) } } else { data <- data.frame( xValues = xValues, yValues = simulationResults$successPerStage[1, ] ) if (userDefinedEffectMatrix) { data$xValues <- 1:nrow(data) } yParameterNamesSrc <- c(yParameterNamesSrc, "successPerStage[1, ]") } legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_TOP, legendPosition) srcCmd <- .showPlotSourceInformation(objectName = simulationResultsName, xParameterName = xParameterNameSrc, yParameterNames = yParameterNamesSrc, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) if (!is.null(srcCmd)) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(srcCmd)) } return(srcCmd) } return(.plotDataFrame(data, mainTitle = main, xlab = NA_character_, ylab = NA_character_, xAxisLabel = .getSimulationPlotXAxisLabel(simulationResults), yAxisLabel1 = "Success", yAxisLabel2 = NA_character_, plotPointsEnabled = plotPointsEnabled, legendTitle = "Stage", legendPosition = legendPosition, sided = designMaster$sided, palette = palette, plotSettings = plotSettings, discreteXAxis = discreteXAxis)) } else if (type == 3) { # Multi-arm, Selected Arms/Populations per Stage .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { main <- PlotSubTitleItems(title = paste0("Selected ", armsCaption, " per Stage")) .addPlotSubTitleItems(simulationResults, designMaster, main, type) } selectedDataParamName <- ifelse(multiArmEnabled, "selectedArms", "selectedPopulations") selectedData <- simulationResults[[selectedDataParamName]] yParameterNamesSrc <- c() data <- NULL if (designMaster$kMax > 1) { for (g in 1:gMax) { for (k in 2:designMaster$kMax) { stages <- rep(k, length(xValues)) populationCaption <- g if (enrichmentEnabled) { populationCaption <- ifelse(g == gMax, "F", paste0("S", g)) } part <- data.frame( categories = ifelse(designMaster$kMax > 2, paste0(populationCaption, ", ", stages), populationCaption), xValues = xValues, yValues = selectedData[k, , g] ) if (userDefinedEffectMatrix) { part$xValues <- 1:nrow(part) } if (is.null(data)) { data <- part } else { data <- rbind(data, part) } yParameterNamesSrc <- c(yParameterNamesSrc, paste0(selectedDataParamName, "[", k, ", , ", g, "]")) } } } else { for (g in 1:gMax) { part <- data.frame( categories = g, xValues = xValues, yValues = selectedData[1, , g] ) if (userDefinedEffectMatrix) { data$xValues <- 1:nrow(data) } if (is.null(data)) { data <- part } else { data <- rbind(data, part) } yParameterNamesSrc <- c(yParameterNamesSrc, paste0(selectedDataParamName, "[1, , ", g, "]")) } } legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_TOP, legendPosition) srcCmd <- .showPlotSourceInformation(objectName = simulationResultsName, xParameterName = xParameterNameSrc, yParameterNames = yParameterNamesSrc, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) if (!is.null(srcCmd)) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(srcCmd)) } return(srcCmd) } legendTitle <- ifelse(gMax > 1, ifelse(designMaster$kMax > 2, paste0(armCaption, ", Stage"), armCaption), ifelse(designMaster$kMax > 2, "Stage", armCaption)) return(.plotDataFrame(data, mainTitle = main, xlab = NA_character_, ylab = NA_character_, xAxisLabel = .getSimulationPlotXAxisLabel(simulationResults), yAxisLabel1 = paste0("Selected ", armsCaption), yAxisLabel2 = NA_character_, plotPointsEnabled = plotPointsEnabled, legendTitle = legendTitle, legendPosition = legendPosition, sided = designMaster$sided, palette = palette, plotSettings = plotSettings, discreteXAxis = discreteXAxis)) } else if (type == 4) { # Multi-arm, Rejected Arms/Populations per Stage .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { main <- PlotSubTitleItems(title = ifelse(!multiArmEnabled, "Reject per Stage", ifelse(designMaster$kMax > 1, paste0("Rejected ", armsCaption, " per Stage"), paste0("Rejected ", armsCaption)))) .addPlotSubTitleItems(simulationResults, designMaster, main, type) } yParameterNamesSrc <- c() data <- NULL if (multiArmEnabled || enrichmentEnabled) { rejectedDataParamName <- ifelse(multiArmEnabled, "rejectedArmsPerStage", "rejectedPopulationsPerStage") rejectedData <- simulationResults[[rejectedDataParamName]] if (designMaster$kMax > 1) { for (g in 1:gMax) { for (k in 1:designMaster$kMax) { stages <- rep(k, length(xValues)) populationCaption <- g if (enrichmentEnabled) { populationCaption <- ifelse(g == gMax, "F", paste0("S", g)) } part <- data.frame( categories = ifelse(gMax > 1, paste0(populationCaption, ", ", stages), stages), xValues = xValues, yValues = rejectedData[k, , g] ) if (userDefinedEffectMatrix) { part$xValues <- 1:nrow(part) } if (is.null(data)) { data <- part } else { data <- rbind(data, part) } yParameterNamesSrc <- c(yParameterNamesSrc, paste0(rejectedDataParamName, "[", k, ", , ", g, "]")) } } } else { for (g in 1:gMax) { part <- data.frame( categories = g, xValues = xValues, yValues = rejectedData[1, , g] ) if (userDefinedEffectMatrix) { part$xValues <- 1:nrow(part) } if (is.null(data)) { data <- part } else { data <- rbind(data, part) } yParameterNamesSrc <- c(yParameterNamesSrc, paste0(rejectedDataParamName, "[1, , ", g, "]")) } } } else { xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) if (designMaster$kMax > 1) { for (k in 1:designMaster$kMax) { part <- data.frame( categories = k, xValues = simulationResults[[xParameterName]], yValues = simulationResults$rejectPerStage[k, ] ) if (userDefinedEffectMatrix) { part$xValues <- 1:nrow(part) } if (is.null(data)) { data <- part } else { data <- rbind(data, part) } yParameterNamesSrc <- c(yParameterNamesSrc, paste0("rejectPerStage[", k, ", ]")) } } else { data <- data.frame( xValues = simulationResults[[xParameterName]], yValues = simulationResults$rejectPerStage[1, ] ) if (userDefinedEffectMatrix) { data$xValues <- 1:nrow(data) } yParameterNamesSrc <- c(yParameterNamesSrc, "rejectPerStage[1, ]") } } legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_TOP, legendPosition) srcCmd <- .showPlotSourceInformation(objectName = simulationResultsName, xParameterName = xParameterNameSrc, yParameterNames = yParameterNamesSrc, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) if (!is.null(srcCmd)) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(srcCmd)) } return(srcCmd) } palette <- NULL legendTitle <- "Stage" if (multiArmEnabled) { legendTitle <- ifelse(designMaster$kMax > 1, paste0(armCaption, ", Stage"), armCaption) } else if (enrichmentEnabled) { legendTitle <- ifelse(gMax > 1, paste0(armCaption, ", Stage"), "Stage") } yAxisLabel1 <- ifelse(.isMultiArmSimulationResults(simulationResults), paste0("Rejected ", armsCaption), "Rejection Probability") return(.plotDataFrame(data, mainTitle = main, xlab = NA_character_, ylab = NA_character_, xAxisLabel = .getSimulationPlotXAxisLabel(simulationResults), yAxisLabel1 = yAxisLabel1, yAxisLabel2 = NA_character_, plotPointsEnabled = plotPointsEnabled, legendTitle = legendTitle, legendPosition = legendPosition, sided = designMaster$sided, palette = palette, plotSettings = plotSettings, discreteXAxis = discreteXAxis)) } else if (type == 5) { # Power and Stopping Probabilities .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { main <- PlotSubTitleItems(title = ifelse(designMaster$kMax == 1, "Overall Power", "Overall Power and Early Stopping")) .addPlotSubTitleItems(simulationResults, designMaster, main, type) } xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) if ((multiArmEnabled || enrichmentEnabled) && designMaster$kMax > 1) { powerAndStoppingProbabilities <- .getPowerAndStoppingProbabilities(simulationResults, xValues = xValues, parameters = c("rejectAtLeastOne", "futilityStop", "earlyStop")) data <- powerAndStoppingProbabilities$data yParameterNames <- powerAndStoppingProbabilities$yParameterNames yParameterNamesSrc <- powerAndStoppingProbabilities$yParameterNamesSrc } else { yParameterNames <- ifelse(multiArmEnabled || enrichmentEnabled, "rejectAtLeastOne", "overallReject") if (designMaster$kMax > 1) { if (!multiArmEnabled && !enrichmentEnabled) { yParameterNames <- c(yParameterNames, "earlyStop") } yParameterNames <- c(yParameterNames, "futilityStop") } yParameterNamesSrc <- yParameterNames } xlab <- .getSimulationPlotXAxisLabel(simulationResults, xlab) ylab <- ifelse(is.na(ylab), "", ylab) legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_TOP, legendPosition) srcCmd <- .showPlotSourceInformation(objectName = simulationResultsName, xParameterName = xParameterNameSrc, yParameterNames = yParameterNamesSrc, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) if (!is.null(srcCmd)) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(srcCmd)) } return(srcCmd) } if ((multiArmEnabled || enrichmentEnabled) && designMaster$kMax > 1) { return(.plotDataFrame(data, mainTitle = main, xlab = xlab, ylab = ylab, xAxisLabel = .getSimulationPlotXAxisLabel(simulationResults), yAxisLabel1 = NA_character_, yAxisLabel2 = NA_character_, plotPointsEnabled = plotPointsEnabled, legendTitle = NA_character_, legendPosition = legendPosition, sided = designMaster$sided, palette = palette, plotSettings = plotSettings, discreteXAxis = discreteXAxis)) } else { if (is.null(list(...)[["ylim"]])) { ylim <- c(0, 1) return(.plotParameterSet(parameterSet = simulationResults, designMaster = designMaster, xParameterName = xParameterName, yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, variedParameters = variedParameters, qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, plotSettings = plotSettings, ylim = ylim, ...)) # ratioEnabled = TRUE } else { return(.plotParameterSet(parameterSet = simulationResults, designMaster = designMaster, xParameterName = xParameterName, yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, variedParameters = variedParameters, qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, plotSettings = plotSettings, ...)) } } } else if (type == 6) { # Average Sample Size / Average Event Number .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { titlePart <- paste0("Expected ", ifelse(survivalEnabled, "Number of Events", "Number of Subjects")) main <- PlotSubTitleItems(title = paste0(titlePart, ifelse(designMaster$kMax == 1, "", paste0(" and Power", ifelse(multiArmEnabled, "", " / Early Stop"))))) .addPlotSubTitleItems(simulationResults, designMaster, main, type) } xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) yParameterNames <- ifelse(survivalEnabled, "expectedNumberOfEvents", "expectedNumberOfSubjects") if (designMaster$kMax > 1) { if (multiArmEnabled || enrichmentEnabled) { yParameterNames <- c(yParameterNames, "rejectAtLeastOne") } else { yParameterNames <- c(yParameterNames, "overallReject") } yParameterNames <- c(yParameterNames, "earlyStop") } xlab <- .getSimulationPlotXAxisLabel(simulationResults, xlab) legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_CENTER, legendPosition) srcCmd <- .showPlotSourceInformation(objectName = simulationResultsName, xParameterName = xParameterNameSrc, yParameterNames = yParameterNames, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) } else if (type == 7) { .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { main <- PlotSubTitleItems(title = "Overall Power") .addPlotSubTitleItems(simulationResults, designMaster, main, type) } xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) yParameterNames <- ifelse(multiArmEnabled || enrichmentEnabled, "rejectAtLeastOne", "overallReject") xlab <- .getSimulationPlotXAxisLabel(simulationResults, xlab) legendPosition <- ifelse(is.na(legendPosition), C_POSITION_RIGHT_CENTER, legendPosition) srcCmd <- .showPlotSourceInformation(objectName = simulationResultsName, xParameterName = xParameterNameSrc, yParameterNames = yParameterNames, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) } else if (type == 8) { if (designMaster$kMax == 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type 8 (Early Stopping) is not available for 'kMax' = 1") } .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) futilityStopEnabled <- !is.null(simulationResults[["futilityStop"]]) && !all(na.omit(simulationResults$futilityStop) == 0) if (is.na(main)) { main <- PlotSubTitleItems(title = paste0("Overall Early Stopping", ifelse(futilityStopEnabled, " and Futility Stopping", ""))) .addPlotSubTitleItems(simulationResults, designMaster, main, type) } xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) yParameterNames <- c("earlyStop") if (futilityStopEnabled) { yParameterNames <- c(yParameterNames, "futilityStop") } xlab <- .getSimulationPlotXAxisLabel(simulationResults, xlab) legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_CENTER, legendPosition) srcCmd <- .showPlotSourceInformation(objectName = simulationResultsName, xParameterName = xParameterNameSrc, yParameterNames = yParameterNames, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) } else if (type == 9) { .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { main <- PlotSubTitleItems(title = ifelse(survivalEnabled, "Expected Number of Events", "Expected Number of Subjects")) .addPlotSubTitleItems(simulationResults, designMaster, main, type) } xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) yParameterNames <- ifelse(survivalEnabled, "expectedNumberOfEvents", "expectedNumberOfSubjects") xlab <- .getSimulationPlotXAxisLabel(simulationResults, xlab) srcCmd <- .showPlotSourceInformation(objectName = simulationResultsName, xParameterName = xParameterNameSrc, yParameterNames = yParameterNames, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) } else if (type == 10) { # Study Duration .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { main <- PlotSubTitleItems(title = "Study Duration") .addPlotSubTitleItems(simulationResults, designMaster, main, type) } xParameterName <- "hazardRatio" yParameterNames <- "studyDuration" srcCmd <- .showPlotSourceInformation(objectName = simulationResultsName, xParameterName = xParameterName, yParameterNames = yParameterNames, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) } else if (type == 11) { .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { main <- PlotSubTitleItems(title = "Expected Number of Subjects") .addPlotSubTitleItems(simulationResults, designMaster, main, type) } xParameterName <- "hazardRatio" yParameterNames <- "expectedNumberOfSubjects" srcCmd <- .showPlotSourceInformation(objectName = simulationResultsName, xParameterName = xParameterName, yParameterNames = yParameterNames, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) } else if (type == 12) { # Analysis Time .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { main <- PlotSubTitleItems(title = "Analysis Time") .addPlotSubTitleItems(simulationResults, designMaster, main, type) } xParameterName <- "hazardRatio" yParameterNames <- "analysisTime" yParameterNamesSrc <- c() for (i in 1:nrow(simulationResults[["analysisTime"]])) { yParameterNamesSrc <- c(yParameterNamesSrc, paste0("analysisTime[", i, ", ]")) } data <- NULL for (k in 1:designMaster$kMax) { part <- data.frame( categories = rep(k, length(simulationResults$hazardRatio)), xValues = simulationResults$hazardRatio, yValues = simulationResults$analysisTime[k, ] ) if (is.null(data)) { data <- part } else { data <- rbind(data, part) } } if (is.na(legendPosition)) { legendPosition <- C_POSITION_LEFT_CENTER } srcCmd <- .showPlotSourceInformation(objectName = simulationResultsName, xParameterName = xParameterName, yParameterNames = yParameterNamesSrc, hint = showSourceHint, nMax = nMax, type = type, showSource = showSource) if (!is.null(srcCmd)) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(srcCmd)) } return(srcCmd) } return(.plotDataFrame(data, mainTitle = main, xlab = NA_character_, ylab = NA_character_, xAxisLabel = "Hazard Ratio", yAxisLabel1 = "Analysis Time", yAxisLabel2 = NA_character_, plotPointsEnabled = TRUE, legendTitle = "Stage", legendPosition = legendPosition, sided = designMaster$sided, plotSettings = plotSettings, discreteXAxis = discreteXAxis)) } else if (type == 13 || type == 14) { # Cumulative Distribution Function / Survival function return(.plotSurvivalFunction(simulationResults, designMaster = designMaster, type = type, main = main, xlab = xlab, ylab = ylab, palette = palette, legendPosition = legendPosition, designPlanName = simulationResultsName, showSource = showSource, plotSettings = plotSettings)) } else { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 5, 6, ..., 14") } if (!is.null(srcCmd)) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(srcCmd)) } return(srcCmd) } return(.plotParameterSet(parameterSet = simulationResults, designMaster = designMaster, xParameterName = xParameterName, yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, variedParameters = variedParameters, qnormAlphaLineEnabled = (type != 2), ratioEnabled = TRUE, plotSettings = plotSettings, ...)) } #' #' @title #' Simulation Results Plotting #' #' @param x The simulation results, obtained from \cr #' \code{\link{getSimulationSurvival}}. #' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). #' @param main The main title. #' @param xlab The x-axis label. #' @param ylab The y-axis label. #' @inheritParams param_palette #' @inheritParams param_theta #' @inheritParams param_plotPointsEnabled #' @inheritParams param_showSource #' @inheritParams param_plotSettings #' @inheritParams param_legendPosition #' @inheritParams param_grid #' @param type The plot type (default = \code{1}). The following plot types are available: #' \itemize{ #' \item \code{1}: creates a 'Overall Success' plot (multi-arm only) #' \item \code{2}: creates a 'Success per Stage' plot (multi-arm only) #' \item \code{3}: creates a 'Selected Arms per Stage' plot (multi-arm only) #' \item \code{4}: creates a 'Reject per Stage' or 'Rejected Arms per Stage' plot #' \item \code{5}: creates a 'Overall Power and Early Stopping' plot #' \item \code{6}: creates a 'Expected Number of Subjects and Power / Early Stop' or #' 'Expected Number of Events and Power / Early Stop' plot #' \item \code{7}: creates an 'Overall Power' plot #' \item \code{8}: creates an 'Overall Early Stopping' plot #' \item \code{9}: creates an 'Expected Sample Size' or 'Expected Number of Events' plot #' \item \code{10}: creates a 'Study Duration' plot (non-multi-arm survival only) #' \item \code{11}: creates an 'Expected Number of Subjects' plot (non-multi-arm survival only) #' \item \code{12}: creates an 'Analysis Times' plot (non-multi-arm survival only) #' \item \code{13}: creates a 'Cumulative Distribution Function' plot (non-multi-arm survival only) #' \item \code{14}: creates a 'Survival Function' plot (non-multi-arm survival only) #' \item \code{"all"}: creates all available plots and returns it as a grid plot or list #' } #' @inheritParams param_three_dots_plot #' #' @description #' Plots simulation results. #' #' @details #' Generic function to plot all kinds of simulation results. #' #' @template return_object_ggplot #' #' @examples #' \donttest{ #' results <- getSimulationMeans(alternative = 0:4, stDev = 5, #' plannedSubjects = 40, maxNumberOfIterations = 1000) #' plot(results, type = 5) #' } #' #' @export #' plot.SimulationResults <- function(x, y, ..., main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", theta = seq(-1, 1, 0.01), plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, grid = 1, plotSettings = NULL) { fCall = match.call(expand.dots = FALSE) simulationResultsName <- deparse(fCall$x) .assertIsSingleInteger(grid, "grid", validateType = FALSE) typeNumbers <- .getPlotTypeNumber(type, x) if (is.null(plotSettings)) { plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) } p <- NULL plotList <- list() for (typeNumber in typeNumbers) { p <- .plotSimulationResults(simulationResults = x, designMaster = x$.design, main = main, xlab = xlab, ylab = ylab, type = typeNumber, palette = palette, theta = theta, plotPointsEnabled = plotPointsEnabled, legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), showSource = showSource, simulationResultsName = simulationResultsName, plotSettings = plotSettings, ...) .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) if (length(typeNumbers) > 1) { caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) plotList[[caption]] <- p } } if (length(typeNumbers) == 1) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(p)) } return(p) } if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(plotList)) } return(.createPlotResultObject(plotList, grid)) } #' #' @name SimulationResults_print #' #' @title #' Print Simulation Results #' #' @description #' \code{print} prints its \code{SimulationResults} argument and returns it invisibly (via \code{invisible(x)}). #' #' @param x The \code{\link{SimulationResults}} object to print. #' @param markdown If \code{TRUE}, the object \code{x} will be printed using markdown syntax; #' normal representation will be used otherwise (default is \code{FALSE}) #' @inheritParams param_three_dots #' #' @details #' Prints the parameters and results of an \code{SimulationResults} object. #' #' @export #' #' @keywords internal #' print.SimulationResults <- function(x, ..., showStatistics = FALSE, markdown = FALSE) { if (markdown) { x$.catMarkdownText(showStatistics = showStatistics) return(invisible(x)) } x$show(showStatistics = showStatistics) invisible(x) } #' #' @title #' Get Simulation Data #' #' @description #' Returns the aggregated simulation data. #' #' @param x A \code{\link{SimulationResults}} object created by \code{\link{getSimulationMeans}},\cr #' \code{\link{getSimulationRates}}, \code{\link{getSimulationSurvival}}, \code{\link{getSimulationMultiArmMeans}},\cr #' \code{\link{getSimulationMultiArmRates}}, or \code{\link{getSimulationMultiArmSurvival}}. #' #' @details #' This function can be used to get the aggregated simulated data from an simulation results #' object, for example, obtained by \code{\link{getSimulationSurvival}}. #' In this case, the data frame contains the following columns: #' \enumerate{ #' \item \code{iterationNumber}: The number of the simulation iteration. #' \item \code{stageNumber}: The stage. #' \item \code{pi1}: The assumed or derived event rate in the treatment group. #' \item \code{pi2}: The assumed or derived event rate in the control group. #' \item \code{hazardRatio}: The hazard ratio under consideration (if available). #' \item \code{analysisTime}: The analysis time. #' \item \code{numberOfSubjects}: The number of subjects under consideration when the #' (interim) analysis takes place. #' \item \code{eventsPerStage1}: The observed number of events per stage #' in treatment group 1. #' \item \code{eventsPerStage2}: The observed number of events per stage #' in treatment group 2. #' \item \code{eventsPerStage}: The observed number of events per stage #' in both treatment groups. #' \item \code{rejectPerStage}: 1 if null hypothesis can be rejected, 0 otherwise. #' \item \code{eventsNotAchieved}: 1 if number of events could not be reached with #' observed number of subjects, 0 otherwise. #' \item \code{futilityPerStage}: 1 if study should be stopped for futility, 0 otherwise. #' \item \code{testStatistic}: The test statistic that is used for the test decision, #' depends on which design was chosen (group sequential, inverse normal, #' or Fisher combination test)' #' \item \code{logRankStatistic}: Z-score statistic which corresponds to a one-sided #' log-rank test at considered stage. #' \item \code{conditionalPowerAchieved}: The conditional power for the subsequent stage of the trial for #' selected sample size and effect. The effect is either estimated from the data or can be #' user defined with \code{thetaH1} or \code{pi1H1} and \code{pi2H1}. #' \item \code{trialStop}: \code{TRUE} if study should be stopped for efficacy or futility or final stage, \code{FALSE} otherwise. #' \item \code{hazardRatioEstimateLR}: The estimated hazard ratio, derived from the #' log-rank statistic. #' } #' A subset of variables is provided for \code{\link{getSimulationMeans}}, \code{\link{getSimulationRates}}, \code{\link{getSimulationMultiArmMeans}},\cr #' \code{\link{getSimulationMultiArmRates}}, or \code{\link{getSimulationMultiArmSurvival}}. #' #' @template return_dataframe #' #' @examples #' results <- getSimulationSurvival(pi1 = seq(0.3,0.6,0.1), pi2 = 0.3, eventTime = 12, #' accrualTime = 24, plannedEvents = 40, maxNumberOfSubjects = 200, #' maxNumberOfIterations = 50) #' data <- getData(results) #' head(data) #' dim(data) #' #' @export #' getData <- function(x) { if (!inherits(x, "SimulationResults")) { # or 'Dataset' stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'x' must be a 'SimulationResults' object; for example, use getSimulationMeans() to create one") } return(x$.data) } #' @rdname getData #' @export getData.SimulationResults <- function(x) { return(x$.data) } .getAggregatedDataByIterationNumber <- function(rawData, iterationNumber, pi1 = NA_real_) { if (!is.na(pi1)) { if (is.null(rawData[["pi1"]])) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'rawData' does not contains a 'pi1' column") } subData <- rawData[rawData$iterationNumber == iterationNumber & rawData$pi1 == pi1, ] if (nrow(subData) == 0) { return(NULL) } } else { subData <- rawData[rawData$iterationNumber == iterationNumber, ] } eventsPerStage1 <- sum(subData$event[subData$treatmentGroup == 1]) eventsPerStage2 <- sum(subData$event[subData$treatmentGroup == 2]) result <- data.frame( iterationNumber = iterationNumber, pi1 = pi1, stageNumber = subData$stopStage[1], analysisTime = max(subData$observationTime), numberOfSubjects = nrow(subData), eventsPerStage1 = eventsPerStage1, eventsPerStage2 = eventsPerStage2, eventsPerStage = eventsPerStage1 + eventsPerStage2 ) if (is.na(pi1)) { result <- result[, colnames(result) != "pi1"] } return(result) } .getAggregatedData <- function(rawData) { iterationNumbers <- sort(unique(rawData$iterationNumber)) pi1Vec <- rawData[["pi1"]] if (!is.null(pi1Vec)) { pi1Vec <- sort(unique(na.omit(rawData$pi1))) } data <- NULL if (!is.null(pi1Vec) && length(pi1Vec) > 0) { for (iterationNumber in iterationNumbers) { for (pi1 in pi1Vec) { row <- .getAggregatedDataByIterationNumber(rawData, iterationNumber, pi1) if (!is.null(row)) { if (is.null(data)) { data <- row } else { data <- rbind(data, row) } } } } } else { for (iterationNumber in iterationNumbers) { row <- .getAggregatedDataByIterationNumber(rawData, iterationNumber) if (!is.null(row)) { if (is.null(data)) { data <- row } else { data <- rbind(data, row) } } } } return(data) } #' #' @title #' Get Simulation Raw Data for Survival #' #' @description #' Returns the raw survival data which was generated for simulation. #' #' @param x An \code{\link{SimulationResults}} object created by \code{\link{getSimulationSurvival}}. #' @param aggregate Logical. If \code{TRUE} the raw data will be aggregated similar to #' the result of \code{\link{getData}}, default is \code{FALSE}. #' #' @details #' This function works only if \code{\link{getSimulationSurvival}} was called with a \cr #' \code{maxNumberOfRawDatasetsPerStage} > 0 (default is \code{0}). #' #' This function can be used to get the simulated raw data from a simulation results #' object obtained by \code{\link{getSimulationSurvival}}. Note that \code{\link{getSimulationSurvival}} #' must called before with \code{maxNumberOfRawDatasetsPerStage} > 0. #' The data frame contains the following columns: #' \enumerate{ #' \item \code{iterationNumber}: The number of the simulation iteration. #' \item \code{stopStage}: The stage of stopping. #' \item \code{subjectId}: The subject id (increasing number 1, 2, 3, ...) #' \item \code{accrualTime}: The accrual time, i.e., the time when the subject entered the trial. #' \item \code{treatmentGroup}: The treatment group number (1 or 2). #' \item \code{survivalTime}: The survival time of the subject. #' \item \code{dropoutTime}: The dropout time of the subject (may be \code{NA}). #' \item \code{observationTime}: The specific observation time. #' \item \code{timeUnderObservation}: The time under observation is defined as follows:\cr #' if (event == TRUE) {\cr #' timeUnderObservation <- survivalTime;\cr #' } else if (dropoutEvent == TRUE) {\cr #' timeUnderObservation <- dropoutTime;\cr #' } else {\cr #' timeUnderObservation <- observationTime - accrualTime;\cr #' } #' \item \code{event}: \code{TRUE} if an event occurred; \code{FALSE} otherwise. #' \item \code{dropoutEvent}: \code{TRUE} if an dropout event occurred; \code{FALSE} otherwise. #' } #' #' @template return_dataframe #' #' @examples #' \donttest{ #' results <- getSimulationSurvival(pi1 = seq(0.3,0.6,0.1), pi2 = 0.3, eventTime = 12, #' accrualTime = 24, plannedEvents = 40, maxNumberOfSubjects = 200, #' maxNumberOfIterations = 50, maxNumberOfRawDatasetsPerStage = 5) #' rawData <- getRawData(results) #' head(rawData) #' dim(rawData) #' } #' #' @export #' getRawData <- function(x, aggregate = FALSE) { if (!inherits(x, "SimulationResultsSurvival")) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'x' must be a 'SimulationResultsSurvival' object; use getSimulationSurvival() to create one") } rawData <- x$.rawData if (is.null(rawData) || ncol(rawData) == 0 || nrow(rawData) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "simulation results contain no raw data; ", "choose a 'maxNumberOfRawDatasetsPerStage' > 0, e.g., ", "getSimulationSurvival(..., maxNumberOfRawDatasetsPerStage = 1)") } if (!aggregate) { return(rawData) } return(.getAggregatedData(rawData)) } rpact/R/f_analysis_multiarm_rates.R0000644000175000017500000017406114165522661017322 0ustar nileshnilesh## | ## | *Analysis of rates in multi-arm designs with adaptive test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5684 $ ## | Last changed: $Date: 2022-01-05 12:27:24 +0100 (Mi, 05 Jan 2022) $ ## | Last changed by: $Author: wassmer $ ## | # @title # Get Analysis Results Rates # # @description # Returns an analysis result object. # # @param design The trial design. # # @return Returns a \code{AnalysisResultsRates} object. # # @keywords internal # .getAnalysisResultsRatesMultiArm <- function(..., design, dataInput) { if (.isTrialDesignInverseNormal(design)) { return(.getAnalysisResultsRatesInverseNormalMultiArm( design = design, dataInput = dataInput, ... )) } if (.isTrialDesignFisher(design)) { return(.getAnalysisResultsRatesFisherMultiArm( design = design, dataInput = dataInput, ... )) } if (.isTrialDesignConditionalDunnett(design)) { return(.getAnalysisResultsRatesConditionalDunnettMultiArm( design = design, dataInput = dataInput, ... )) } .stopWithWrongDesignMessage(design) } .getAnalysisResultsRatesInverseNormalMultiArm <- function(..., design, dataInput, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, thetaH0 = C_THETA_H0_RATES_DEFAULT, piTreatments = NA_real_, piControl = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .assertIsTrialDesignInverseNormal(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsRatesInverseNormalMultiArm", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsMultiArmInverseNormal(design = design, dataInput = dataInput) results <- .getAnalysisResultsRatesMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, thetaH0 = thetaH0, piTreatments = piTreatments, piControl = piControl, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance ) return(results) } .getAnalysisResultsRatesFisherMultiArm <- function(..., design, dataInput, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, thetaH0 = C_THETA_H0_RATES_DEFAULT, piTreatments = NA_real_, piControl = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsRatesFisherMultiArm", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsMultiArmFisher(design = design, dataInput = dataInput) results <- .getAnalysisResultsRatesMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, thetaH0 = thetaH0, piTreatments = piTreatments, piControl = piControl, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance, iterations = iterations, seed = seed ) return(results) } .getAnalysisResultsRatesConditionalDunnettMultiArm <- function(..., design, dataInput, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, thetaH0 = C_THETA_H0_RATES_DEFAULT, piTreatments = NA_real_, piControl = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .assertIsTrialDesignConditionalDunnett(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsRatesConditionalDunnettMultiArm", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsConditionalDunnett(design = design, dataInput = dataInput) results <- .getAnalysisResultsRatesMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, thetaH0 = thetaH0, piTreatments = piTreatments, piControl = piControl, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance, iterations = iterations, seed = seed ) return(results) } .getAnalysisResultsRatesMultiArmAll <- function(..., results, design, dataInput, intersectionTest, stage, directionUpper, normalApproximation, thetaH0, piTreatments, piControl, nPlanned, allocationRatioPlanned, tolerance, iterations, seed) { startTime <- Sys.time() intersectionTest <- .getCorrectedIntersectionTestMultiArmIfNecessary(design, intersectionTest) stageResults <- .getStageResultsRatesMultiArm( design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation ) results$.setStageResults(stageResults) .logProgress("Stage results calculated", startTime = startTime) gMax <- stageResults$getGMax() piControl <- .assertIsValidPiControlForMultiArm(piControl, stageResults, stage, results = results) piTreatments <- .assertIsValidPiTreatmentsForMultiArm(piTreatments, stageResults, stage, results = results) .setValueAndParameterType( results, "intersectionTest", intersectionTest, C_INTERSECTION_TEST_MULTIARMED_DEFAULT ) .setValueAndParameterType(results, "directionUpper", directionUpper, C_DIRECTION_UPPER_DEFAULT) .setValueAndParameterType( results, "normalApproximation", normalApproximation, C_NORMAL_APPROXIMATION_RATES_DEFAULT ) .setValueAndParameterType(results, "thetaH0", thetaH0, C_THETA_H0_MEANS_DEFAULT) .setConditionalPowerArguments(results, dataInput, nPlanned, allocationRatioPlanned) .setNPlannedAndPi(results, nPlanned, "piControl", piControl, piTreatments) if (results$.getParameterType("piControl") %in% c(C_PARAM_TYPE_UNKNOWN, C_PARAM_NOT_APPLICABLE)) { .setValueAndParameterType( results, "piControl", matrix(piControl, ncol = 1), matrix(rep(NA_real_, gMax), ncol = 1) ) } else { results$piControl <- matrix(piControl, ncol = 1) } if (results$.getParameterType("piTreatments") %in% c(C_PARAM_TYPE_UNKNOWN, C_PARAM_NOT_APPLICABLE)) { .setValueAndParameterType( results, "piTreatments", matrix(piTreatments, ncol = 1), matrix(rep(NA_real_, gMax), ncol = 1) ) } else { results$piTreatments <- matrix(piTreatments, ncol = 1) } startTime <- Sys.time() if (!.isTrialDesignConditionalDunnett(design)) { results$.closedTestResults <- getClosedCombinationTestResults(stageResults = stageResults) } else { results$.closedTestResults <- getClosedConditionalDunnettTestResults( stageResults = stageResults, design = design, stage = stage ) } .logProgress("Closed test calculated", startTime = startTime) if (design$kMax > 1) { # conditional power startTime <- Sys.time() if (.isTrialDesignFisher(design)) { conditionalPowerResults <- .getConditionalPowerRatesMultiArm( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, piTreatments = piTreatments, piControl = piControl, iterations = iterations, seed = seed ) if (conditionalPowerResults$simulated) { results$conditionalPowerSimulated <- conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalPowerSimulated", C_PARAM_GENERATED) } else { results$conditionalPower <- conditionalPowerResults$conditionalPower results$conditionalPowerSimulated <- matrix(numeric(0)) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$.setParameterType("conditionalPowerSimulated", C_PARAM_NOT_APPLICABLE) } } else { conditionalPowerResults <- .getConditionalPowerRatesMultiArm( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, piTreatments = piTreatments, piControl = piControl ) results$conditionalPower <- conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_GENERATED) } results$.conditionalPowerResults <- conditionalPowerResults .logProgress("Conditional power calculated", startTime = startTime) # CRP - conditional rejection probabilities startTime <- Sys.time() results$conditionalRejectionProbabilities <- .getConditionalRejectionProbabilitiesMultiArm( stageResults = stageResults, stage = stage ) results$.setParameterType("conditionalRejectionProbabilities", C_PARAM_GENERATED) .logProgress("Conditional rejection probabilities (CRP) calculated", startTime = startTime) } else { results$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalPowerSimulated", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalRejectionProbabilities", C_PARAM_NOT_APPLICABLE) } # RCI - repeated confidence interval repeatedConfidenceIntervals <- .getRepeatedConfidenceIntervalsRatesMultiArm( design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, normalApproximation = normalApproximation, tolerance = tolerance ) results$repeatedConfidenceIntervalLowerBounds <- matrix(rep(NA_real_, gMax * design$kMax), nrow = gMax, ncol = design$kMax) results$repeatedConfidenceIntervalUpperBounds <- results$repeatedConfidenceIntervalLowerBounds for (k in 1:design$kMax) { for (treatmentArm in 1:gMax) { results$repeatedConfidenceIntervalLowerBounds[treatmentArm, k] <- repeatedConfidenceIntervals[treatmentArm, 1, k] results$repeatedConfidenceIntervalUpperBounds[treatmentArm, k] <- repeatedConfidenceIntervals[treatmentArm, 2, k] } } results$.setParameterType("repeatedConfidenceIntervalLowerBounds", C_PARAM_GENERATED) results$.setParameterType("repeatedConfidenceIntervalUpperBounds", C_PARAM_GENERATED) # repeated p-value results$repeatedPValues <- .getRepeatedPValuesMultiArm(stageResults = stageResults, tolerance = tolerance) results$.setParameterType("repeatedPValues", C_PARAM_GENERATED) return(results) } .getStageResultsRatesMultiArm <- function(..., design, dataInput, thetaH0 = C_THETA_H0_RATES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, calculateSingleStepAdjusted = FALSE, userFunctionCallEnabled = FALSE) { .assertIsTrialDesign(design) .assertIsDatasetRates(dataInput) .assertIsValidThetaH0DataInput(thetaH0, dataInput) .assertIsValidDirectionUpper(directionUpper, design$sided) .assertIsSingleLogical(normalApproximation, "normalApproximation") .assertIsSingleLogical(calculateSingleStepAdjusted, "calculateSingleStepAdjusted") .warnInCaseOfUnknownArguments( functionName = ".getStageResultsRatesMultiArm", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) gMax <- dataInput$getNumberOfGroups() - 1 kMax <- design$kMax if (.isTrialDesignConditionalDunnett(design)) { if (!normalApproximation) { if (userFunctionCallEnabled) { warning("'normalApproximation' was set to TRUE ", "because conditional Dunnett test was specified as design", call. = FALSE ) } normalApproximation <- TRUE } } intersectionTest <- .getCorrectedIntersectionTestMultiArmIfNecessary( design, intersectionTest, userFunctionCallEnabled ) .assertIsValidIntersectionTestMultiArm(design, intersectionTest) if (intersectionTest == "Dunnett" && !normalApproximation) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "Dunnett test cannot be used with Fisher's exact test (normalApproximation = FALSE)", call. = FALSE ) } stageResults <- StageResultsMultiArmRates( design = design, dataInput = dataInput, intersectionTest = intersectionTest, thetaH0 = thetaH0, direction = ifelse(directionUpper, C_DIRECTION_UPPER, C_DIRECTION_LOWER), normalApproximation = normalApproximation, directionUpper = directionUpper, stage = stage ) piControl <- matrix(rep(NA_real_, kMax), 1, kMax) piTreatments <- matrix(NA_real_, nrow = gMax, ncol = kMax) testStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallTestStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) separatePValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallPValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) dimnames(testStatistics) <- list(paste("arm ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "")) dimnames(overallTestStatistics) <- list( paste("arm ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "") ) dimnames(separatePValues) <- list(paste("arm ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "")) dimnames(overallPValues) <- list(paste("arm ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "")) for (k in 1:stage) { piControl[1, k] <- dataInput$getOverallEvents(stage = k, group = gMax + 1) / dataInput$getOverallSampleSizes(stage = k, group = gMax + 1) for (g in 1:gMax) { piTreatments[g, k] <- dataInput$getOverallEvents(stage = k, group = g) / dataInput$getOverallSampleSizes(stage = k, group = g) actEv <- dataInput$getEvents(stage = k, group = g) ctrEv <- dataInput$getEvents(stage = k, group = gMax + 1) actN <- dataInput$getSampleSize(stage = k, group = g) ctrN <- dataInput$getSampleSize(stage = k, group = gMax + 1) if (normalApproximation) { if (thetaH0 == 0) { if (!is.na(actEv)) { if ((actEv + ctrEv == 0) || (actEv + ctrEv == actN + ctrN)) { testStatistics[g, k] <- 0 } else { rateH0 <- (actEv + ctrEv) / (actN + ctrN) testStatistics[g, k] <- (actEv / actN - ctrEv / ctrN - thetaH0) / sqrt(rateH0 * (1 - rateH0) * (1 / actN + 1 / ctrN)) } } } else { y <- .getFarringtonManningValues( rate1 = actEv / actN, rate2 = ctrEv / ctrN, theta = thetaH0, allocation = actN / ctrN, method = "diff" ) testStatistics[g, k] <- (actEv / actN - ctrEv / ctrN - thetaH0) / sqrt(y$ml1 * (1 - y$ml1) / actN + y$ml2 * (1 - y$ml2) / ctrN) } if (directionUpper) { separatePValues[g, k] <- 1 - stats::pnorm(testStatistics[g, k]) } else { separatePValues[g, k] <- stats::pnorm(testStatistics[g, k]) } } else { if (thetaH0 != 0) { stop( C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "'thetaH0' (", thetaH0, ") must be 0 to perform Fisher's exact test" ) } if (directionUpper) { separatePValues[g, k] <- stats::phyper(actEv - 1, actEv + ctrEv, actN + ctrN - actEv - ctrEv, actN, lower.tail = FALSE ) } else { separatePValues[g, k] <- stats::phyper(actEv, actEv + ctrEv, actN + ctrN - actEv - ctrEv, actN, lower.tail = TRUE ) } if (directionUpper) { testStatistics <- .getOneMinusQNorm(separatePValues) } else { testStatistics <- -.getOneMinusQNorm(separatePValues) } } # overall test statistics actEv <- dataInput$getOverallEvents(stage = k, group = g) ctrEv <- dataInput$getOverallEvents(stage = k, group = gMax + 1) actN <- dataInput$getOverallSampleSize(stage = k, group = g) ctrN <- dataInput$getOverallSampleSize(stage = k, group = gMax + 1) if (normalApproximation) { if (thetaH0 == 0) { if (!is.na(actEv)) { if ((actEv + ctrEv == 0) || (actEv + ctrEv == actN + ctrN)) { overallTestStatistics[g, k] <- 0 } else { overallRateH0 <- (actEv + ctrEv) / (actN + ctrN) overallTestStatistics[g, k] <- (actEv / actN - ctrEv / ctrN - thetaH0) / sqrt(overallRateH0 * (1 - overallRateH0) * (1 / actN + 1 / ctrN)) } } } else { y <- .getFarringtonManningValues( rate1 = actEv / actN, rate2 = ctrEv / ctrN, theta = thetaH0, allocation = actN / ctrN, method = "diff" ) overallTestStatistics[g, k] <- (actEv / actN - ctrEv / ctrN - thetaH0) / sqrt(y$ml1 * (1 - y$ml1) / actN + y$ml2 * (1 - y$ml2) / ctrN) } if (directionUpper) { overallPValues[g, k] <- 1 - stats::pnorm(overallTestStatistics[g, k]) } else { overallPValues[g, k] <- stats::pnorm(overallTestStatistics[g, k]) } } else { if (thetaH0 != 0) { stop( C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "'thetaH0' (", thetaH0, ") must be 0 to perform Fisher's exact test" ) } if (directionUpper) { overallPValues[g, k] <- stats::phyper(actEv - 1, actEv + ctrEv, actN + ctrN - actEv - ctrEv, actN, lower.tail = FALSE ) } else { overallPValues[g, k] <- stats::phyper(actEv, actEv + ctrEv, actN + ctrN - actEv - ctrEv, actN, lower.tail = TRUE ) } if (directionUpper) { overallTestStatistics <- .getOneMinusQNorm(overallPValues) } else { overallTestStatistics <- -.getOneMinusQNorm(overallPValues) } } } } stageResults$overallPiControl <- piControl stageResults$overallPiTreatments <- piTreatments stageResults$overallTestStatistics <- overallTestStatistics stageResults$overallPValues <- overallPValues stageResults$testStatistics <- testStatistics stageResults$separatePValues <- separatePValues effectSizes <- matrix(numeric(0), ncol = ncol(piControl)) for (g in 1:gMax) { effectSizes <- rbind(effectSizes, piTreatments[g, ] - piControl) } stageResults$effectSizes <- effectSizes stageResults$.setParameterType("effectSizes", C_PARAM_GENERATED) .setWeightsToStageResults(design, stageResults) if (!calculateSingleStepAdjusted) { return(stageResults) } # Calculation of single stage adjusted p-Values and overall test statistics # for determination of RCIs singleStepAdjustedPValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) combInverseNormal <- matrix(NA_real_, nrow = gMax, ncol = kMax) combFisher <- matrix(NA_real_, nrow = gMax, ncol = kMax) if (.isTrialDesignInverseNormal(design)) { weightsInverseNormal <- stageResults$weightsInverseNormal } else if (.isTrialDesignFisher(design)) { weightsFisher <- stageResults$weightsFisher } for (k in 1:stage) { selected <- sum(!is.na(separatePValues[, k])) sampleSizesSelected <- as.numeric(na.omit( dataInput$getSampleSizes(stage = k, group = -(gMax + 1)) )) sigma <- sqrt(sampleSizesSelected / (sampleSizesSelected + dataInput$getSampleSize(k, gMax + 1))) %*% sqrt(t(sampleSizesSelected / (sampleSizesSelected + dataInput$getSampleSize(k, gMax + 1)))) diag(sigma) <- 1 for (g in 1:gMax) { if ((intersectionTest == "Bonferroni") || (intersectionTest == "Simes")) { if (.isTrialDesignGroupSequential(design)) { overallPValues[g, k] <- min(1, overallPValues[g, k] * selected) } else { singleStepAdjustedPValues[g, k] <- min(1, separatePValues[g, k] * selected) } } else if (intersectionTest == "Sidak") { if (.isTrialDesignGroupSequential(design)) { overallPValues[g, k] <- 1 - (1 - overallPValues[g, k])^selected } else { singleStepAdjustedPValues[g, k] <- 1 - (1 - separatePValues[g, k])^selected } } else if (intersectionTest == "Dunnett") { if (!is.na(testStatistics[g, k])) { df <- NA_real_ singleStepAdjustedPValues[g, k] <- 1 - .getMultivariateDistribution( type = "normal", upper = ifelse(directionUpper, testStatistics[g, k], -testStatistics[g, k]), sigma = sigma, df = df ) } } if (.isTrialDesignInverseNormal(design)) { combInverseNormal[g, k] <- (weightsInverseNormal[1:k] %*% .getOneMinusQNorm(singleStepAdjustedPValues[g, 1:k])) / sqrt(sum(weightsInverseNormal[1:k]^2)) } else if (.isTrialDesignFisher(design)) { combFisher[g, k] <- prod(singleStepAdjustedPValues[g, 1:k]^weightsFisher[1:k]) } } } stageResults$singleStepAdjustedPValues <- singleStepAdjustedPValues stageResults$.setParameterType("singleStepAdjustedPValues", C_PARAM_GENERATED) if (.isTrialDesignFisher(design)) { stageResults$combFisher <- combFisher stageResults$.setParameterType("combFisher", C_PARAM_GENERATED) } else if (.isTrialDesignInverseNormal(design)) { stageResults$combInverseNormal <- combInverseNormal stageResults$.setParameterType("combInverseNormal", C_PARAM_GENERATED) } return(stageResults) } .getRootThetaRatesMultiArm <- function(..., design, dataInput, treatmentArm, stage, directionUpper, normalApproximation, intersectionTest, thetaLow, thetaUp, firstParameterName, secondValue, tolerance) { result <- .getOneDimensionalRoot( function(theta) { stageResults <- .getStageResultsRatesMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, intersectionTest = intersectionTest, normalApproximation = normalApproximation, calculateSingleStepAdjusted = TRUE ) firstValue <- stageResults[[firstParameterName]][treatmentArm, stage] if (.isTrialDesignGroupSequential(design)) { firstValue <- .getOneMinusQNorm(firstValue) } return(firstValue - secondValue) }, lower = thetaLow, upper = thetaUp, tolerance = tolerance, callingFunctionInformation = ".getRootThetaRatesMultiArm" ) return(result) } .getRepeatedConfidenceIntervalsRatesMultiArmAll <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, firstParameterName) { .assertIsValidIntersectionTestMultiArm(design, intersectionTest) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) stageResults <- .getStageResultsRatesMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = 0, directionUpper = directionUpper, intersectionTest = intersectionTest, normalApproximation = normalApproximation, calculateSingleStepAdjusted = FALSE ) gMax <- dataInput$getNumberOfGroups() - 1 repeatedConfidenceIntervals <- array(NA_real_, dim = c(gMax, 2, design$kMax)) # Confidence interval for second stage when using conditional Dunnett test if (.isTrialDesignConditionalDunnett(design)) { startTime <- Sys.time() for (treatmentArm in 1:gMax) { if (!is.na(stageResults$testStatistics[treatmentArm, 2])) { thetaLow <- -1 thetaUp <- 1 iteration <- 50 prec <- 1 while (prec > tolerance) { theta <- (thetaLow + thetaUp) / 2 stageResults <- .getStageResultsRatesMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = TRUE, intersectionTest = intersectionTest, normalApproximation = TRUE, calculateSingleStepAdjusted = FALSE ) conditionalDunnettSingleStepRejected <- .getConditionalDunnettTestForCI( design = design, stageResults = stageResults, treatmentArm = treatmentArm ) ifelse(conditionalDunnettSingleStepRejected, thetaLow <- theta, thetaUp <- theta) ifelse(iteration > 0, prec <- thetaUp - thetaLow, prec <- 0) iteration <- iteration - 1 } repeatedConfidenceIntervals[treatmentArm, 1, 2] <- theta thetaLow <- -1 thetaUp <- 1 iteration <- 50 prec <- 1 while (prec > tolerance) { theta <- (thetaLow + thetaUp) / 2 stageResults <- .getStageResultsRatesMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = FALSE, intersectionTest = intersectionTest, normalApproximation = TRUE, calculateSingleStepAdjusted = FALSE ) conditionalDunnettSingleStepRejected <- .getConditionalDunnettTestForCI( design = design, stageResults = stageResults, treatmentArm = treatmentArm ) ifelse(conditionalDunnettSingleStepRejected, thetaUp <- theta, thetaLow <- theta) ifelse(iteration > 0, prec <- thetaUp - thetaLow, prec <- 0) iteration <- iteration - 1 } repeatedConfidenceIntervals[treatmentArm, 2, 2] <- theta if (!is.na(repeatedConfidenceIntervals[treatmentArm, 1, 2]) && !is.na(repeatedConfidenceIntervals[treatmentArm, 2, 2]) && repeatedConfidenceIntervals[treatmentArm, 1, 2] > repeatedConfidenceIntervals[treatmentArm, 2, 2]) { repeatedConfidenceIntervals[treatmentArm, , 2] <- rep(NA_real_, 2) } } } .logProgress("Confidence intervals for final stage calculated", startTime = startTime) } else { # Repeated onfidence intervals when using combination tests if (intersectionTest == "Hierarchical") { warning("Repeated confidence intervals not available for ", "'intersectionTest' = \"Hierarchical\"", call. = FALSE ) return(repeatedConfidenceIntervals) } if (.isTrialDesignFisher(design)) { bounds <- design$alpha0Vec border <- C_ALPHA_0_VEC_DEFAULT criticalValues <- design$criticalValues conditionFunction <- .isFirstValueSmallerThanSecondValue } else if (.isTrialDesignInverseNormal(design)) { bounds <- design$futilityBounds border <- C_FUTILITY_BOUNDS_DEFAULT criticalValues <- design$criticalValues criticalValues[is.infinite(criticalValues) & criticalValues > 0] <- C_QNORM_MAXIMUM criticalValues[is.infinite(criticalValues) & criticalValues < 0] <- C_QNORM_MINIMUM conditionFunction <- .isFirstValueGreaterThanSecondValue } # necessary for adjustment for binding futility boundaries futilityCorr <- rep(NA_real_, design$kMax) stages <- (1:stage) for (k in stages) { startTime <- Sys.time() for (g in 1:gMax) { if (!is.na(stageResults$testStatistics[g, k])) { thetaLow <- -1 + tolerance thetaUp <- 1 - tolerance # finding upper and lower RCI limits through root function repeatedConfidenceIntervals[g, 1, k] <- .getRootThetaRatesMultiArm( design = design, dataInput = dataInput, treatmentArm = g, stage = k, directionUpper = TRUE, normalApproximation = normalApproximation, thetaLow = thetaLow, thetaUp = thetaUp, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance ) repeatedConfidenceIntervals[g, 2, k] <- .getRootThetaRatesMultiArm( design = design, dataInput = dataInput, treatmentArm = g, stage = k, directionUpper = FALSE, normalApproximation = normalApproximation, thetaLow = thetaLow, thetaUp = thetaUp, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance ) # adjustment for binding futility bounds if (k > 1 && conditionFunction(bounds[k - 1], border) & design$bindingFutility) { parameterName <- ifelse(.isTrialDesignFisher(design), "singleStepAdjustedPValues", firstParameterName ) futilityCorr[k] <- .getRootThetaRatesMultiArm( design = design, dataInput = dataInput, treatmentArm = g, stage = k - 1, directionUpper = directionUpper, normalApproximation = normalApproximation, thetaLow = thetaLow, thetaUp = thetaUp, intersectionTest = intersectionTest, firstParameterName = parameterName, secondValue = bounds[k - 1], tolerance = tolerance ) if (directionUpper) { repeatedConfidenceIntervals[g, 1, k] <- min( min(futilityCorr[2:k]), repeatedConfidenceIntervals[g, 1, k] ) } else { repeatedConfidenceIntervals[g, 2, k] <- max( max(futilityCorr[2:k]), repeatedConfidenceIntervals[g, 2, k] ) } } if (!is.na(repeatedConfidenceIntervals[g, 1, k]) && !is.na(repeatedConfidenceIntervals[g, 2, k]) && repeatedConfidenceIntervals[g, 1, k] > repeatedConfidenceIntervals[g, 2, k]) { repeatedConfidenceIntervals[g, , k] <- rep(NA_real_, 2) } } } .logProgress("Repeated confidence intervals for stage %s calculated", startTime = startTime, k) } } return(repeatedConfidenceIntervals) } # # RCIs based on inverse normal combination test # .getRepeatedConfidenceIntervalsRatesMultiArmInverseNormal <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { if (!normalApproximation) { message("Repeated confidence intervals will be calculated under the normal approximation") normalApproximation <- TRUE } .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsRatesMultiArmInverseNormal", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) return(.getRepeatedConfidenceIntervalsRatesMultiArmAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, directionUpper = directionUpper, intersectionTest = intersectionTest, tolerance = tolerance, firstParameterName = "combInverseNormal", ... )) } # # RCIs based on Fisher's combination test # .getRepeatedConfidenceIntervalsRatesMultiArmFisher <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { if (!normalApproximation) { message("Repeated confidence intervals will be calculated under the normal approximation") normalApproximation <- TRUE } .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsRatesMultiArmFisher", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) return(.getRepeatedConfidenceIntervalsRatesMultiArmAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, directionUpper = directionUpper, intersectionTest = intersectionTest, tolerance = tolerance, firstParameterName = "combFisher", ... )) } # # CIs based on conditional Dunnett test # .getRepeatedConfidenceIntervalsRatesMultiArmConditionalDunnett <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsRatesMultiArmConditionalDunnett", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) return(.getRepeatedConfidenceIntervalsRatesMultiArmAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, directionUpper = directionUpper, intersectionTest = intersectionTest, tolerance = tolerance, firstParameterName = "condDunnett", ... )) } # # Calculation of repeated confidence intervals (RCIs) for Rates # .getRepeatedConfidenceIntervalsRatesMultiArm <- function(..., design) { if (.isTrialDesignInverseNormal(design)) { return(.getRepeatedConfidenceIntervalsRatesMultiArmInverseNormal(design = design, ...)) } if (.isTrialDesignFisher(design)) { return(.getRepeatedConfidenceIntervalsRatesMultiArmFisher(design = design, ...)) } if (.isTrialDesignConditionalDunnett(design)) { return(.getRepeatedConfidenceIntervalsRatesMultiArmConditionalDunnett(design = design, ...)) } .stopWithWrongDesignMessage(design) } # # Calculation of conditional power for Rates # .getConditionalPowerRatesMultiArm <- function(..., stageResults, stage = stageResults$stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, piTreatments = NA_real_, piControl = NA_real_, useAdjustment = TRUE, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { design <- stageResults$.design gMax <- stageResults$getGMax() if (.isTrialDesignConditionalDunnett(design)) { kMax <- 2 } else { kMax <- design$kMax } piTreatmentsH1 <- .getOptionalArgument("piTreatmentsH1", ...) if (!is.null(piTreatmentsH1) && !is.na(piTreatmentsH1)) { if (!is.na(piTreatments)) { warning(sQuote("piTreatments"), " will be ignored because ", sQuote("piTreatmentsH1"), " is defined", call. = FALSE ) } piTreatments <- piTreatmentsH1 } piControlH1 <- .getOptionalArgument("piControlH1", ...) if (!is.null(piControlH1) && !is.na(piControlH1)) { if (!is.na(piControl)) { warning(sQuote("piControl"), " will be ignored because ", sQuote("piControlH1"), " is defined", call. = FALSE ) } piControl <- piControlH1 } results <- ConditionalPowerResultsMultiArmRates( .design = design, .stageResults = stageResults, piControl = piControl, piTreatments = piTreatments, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned ) if (any(is.na(nPlanned))) { return(results) } .assertIsValidStage(stage, kMax) if (stage == kMax) { .logDebug( "Conditional power will be calculated only for subsequent stages ", "(stage = ", stage, ", kMax = ", kMax, ")" ) return(results) } if (!.isValidNPlanned(nPlanned = nPlanned, kMax = kMax, stage = stage)) { return(results) } .assertIsValidNPlanned(nPlanned, kMax, stage) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) .setValueAndParameterType(results, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT) piControl <- .assertIsValidPiControlForMultiArm(piControl, stageResults, stage, results = results) piTreatments <- .assertIsValidPiTreatmentsForMultiArm(piTreatments, stageResults, stage, results = results) results$.setParameterType("nPlanned", C_PARAM_USER_DEFINED) if ((length(piTreatments) != 1) && (length(piTreatments) != gMax)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sprintf(paste0( "length of 'piTreatments' (%s) ", "must be equal to 'gMax' (%s) or 1" ), .arrayToString(piTreatments), gMax) ) } if (length(piControl) != 1) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sprintf(paste0("length of 'piControl' (%s) must be equal to 1"), .arrayToString(piControl)) ) } if (.isTrialDesignInverseNormal(design)) { return(.getConditionalPowerRatesMultiArmInverseNormal( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, piControl = piControl, piTreatments = piTreatments, ... )) } else if (.isTrialDesignFisher(design)) { return(.getConditionalPowerRatesMultiArmFisher( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, useAdjustment = useAdjustment, piControl = piControl, piTreatments = piTreatments, iterations = iterations, seed = seed, ... )) } else if (.isTrialDesignConditionalDunnett(design)) { return(.getConditionalPowerRatesMultiArmConditionalDunnett( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, piControl = piControl, piTreatments = piTreatments, ... )) } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of TrialDesignInverseNormal, TrialDesignFisher, ", "or TrialDesignConditionalDunnett" ) } # # Calculation of conditional power based on inverse normal method # .getConditionalPowerRatesMultiArmInverseNormal <- function(..., results, design, stageResults, stage, allocationRatioPlanned, nPlanned, piTreatments, piControl) { .assertIsTrialDesignInverseNormal(design) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerRatesMultiArmInverseNormal", ignore = c("piTreatmentsH1", "piControlH1"), ... ) kMax <- design$kMax gMax <- stageResults$getGMax() weights <- .getWeightsInverseNormal(design) informationRates <- design$informationRates nPlanned <- c(rep(NA_real_, stage), nPlanned) condError <- .getConditionalRejectionProbabilitiesMultiArm(design = design, stageResults = stageResults)[, stage] ml <- (allocationRatioPlanned * piTreatments + piControl) / (1 + allocationRatioPlanned) adjustment <- .getOneMinusQNorm(condError) * (1 - sqrt(ml * (1 - ml) * (1 + allocationRatioPlanned)) / sqrt(piTreatments * (1 - piTreatments) + allocationRatioPlanned * piControl * (1 - piControl))) * (1 + allocationRatioPlanned) / sqrt(allocationRatioPlanned * sum(nPlanned[(stage + 1):kMax])) adjustment[condError < 1e-12] <- 0 results$.setParameterType("piControl", C_PARAM_DEFAULT_VALUE) if (length(piTreatments) == 1) { piTreatments <- rep(piTreatments, gMax) results$.setParameterType("piTreatments", C_PARAM_GENERATED) } else { results$.setParameterType("piTreatments", C_PARAM_DEFAULT_VALUE) } if (stageResults$directionUpper) { standardizedEffect <- (piTreatments - piControl - stageResults$thetaH0) / sqrt(piTreatments * (1 - piTreatments) + allocationRatioPlanned * piControl * (1 - piControl)) * sqrt(1 + allocationRatioPlanned) + adjustment } else { standardizedEffect <- -(piTreatments - piControl - stageResults$thetaH0) / sqrt(piTreatments * (1 - piTreatments) + allocationRatioPlanned * piControl * (1 - piControl)) * sqrt(1 + allocationRatioPlanned) + adjustment } nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned ctr <- .performClosedCombinationTest(stageResults = stageResults) criticalValues <- design$criticalValues for (g in 1:gMax) { if (!is.na(ctr$separatePValues[g, stage])) { # shifted decision region for use in getGroupSeqProbs # Inverse Normal Method shiftedDecisionRegionUpper <- criticalValues[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stage], na.rm = TRUE) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - standardizedEffect[g] * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) if (stage == kMax - 1) { shiftedFutilityBounds <- c() } else { shiftedFutilityBounds <- design$futilityBounds[(stage + 1):(kMax - 1)] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):(kMax - 1)]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stage], na.rm = TRUE) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - standardizedEffect[g] * cumsum(sqrt(nPlanned[(stage + 1):(kMax - 1)]) * weights[(stage + 1):(kMax - 1)]) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) } # scaled information for use in getGroupSeqProbs scaledInformation <- (informationRates[(stage + 1):kMax] - informationRates[stage]) / (1 - informationRates[stage]) decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, shiftedDecisionRegionUpper ), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = scaledInformation ) results$conditionalPower[g, (stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ]) } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned results$nPlanned <- nPlanned results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$piTreatments <- piTreatments results$piControl <- piControl return(results) } # # Calculation of conditional power based on Fisher's combination test # .getConditionalPowerRatesMultiArmFisher <- function(..., results, design, stageResults, stage, allocationRatioPlanned, nPlanned, piTreatments, piControl, useAdjustment = TRUE, iterations, seed) { .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerRatesMultiArmFisher", ignore = c("piTreatmentsH1", "piControlH1"), ... ) kMax <- design$kMax gMax <- stageResults$getGMax() criticalValues <- design$criticalValues weightsFisher <- .getWeightsFisher(design) results$iterations <- as.integer(iterations) results$.setParameterType("iterations", C_PARAM_USER_DEFINED) results$.setParameterType("seed", ifelse(is.na(seed), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) results$seed <- .setSeed(seed) results$simulated <- FALSE results$.setParameterType("simulated", C_PARAM_DEFAULT_VALUE) nPlanned <- c(rep(NA_real_, stage), nPlanned) if (useAdjustment) { condError <- .getConditionalRejectionProbabilitiesMultiArm( design = design, stageResults = stageResults, iterations = iterations, seed = seed )[, stage] ml <- (allocationRatioPlanned * piTreatments + piControl) / (1 + allocationRatioPlanned) adjustment <- .getOneMinusQNorm(condError) * (1 - sqrt(ml * (1 - ml) * (1 + allocationRatioPlanned)) / sqrt(piTreatments * (1 - piTreatments) + allocationRatioPlanned * piControl * (1 - piControl))) * (1 + allocationRatioPlanned) / sqrt(allocationRatioPlanned * sum(nPlanned[(stage + 1):kMax])) adjustment[condError < 1e-12] <- 0 } else { adjustment <- 0 } if (length(piTreatments) == 1) { piTreatments <- rep(piTreatments, gMax) results$.setParameterType("piTreatments", C_PARAM_GENERATED) } else { results$.setParameterType("piTreatments", C_PARAM_DEFAULT_VALUE) } if (stageResults$directionUpper) { standardizedEffect <- (piTreatments - piControl) / sqrt(piTreatments * (1 - piTreatments) + allocationRatioPlanned * piControl * (1 - piControl)) * sqrt(1 + allocationRatioPlanned) + adjustment } else { standardizedEffect <- -(piTreatments - piControl - stageResults$thetaH0) / sqrt(piTreatments * (1 - piTreatments) + allocationRatioPlanned * piControl * (1 - piControl)) * sqrt(1 + allocationRatioPlanned) + adjustment } nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned ctr <- .performClosedCombinationTest(stageResults = stageResults) for (g in 1:gMax) { if (!is.na(ctr$separatePValues[g, stage])) { if (gMax == 1) { pValues <- ctr$adjustedStageWisePValues[ctr$indices[, g] == 1, ][1:stage] } else { pValues <- ctr$adjustedStageWisePValues[ctr$indices[, g] == 1, ][which.max( ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stage] ), 1:stage] } if (stage < kMax - 1) { for (k in (stage + 1):kMax) { reject <- 0 for (i in 1:iterations) { reject <- reject + .getRejectValueConditionalPowerFisher( kMax = kMax, alpha0Vec = design$alpha0Vec, criticalValues = criticalValues, weightsFisher = weightsFisher, pValues = pValues, currentKMax = k, thetaH1 = standardizedEffect[g], stage = stage, nPlanned = nPlanned ) } results$conditionalPower[g, k] <- reject / iterations } results$simulated <- TRUE results$.setParameterType("simulated", C_PARAM_GENERATED) } else if (stage == kMax - 1) { divisor <- prod(pValues[1:(kMax - 1)]^weightsFisher[1:(kMax - 1)]) result <- 1 - (criticalValues[kMax] / divisor)^(1 / weightsFisher[kMax]) if (result <= 0 || result >= 1) { warning("Calculation not possible: could not calculate conditional power for stage ", kMax, call. = FALSE) results$conditionalPower[g, kMax] <- NA_real_ } else { results$conditionalPower[g, kMax] <- 1 - stats::pnorm(.getQNorm(result) - standardizedEffect[g] * sqrt(nPlanned[kMax])) } } } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned results$nPlanned <- nPlanned results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$piTreatments <- piTreatments results$piControl <- piControl if (!results$simulated) { results$iterations <- NA_integer_ results$seed <- NA_real_ results$.setParameterType("iterations", C_PARAM_NOT_APPLICABLE) results$.setParameterType("seed", C_PARAM_NOT_APPLICABLE) } return(results) } # # Calculation of conditional power based on conditional Dunnett test # .getConditionalPowerRatesMultiArmConditionalDunnett <- function(..., results, design, stageResults, stage, allocationRatioPlanned, nPlanned, piTreatments, piControl) { .assertIsTrialDesignConditionalDunnett(design) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerRatesMultiArmConditionalDunnett", ignore = c("intersectionTest", "piTreatmentsH1", "piControlH1"), ... ) if (stage > 1) { warning("Conditional power is only calculated for the first (interim) stage", call. = FALSE) } gMax <- stageResults$getGMax() nPlanned <- c(rep(NA_real_, stage), nPlanned) condError <- .getConditionalRejectionProbabilitiesMultiArm(design = design, stageResults = stageResults)[, 2] ml <- (allocationRatioPlanned * piTreatments + piControl) / (1 + allocationRatioPlanned) adjustment <- .getOneMinusQNorm(condError) * (1 - sqrt(ml * (1 - ml) * (1 + allocationRatioPlanned)) / sqrt(piTreatments * (1 - piTreatments) + allocationRatioPlanned * piControl * (1 - piControl))) * (1 + allocationRatioPlanned) / sqrt(allocationRatioPlanned * sum(nPlanned[(stage + 1):2])) adjustment[condError < 1e-12] <- 0 if (length(piTreatments) == 1) { piTreatments <- rep(piTreatments, gMax) results$.setParameterType("piTreatments", C_PARAM_GENERATED) } else { results$.setParameterType("piTreatments", C_PARAM_DEFAULT_VALUE) } nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned if (stageResults$directionUpper) { standardizedEffect <- (piTreatments - piControl - stageResults$thetaH0) / sqrt(piTreatments * (1 - piTreatments) + allocationRatioPlanned * piControl * (1 - piControl)) * sqrt(1 + allocationRatioPlanned) + adjustment } else { standardizedEffect <- -(piTreatments - piControl - stageResults$thetaH0) / sqrt(piTreatments * (1 - piTreatments) + allocationRatioPlanned * piControl * (1 - piControl)) * sqrt(1 + allocationRatioPlanned) + adjustment } ctr <- .getClosedConditionalDunnettTestResults(stageResults = stageResults, design = design, stage = stage) for (g in 1:gMax) { if (!is.na(ctr$separatePValues[g, stage])) { results$conditionalPower[g, 2] <- 1 - stats::pnorm(.getOneMinusQNorm(min(ctr$conditionalErrorRate[ ctr$indices[, g] == 1, stage ], na.rm = TRUE)) - standardizedEffect[g] * sqrt(nPlanned[2])) } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned results$nPlanned <- nPlanned results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$piTreatments <- piTreatments results$piControl <- piControl return(results) } # # Calculation of conditional power and likelihood values for plotting the graph # .getConditionalPowerLikelihoodRatesMultiArm <- function(..., stageResults, stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, piTreatmentRange, piControl = NA_real_, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .associatedArgumentsAreDefined(nPlanned = nPlanned, piTreatmentRange = piTreatmentRange) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) design <- stageResults$.design kMax <- design$kMax gMax <- stageResults$getGMax() intersectionTest <- stageResults$intersectionTest piControl <- .assertIsValidPiControlForMultiArm(piControl, stageResults, stage) if (length(piControl) != 1) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'piControl' (", .arrayToString(piControl), ") must be equal to 1" ) } piTreatmentRange <- .assertIsValidPiTreatmentRange(piTreatmentRange = piTreatmentRange) treatmentArms <- numeric(gMax * length(piTreatmentRange)) effectValues <- numeric(gMax * length(piTreatmentRange)) condPowerValues <- numeric(gMax * length(piTreatmentRange)) likelihoodValues <- numeric(gMax * length(piTreatmentRange)) stdErr <- sqrt(stageResults$overallPiTreatments[, stage] * (1 - stageResults$overallPiTreatments[, stage])) / sqrt(stageResults$.dataInput$getOverallSampleSizes(stage = stage, group = (1:gMax))) results <- ConditionalPowerResultsMultiArmRates( .design = design, .stageResults = stageResults, piControl = piControl, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned ) j <- 1 for (i in seq(along = piTreatmentRange)) { for (g in (1:gMax)) { treatmentArms[j] <- g effectValues[j] <- piTreatmentRange[i] if (.isTrialDesignInverseNormal(design)) { condPowerValues[j] <- .getConditionalPowerRatesMultiArmInverseNormal( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, piControl = piControl, piTreatments = piTreatmentRange[i] )$conditionalPower[g, kMax] } else if (.isTrialDesignFisher(design)) { condPowerValues[j] <- .getConditionalPowerRatesMultiArmFisher( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, useAdjustment = FALSE, piControl = piControl, piTreatments = piTreatmentRange[i], iterations = iterations, seed = seed )$conditionalPower[g, kMax] } else if (.isTrialDesignConditionalDunnett(design)) { condPowerValues[j] <- .getConditionalPowerRatesMultiArmConditionalDunnett( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, piControl = piControl, piTreatments = piTreatmentRange[i] )$conditionalPower[g, 2] } likelihoodValues[j] <- stats::dnorm(piTreatmentRange[i], stageResults$overallPiTreatments[g, stage], stdErr[g]) / stats::dnorm(0, 0, stdErr[g]) j <- j + 1 } } subtitle <- paste0( "Intersection test = ", intersectionTest, ", stage = ", stage, ", # of remaining subjects = ", sum(nPlanned), ", control rate = ", .formatSubTitleValue(piControl, "piControl"), ", allocation ratio = ", .formatSubTitleValue(allocationRatioPlanned, "allocationRatioPlanned") ) return(list( treatmentArms = treatmentArms, xValues = effectValues, condPowerValues = condPowerValues, likelihoodValues = likelihoodValues, main = C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, xlab = "Treatment rate", ylab = C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, sub = subtitle )) } rpact/R/f_analysis_multiarm_survival.R0000644000175000017500000015302114165523513020045 0ustar nileshnilesh## | ## | *Analysis of survival in multi-arm designs with adaptive test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5684 $ ## | Last changed: $Date: 2022-01-05 12:27:24 +0100 (Mi, 05 Jan 2022) $ ## | Last changed by: $Author: wassmer $ ## | # @title # Get Analysis Results Survival # # @description # Returns an analysis result object. # # @param design The trial design. # # @return Returns a \code{AnalysisResultsSurvival} object. # # @keywords internal # .getAnalysisResultsSurvivalMultiArm <- function(..., design, dataInput) { if (.isTrialDesignInverseNormal(design)) { return(.getAnalysisResultsSurvivalInverseNormalMultiArm( design = design, dataInput = dataInput, ... )) } if (.isTrialDesignFisher(design)) { return(.getAnalysisResultsSurvivalFisherMultiArm( design = design, dataInput = dataInput, ... )) } if (.isTrialDesignConditionalDunnett(design)) { return(.getAnalysisResultsSurvivalConditionalDunnettMultiArm( design = design, dataInput = dataInput, ... )) } .stopWithWrongDesignMessage(design) } .getAnalysisResultsSurvivalInverseNormalMultiArm <- function(..., design, dataInput, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, thetaH0 = C_THETA_H0_SURVIVAL_DEFAULT, thetaH1 = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .assertIsTrialDesignInverseNormal(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsSurvivalInverseNormalMultiArm", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsMultiArmInverseNormal(design = design, dataInput = dataInput) results <- .getAnalysisResultsSurvivalMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, thetaH0 = thetaH0, thetaH1 = thetaH1, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance ) return(results) } .getAnalysisResultsSurvivalFisherMultiArm <- function(..., design, dataInput, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, thetaH0 = C_THETA_H0_SURVIVAL_DEFAULT, thetaH1 = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsSurvivalFisherMultiArm", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsMultiArmFisher(design = design, dataInput = dataInput) results <- .getAnalysisResultsSurvivalMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, thetaH0 = thetaH0, thetaH1 = thetaH1, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance, iterations = iterations, seed = seed ) return(results) } .getAnalysisResultsSurvivalConditionalDunnettMultiArm <- function(..., design, dataInput, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, thetaH0 = C_THETA_H0_SURVIVAL_DEFAULT, thetaH1 = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .assertIsTrialDesignConditionalDunnett(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsSurvivalConditionalDunnettMultiArm", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsConditionalDunnett(design = design, dataInput = dataInput) results <- .getAnalysisResultsSurvivalMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, thetaH0 = thetaH0, thetaH1 = thetaH1, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance, iterations = iterations, seed = seed ) return(results) } .getAnalysisResultsSurvivalMultiArmAll <- function(..., results, design, dataInput, intersectionTest, stage, directionUpper, thetaH0, thetaH1, nPlanned, allocationRatioPlanned, tolerance, iterations, seed) { startTime <- Sys.time() intersectionTest <- .getCorrectedIntersectionTestMultiArmIfNecessary(design, intersectionTest) stageResults <- .getStageResultsSurvivalMultiArm( design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper ) results$.setStageResults(stageResults) .logProgress("Stage results calculated", startTime = startTime) gMax <- stageResults$getGMax() thetaH1 <- .assertIsValidThetaH1ForMultiArm(thetaH1, stageResults, stage, results = results) .setValueAndParameterType(results, "intersectionTest", intersectionTest, C_INTERSECTION_TEST_MULTIARMED_DEFAULT) .setValueAndParameterType(results, "directionUpper", directionUpper, C_DIRECTION_UPPER_DEFAULT) .setValueAndParameterType(results, "thetaH0", thetaH0, C_THETA_H0_MEANS_DEFAULT) .setConditionalPowerArguments(results, dataInput, nPlanned, allocationRatioPlanned) .setNPlannedAndThetaH1(results, nPlanned, thetaH1) startTime <- Sys.time() if (!.isTrialDesignConditionalDunnett(design)) { results$.closedTestResults <- getClosedCombinationTestResults(stageResults = stageResults) } else { results$.closedTestResults <- getClosedConditionalDunnettTestResults( stageResults = stageResults, design = design, stage = stage ) } .logProgress("Closed test calculated", startTime = startTime) if (design$kMax > 1) { # conditional power startTime <- Sys.time() if (.isTrialDesignFisher(design)) { conditionalPowerResults <- .getConditionalPowerSurvivalMultiArm( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, iterations = iterations, seed = seed ) if (conditionalPowerResults$simulated) { results$conditionalPowerSimulated <- conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalPowerSimulated", C_PARAM_GENERATED) } else { results$conditionalPower <- conditionalPowerResults$conditionalPower results$conditionalPowerSimulated <- matrix(numeric(0)) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$.setParameterType("conditionalPowerSimulated", C_PARAM_NOT_APPLICABLE) } } else { conditionalPowerResults <- .getConditionalPowerSurvivalMultiArm( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1 ) results$conditionalPower <- conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_GENERATED) } results$thetaH1 <- matrix(conditionalPowerResults$thetaH1, ncol = 1) results$.conditionalPowerResults <- conditionalPowerResults .logProgress("Conditional power calculated", startTime = startTime) # CRP - conditional rejection probabilities startTime <- Sys.time() results$conditionalRejectionProbabilities <- .getConditionalRejectionProbabilitiesMultiArm( stageResults = stageResults, stage = stage, iterations = iterations, seed = seed ) results$.setParameterType("conditionalRejectionProbabilities", C_PARAM_GENERATED) .logProgress("Conditional rejection probabilities (CRP) calculated", startTime = startTime) } else { results$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalPowerSimulated", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalRejectionProbabilities", C_PARAM_NOT_APPLICABLE) } # RCI - repeated confidence interval repeatedConfidenceIntervalLowerBounds <- numeric(0) repeatedConfidenceIntervalUpperBounds <- numeric(0) startTime <- Sys.time() repeatedConfidenceIntervals <- .getRepeatedConfidenceIntervalsSurvivalMultiArm( design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, tolerance = tolerance ) results$repeatedConfidenceIntervalLowerBounds <- matrix(rep(NA_real_, gMax * design$kMax), nrow = gMax, ncol = design$kMax) results$repeatedConfidenceIntervalUpperBounds <- results$repeatedConfidenceIntervalLowerBounds for (k in 1:design$kMax) { for (treatmentArm in 1:gMax) { results$repeatedConfidenceIntervalLowerBounds[treatmentArm, k] <- repeatedConfidenceIntervals[treatmentArm, 1, k] results$repeatedConfidenceIntervalUpperBounds[treatmentArm, k] <- repeatedConfidenceIntervals[treatmentArm, 2, k] } } results$.setParameterType("repeatedConfidenceIntervalLowerBounds", C_PARAM_GENERATED) results$.setParameterType("repeatedConfidenceIntervalUpperBounds", C_PARAM_GENERATED) # repeated p-value results$repeatedPValues <- .getRepeatedPValuesMultiArm(stageResults = stageResults, tolerance = tolerance) results$.setParameterType("repeatedPValues", C_PARAM_GENERATED) return(results) } .getStageResultsSurvivalMultiArm <- function(..., design, dataInput, thetaH0 = C_THETA_H0_SURVIVAL_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, calculateSingleStepAdjusted = FALSE, userFunctionCallEnabled = FALSE) { .assertIsTrialDesign(design) .assertIsDatasetSurvival(dataInput) .assertIsValidThetaH0DataInput(thetaH0, dataInput) .assertIsValidDirectionUpper(directionUpper, design$sided) .assertIsSingleLogical(calculateSingleStepAdjusted, "calculateSingleStepAdjusted") .warnInCaseOfUnknownArguments( functionName = ".getStageResultsSurvivalMultiArm", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) gMax <- dataInput$getNumberOfGroups() - 1 kMax <- design$kMax intersectionTest <- .getCorrectedIntersectionTestMultiArmIfNecessary( design, intersectionTest, userFunctionCallEnabled ) .assertIsValidIntersectionTestMultiArm(design, intersectionTest) stageResults <- StageResultsMultiArmSurvival( design = design, dataInput = dataInput, intersectionTest = intersectionTest, thetaH0 = thetaH0, direction = ifelse(directionUpper, C_DIRECTION_UPPER, C_DIRECTION_LOWER), directionUpper = directionUpper, stage = stage ) effectSizes <- matrix(NA_real_, nrow = gMax, ncol = kMax) testStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallTestStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) separatePValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallPValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) dimnames(testStatistics) <- list(paste("arm ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "")) dimnames(overallTestStatistics) <- list( paste("arm ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "") ) dimnames(separatePValues) <- list(paste("arm ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "")) dimnames(overallPValues) <- list(paste("arm ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "")) for (k in 1:stage) { for (g in 1:gMax) { effectSizes[g, k] <- exp(dataInput$getOverallLogRanks(stage = k, group = g) * (1 + dataInput$getOverallAllocationRatios(stage = k, group = g)) / sqrt(dataInput$getOverallAllocationRatios(stage = k, group = g) * dataInput$getOverallEvents(stage = k, group = g))) testStatistics[g, k] <- dataInput$getLogRanks(stage = k, group = g) - sqrt(dataInput$getEvents(stage = k, group = g)) * sqrt(dataInput$getAllocationRatios(stage = k, group = g)) / (1 + dataInput$getAllocationRatios(stage = k, group = g)) * log(thetaH0) overallTestStatistics[g, k] <- dataInput$getOverallLogRanks(stage = k, group = g) - sqrt(dataInput$getOverallEvents(stage = k, group = g)) * sqrt(dataInput$getOverallAllocationRatios(stage = k, group = g)) / (1 + dataInput$getOverallAllocationRatios(stage = k, group = g)) * log(thetaH0) if (directionUpper) { separatePValues[g, k] <- 1 - stats::pnorm(testStatistics[g, k]) overallPValues[g, k] <- 1 - stats::pnorm(overallTestStatistics[g, k]) } else { separatePValues[g, k] <- stats::pnorm(testStatistics[g, k]) overallPValues[g, k] <- stats::pnorm(overallTestStatistics[g, k]) } } } .setWeightsToStageResults(design, stageResults) # Calculation of single stage adjusted p-Values and overall test statistics # for determination of RCIs if (calculateSingleStepAdjusted) { singleStepAdjustedPValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) combInverseNormal <- matrix(NA_real_, nrow = gMax, ncol = kMax) combFisher <- matrix(NA_real_, nrow = gMax, ncol = kMax) if (.isTrialDesignInverseNormal(design)) { weightsInverseNormal <- stageResults$weightsInverseNormal } else if (.isTrialDesignFisher(design)) { weightsFisher <- stageResults$weightsFisher } for (k in 1:stage) { selected <- sum(!is.na(separatePValues[, k])) allocationRatiosSelected <- as.numeric(na.omit( dataInput$getAllocationRatios(stage = k, group = (1:gMax)) )) sigma <- sqrt(allocationRatiosSelected / (1 + allocationRatiosSelected)) %*% sqrt(t(allocationRatiosSelected / (1 + allocationRatiosSelected))) diag(sigma) <- 1 for (g in 1:gMax) { if ((intersectionTest == "Bonferroni") || (intersectionTest == "Simes")) { if (.isTrialDesignGroupSequential(design)) { overallPValues[g, k] <- min(1, overallPValues[g, k] * selected) } else { singleStepAdjustedPValues[g, k] <- min(1, separatePValues[g, k] * selected) } } else if (intersectionTest == "Sidak") { if (.isTrialDesignGroupSequential(design)) { overallPValues[g, k] <- 1 - (1 - overallPValues[g, k])^selected } else { singleStepAdjustedPValues[g, k] <- 1 - (1 - separatePValues[g, k])^selected } } else if (intersectionTest == "Dunnett") { if (!is.na(testStatistics[g, k])) { df <- NA_real_ singleStepAdjustedPValues[g, k] <- 1 - .getMultivariateDistribution( type = "normal", upper = ifelse(directionUpper, testStatistics[g, k], -testStatistics[g, k]), sigma = sigma, df = df ) } } if (.isTrialDesignInverseNormal(design)) { combInverseNormal[g, k] <- (weightsInverseNormal[1:k] %*% .getOneMinusQNorm(singleStepAdjustedPValues[g, 1:k])) / sqrt(sum(weightsInverseNormal[1:k]^2)) } else if (.isTrialDesignFisher(design)) { combFisher[g, k] <- prod(singleStepAdjustedPValues[g, 1:k]^weightsFisher[1:k]) } } } stageResults$overallTestStatistics <- overallTestStatistics stageResults$overallPValues <- overallPValues stageResults$effectSizes <- effectSizes stageResults$testStatistics <- testStatistics stageResults$separatePValues <- separatePValues stageResults$singleStepAdjustedPValues <- singleStepAdjustedPValues stageResults$.setParameterType("singleStepAdjustedPValues", C_PARAM_GENERATED) if (.isTrialDesignFisher(design)) { stageResults$combFisher <- combFisher stageResults$.setParameterType("combFisher", C_PARAM_GENERATED) } else if (.isTrialDesignInverseNormal(design)) { stageResults$combInverseNormal <- combInverseNormal stageResults$.setParameterType("combInverseNormal", C_PARAM_GENERATED) } } else { stageResults$overallTestStatistics <- overallTestStatistics stageResults$overallPValues <- overallPValues stageResults$effectSizes <- effectSizes stageResults$testStatistics <- testStatistics stageResults$separatePValues <- separatePValues } return(stageResults) } .getRootThetaSurvivalMultiArm <- function(..., design, dataInput, treatmentArm, stage, directionUpper, intersectionTest, thetaLow, thetaUp, firstParameterName, secondValue, tolerance) { result <- .getOneDimensionalRoot( function(theta) { stageResults <- .getStageResultsSurvivalMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, intersectionTest = intersectionTest, calculateSingleStepAdjusted = TRUE ) firstValue <- stageResults[[firstParameterName]][treatmentArm, stage] return(firstValue - secondValue) }, lower = thetaLow, upper = thetaUp, tolerance = tolerance, callingFunctionInformation = ".getRootThetaSurvivalMultiArm" ) return(result) } .getUpperLowerThetaSurvivalMultiArm <- function(..., design, dataInput, theta, treatmentArm, stage, directionUpper, conditionFunction, intersectionTest, firstParameterName, secondValue) { stageResults <- .getStageResultsSurvivalMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = exp(theta), directionUpper = directionUpper, intersectionTest = intersectionTest, calculateSingleStepAdjusted = TRUE ) firstValue <- stageResults[[firstParameterName]][treatmentArm, stage] maxSearchIterations <- 30 while (conditionFunction(secondValue, firstValue)) { theta <- 2 * theta stageResults <- .getStageResultsSurvivalMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = exp(theta), directionUpper = directionUpper, intersectionTest = intersectionTest, calculateSingleStepAdjusted = TRUE ) firstValue <- stageResults[[firstParameterName]][treatmentArm, stage] maxSearchIterations <- maxSearchIterations - 1 if (maxSearchIterations < 0) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, sprintf( paste0( "failed to find theta (k = %s, firstValue = %s, ", "secondValue = %s, levels(firstValue) = %s, theta = %s)" ), stage, stageResults[[firstParameterName]][treatmentArm, stage], secondValue, firstValue, theta ) ) } } return(theta) } .getRepeatedConfidenceIntervalsSurvivalMultiArmAll <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, firstParameterName) { .assertIsValidIntersectionTestMultiArm(design, intersectionTest) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) stageResults <- .getStageResultsSurvivalMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = 1, directionUpper = directionUpper, intersectionTest = intersectionTest, calculateSingleStepAdjusted = FALSE ) gMax <- dataInput$getNumberOfGroups() - 1 repeatedConfidenceIntervals <- array(NA_real_, dim = c(gMax, 2, design$kMax)) # Confidence interval for second stage when using conditional Dunnett test if (.isTrialDesignConditionalDunnett(design)) { startTime <- Sys.time() for (treatmentArm in 1:gMax) { if (!is.na(stageResults$testStatistics[treatmentArm, 2])) { iteration <- 30 thetaUpLimit <- 1 repeat{ stageResults <- .getStageResultsSurvivalMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaUpLimit, directionUpper = FALSE, intersectionTest = intersectionTest, calculateSingleStepAdjusted = FALSE ) rejected <- .getConditionalDunnettTestForCI( design = design, stageResults = stageResults, treatmentArm = treatmentArm ) iteration <- iteration - 1 if (rejected || iteration == 0) break thetaUpLimit <- 2 * thetaUpLimit } thetaLow <- 0 thetaUp <- thetaUpLimit iteration <- 30 prec <- 1 while (prec > tolerance) { theta <- (thetaLow + thetaUp) / 2 stageResults <- .getStageResultsSurvivalMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = TRUE, intersectionTest = intersectionTest, calculateSingleStepAdjusted = FALSE ) conditionalDunnettSingleStepRejected <- .getConditionalDunnettTestForCI( design = design, stageResults = stageResults, treatmentArm = treatmentArm ) ifelse(conditionalDunnettSingleStepRejected, thetaLow <- theta, thetaUp <- theta) ifelse(iteration > 0, prec <- thetaUp - thetaLow, prec <- 0) iteration <- iteration - 1 } repeatedConfidenceIntervals[treatmentArm, 1, 2] <- theta thetaLow <- 0 thetaUp <- thetaUpLimit iteration <- 30 prec <- 1 while (prec > tolerance) { theta <- (thetaLow + thetaUp) / 2 stageResults <- .getStageResultsSurvivalMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = FALSE, intersectionTest = intersectionTest, calculateSingleStepAdjusted = FALSE ) conditionalDunnettSingleStepRejected <- .getConditionalDunnettTestForCI( design = design, stageResults = stageResults, treatmentArm = treatmentArm ) ifelse(conditionalDunnettSingleStepRejected, thetaUp <- theta, thetaLow <- theta) ifelse(iteration > 0, prec <- thetaUp - thetaLow, prec <- 0) iteration <- iteration - 1 } repeatedConfidenceIntervals[treatmentArm, 2, 2] <- theta if (!is.na(repeatedConfidenceIntervals[treatmentArm, 1, 2]) && !is.na(repeatedConfidenceIntervals[treatmentArm, 2, 2]) && repeatedConfidenceIntervals[treatmentArm, 1, 2] > repeatedConfidenceIntervals[treatmentArm, 2, 2]) { repeatedConfidenceIntervals[treatmentArm, , 2] <- rep(NA_real_, 2) } } } .logProgress("Confidence intervals for final stage calculated", startTime = startTime) } else { # Repeated onfidence intervals when using combination tests if (intersectionTest == "Hierarchical") { warning("Repeated confidence intervals not available for ", "'intersectionTest' = \"Hierarchical\"", call. = FALSE ) return(repeatedConfidenceIntervals) } if (.isTrialDesignFisher(design)) { bounds <- design$alpha0Vec border <- C_ALPHA_0_VEC_DEFAULT criticalValues <- design$criticalValues conditionFunction <- .isFirstValueSmallerThanSecondValue } else if (.isTrialDesignInverseNormal(design)) { bounds <- design$futilityBounds border <- C_FUTILITY_BOUNDS_DEFAULT criticalValues <- design$criticalValues criticalValues[is.infinite(criticalValues) & criticalValues > 0] <- C_QNORM_MAXIMUM criticalValues[is.infinite(criticalValues) & criticalValues < 0] <- C_QNORM_MINIMUM conditionFunction <- .isFirstValueGreaterThanSecondValue } if (any(is.na(criticalValues[1:stage]))) { warning("Repeated confidence intervals not because ", sum(is.na(criticalValues)), " critical values are NA (", .arrayToString(criticalValues), ")", call. = FALSE ) return(repeatedConfidenceIntervals) } # necessary for adjustment for binding futility boundaries futilityCorr <- rep(NA_real_, design$kMax) stages <- (1:stage) for (k in stages) { startTime <- Sys.time() for (g in 1:gMax) { if (!is.na(stageResults$testStatistics[g, k])) { # Finding maximum upper and minimum lower bounds for RCIs thetaLow <- exp(.getUpperLowerThetaSurvivalMultiArm( design = design, dataInput = dataInput, theta = -1, treatmentArm = g, stage = k, directionUpper = TRUE, intersectionTest = intersectionTest, conditionFunction = conditionFunction, firstParameterName = firstParameterName, secondValue = criticalValues[k] )) thetaUp <- exp(.getUpperLowerThetaSurvivalMultiArm( design = design, dataInput = dataInput, theta = 1, treatmentArm = g, stage = k, directionUpper = FALSE, intersectionTest = intersectionTest, conditionFunction = conditionFunction, firstParameterName = firstParameterName, secondValue = criticalValues[k] )) # finding upper and lower RCI limits through root function repeatedConfidenceIntervals[g, 1, k] <- .getRootThetaSurvivalMultiArm( design = design, dataInput = dataInput, treatmentArm = g, stage = k, directionUpper = TRUE, thetaLow = thetaLow, thetaUp = thetaUp, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance ) repeatedConfidenceIntervals[g, 2, k] <- .getRootThetaSurvivalMultiArm( design = design, dataInput = dataInput, treatmentArm = g, stage = k, directionUpper = FALSE, thetaLow = thetaLow, thetaUp = thetaUp, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance ) # adjustment for binding futility bounds if (k > 1 && conditionFunction(bounds[k - 1], border) & design$bindingFutility) { parameterName <- ifelse(.isTrialDesignFisher(design), "singleStepAdjustedPValues", firstParameterName ) # Calculate new lower and upper bounds if (directionUpper) { thetaLow <- tolerance } else { thetaUp <- .getUpperLowerThetaSurvivalMultiArm( design = design, dataInput = dataInput, theta = 1, treatmentArm = g, stage = k - 1, directionUpper = FALSE, conditionFunction = conditionFunction, intersectionTest = intersectionTest, firstParameterName = parameterName, secondValue = bounds[k - 1] ) } futilityCorr[k] <- .getRootThetaSurvivalMultiArm( design = design, dataInput = dataInput, treatmentArm = g, stage = k - 1, directionUpper = directionUpper, thetaLow = thetaLow, thetaUp = thetaUp, intersectionTest = intersectionTest, firstParameterName = parameterName, secondValue = bounds[k - 1], tolerance = tolerance ) if (directionUpper) { repeatedConfidenceIntervals[g, 1, k] <- min( min(futilityCorr[2:k]), repeatedConfidenceIntervals[g, 1, k] ) } else { repeatedConfidenceIntervals[g, 2, k] <- max( max(futilityCorr[2:k]), repeatedConfidenceIntervals[g, 2, k] ) } } if (!is.na(repeatedConfidenceIntervals[g, 1, k]) && !is.na(repeatedConfidenceIntervals[g, 2, k]) && repeatedConfidenceIntervals[g, 1, k] > repeatedConfidenceIntervals[g, 2, k]) { repeatedConfidenceIntervals[g, , k] <- rep(NA_real_, 2) } } } .logProgress("Repeated confidence intervals for stage %s calculated", startTime = startTime, k) } } return(repeatedConfidenceIntervals) } # # RCIs based on inverse normal combination test # .getRepeatedConfidenceIntervalsSurvivalMultiArmInverseNormal <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsSurvivalMultiArmInverseNormal", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) return(.getRepeatedConfidenceIntervalsSurvivalMultiArmAll( design = design, dataInput = dataInput, directionUpper = directionUpper, intersectionTest = intersectionTest, tolerance = tolerance, firstParameterName = "combInverseNormal", ... )) } # # RCIs based on Fisher's combination test # .getRepeatedConfidenceIntervalsSurvivalMultiArmFisher <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsSurvivalMultiArmFisher", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) return(.getRepeatedConfidenceIntervalsSurvivalMultiArmAll( design = design, dataInput = dataInput, directionUpper = directionUpper, intersectionTest = intersectionTest, tolerance = tolerance, firstParameterName = "combFisher", ... )) } # # CIs based on conditional Dunnett test # .getRepeatedConfidenceIntervalsSurvivalMultiArmConditionalDunnett <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsSurvivalMultiArmConditionalDunnett", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) return(.getRepeatedConfidenceIntervalsSurvivalMultiArmAll( design = design, dataInput = dataInput, directionUpper = directionUpper, intersectionTest = intersectionTest, tolerance = tolerance, firstParameterName = "condDunnett", ... )) } # # Calculation of lower and upper limits of repeated confidence intervals (RCIs) for Survival # .getRepeatedConfidenceIntervalsSurvivalMultiArm <- function(..., design) { if (.isTrialDesignInverseNormal(design)) { return(.getRepeatedConfidenceIntervalsSurvivalMultiArmInverseNormal(design = design, ...)) } if (.isTrialDesignFisher(design)) { return(.getRepeatedConfidenceIntervalsSurvivalMultiArmFisher(design = design, ...)) } if (.isTrialDesignConditionalDunnett(design)) { return(.getRepeatedConfidenceIntervalsSurvivalMultiArmConditionalDunnett(design = design, ...)) } .stopWithWrongDesignMessage(design) } # # Calculation of conditional power for Survival # .getConditionalPowerSurvivalMultiArm <- function(..., stageResults, stage = stageResults$stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaH1 = NA_real_, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { design <- stageResults$.design gMax <- stageResults$getGMax() kMax <- design$kMax results <- ConditionalPowerResultsMultiArmSurvival( .design = design, .stageResults = stageResults, thetaH1 = thetaH1, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned ) if (any(is.na(nPlanned))) { return(results) } .assertIsValidStage(stage, kMax) if (stage == kMax) { .logDebug( "Conditional power will be calculated only for subsequent stages ", "(stage = ", stage, ", kMax = ", kMax, ")" ) return(results) } if (!.isValidNPlanned(nPlanned = nPlanned, kMax = kMax, stage = stage)) { return(results) } .assertIsValidNPlanned(nPlanned, kMax, stage) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) .setValueAndParameterType(results, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT) thetaH1 <- .assertIsValidThetaH1ForMultiArm(thetaH1, stageResults, stage, results = results) results$.setParameterType("nPlanned", C_PARAM_USER_DEFINED) if (any(thetaH1 <= 0, na.rm = TRUE)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'thetaH1' (", thetaH1, ") must be > 0") } if ((length(thetaH1) != 1) && (length(thetaH1) != gMax)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sprintf(paste0( "length of 'thetaH1' (%s) must be ", "equal to 'gMax' (%s) or 1" ), .arrayToString(thetaH1), gMax) ) } if (.isTrialDesignInverseNormal(design)) { return(.getConditionalPowerSurvivalMultiArmInverseNormal( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, ... )) } else if (.isTrialDesignFisher(design)) { return(.getConditionalPowerSurvivalMultiArmFisher( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, iterations = iterations, seed = seed, ... )) } else if (.isTrialDesignConditionalDunnett(design)) { return(.getConditionalPowerSurvivalMultiArmConditionalDunnett( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, ... )) } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of TrialDesignInverseNormal, TrialDesignFisher, ", "or TrialDesignConditionalDunnett" ) } # # Calculation of conditional power based on inverse normal method # .getConditionalPowerSurvivalMultiArmInverseNormal <- function(..., results, design, stageResults, stage, allocationRatioPlanned, nPlanned, thetaH1) { .assertIsTrialDesignInverseNormal(design) .warnInCaseOfUnknownArguments(functionName = ".getConditionalPowerSurvivalMultiArmInverseNormal", ...) kMax <- design$kMax gMax <- stageResults$getGMax() weights <- .getWeightsInverseNormal(design) informationRates <- design$informationRates nPlanned <- c(rep(NA_real_, stage), nPlanned) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned if (length(thetaH1) == 1) { thetaH1 <- rep(thetaH1, gMax) results$.setParameterType("thetaH1", C_PARAM_GENERATED) } else { results$.setParameterType("thetaH1", C_PARAM_DEFAULT_VALUE) } if (stageResults$directionUpper) { standardizedEffect <- log(thetaH1 / stageResults$thetaH0) } else { standardizedEffect <- -log(thetaH1 / stageResults$thetaH0) } ctr <- .performClosedCombinationTest(stageResults = stageResults) criticalValues <- design$criticalValues for (g in 1:gMax) { if (!is.na(ctr$separatePValues[g, stage])) { # shifted decision region for use in getGroupSeqProbs # Inverse Normal Method shiftedDecisionRegionUpper <- criticalValues[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stage], na.rm = TRUE) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - standardizedEffect[g] * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) if (stage == kMax - 1) { shiftedFutilityBounds <- c() } else { shiftedFutilityBounds <- design$futilityBounds[(stage + 1):(kMax - 1)] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):(kMax - 1)]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stage], na.rm = TRUE) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - standardizedEffect[g] * cumsum(sqrt(nPlanned[(stage + 1):(kMax - 1)]) * weights[(stage + 1):(kMax - 1)]) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) } # scaled information for use in getGroupSeqProbs scaledInformation <- (informationRates[(stage + 1):kMax] - informationRates[stage]) / (1 - informationRates[stage]) decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, shiftedDecisionRegionUpper ), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = scaledInformation ) results$conditionalPower[g, (stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ]) } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned results$nPlanned <- nPlanned results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$thetaH1 <- thetaH1 return(results) } # # Calculation of conditional power based on Fisher's combination test # .getConditionalPowerSurvivalMultiArmFisher <- function(..., results, design, stageResults, stage, allocationRatioPlanned, nPlanned, thetaH1, iterations, seed) { .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) .warnInCaseOfUnknownArguments(functionName = ".getConditionalPowerSurvivalMultiArmFisher", ...) kMax <- design$kMax gMax <- stageResults$getGMax() criticalValues <- design$criticalValues weightsFisher <- .getWeightsFisher(design) results$iterations <- as.integer(iterations) results$.setParameterType("iterations", C_PARAM_USER_DEFINED) results$.setParameterType("seed", ifelse(is.na(seed), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) results$seed <- .setSeed(seed) results$simulated <- FALSE results$.setParameterType("simulated", C_PARAM_DEFAULT_VALUE) if (length(thetaH1) == 1) { thetaH1 <- rep(thetaH1, gMax) results$.setParameterType("thetaH1", C_PARAM_GENERATED) } else { results$.setParameterType("thetaH1", C_PARAM_DEFAULT_VALUE) } if (stageResults$directionUpper) { standardizedEffect <- log(thetaH1 / stageResults$thetaH0) } else { standardizedEffect <- -log(thetaH1 / stageResults$thetaH0) } nPlanned <- c(rep(NA_real_, stage), nPlanned) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned ctr <- .performClosedCombinationTest(stageResults = stageResults) for (g in 1:gMax) { if (!is.na(ctr$separatePValues[g, stage])) { if (gMax == 1) { pValues <- ctr$adjustedStageWisePValues[ctr$indices[, g] == 1, ][1:stage] } else { pValues <- ctr$adjustedStageWisePValues[ctr$indices[, g] == 1, ][which.max( ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stage] ), 1:stage] } if (stage < kMax - 1) { for (k in (stage + 1):kMax) { reject <- 0 for (i in 1:iterations) { reject <- reject + .getRejectValueConditionalPowerFisher( kMax = kMax, alpha0Vec = design$alpha0Vec, criticalValues = criticalValues, weightsFisher = weightsFisher, pValues = pValues, currentKMax = k, thetaH1 = standardizedEffect[g], stage = stage, nPlanned = nPlanned ) } results$conditionalPower[g, k] <- reject / iterations } results$simulated <- TRUE results$.setParameterType("simulated", C_PARAM_GENERATED) } else if (stage == kMax - 1) { divisor <- prod(pValues[1:(kMax - 1)]^weightsFisher[1:(kMax - 1)]) result <- 1 - (criticalValues[kMax] / divisor)^(1 / weightsFisher[kMax]) if (result <= 0 || result >= 1) { warning("Calculation not possible: ", "could not calculate conditional power for stage ", kMax, call. = FALSE ) results$conditionalPower[g, kMax] <- NA_real_ } else { results$conditionalPower[g, kMax] <- 1 - stats::pnorm(.getQNorm(result) - standardizedEffect[g] * sqrt(nPlanned[kMax])) } } } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned results$nPlanned <- nPlanned results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$thetaH1 <- thetaH1 if (!results$simulated) { results$iterations <- NA_integer_ results$seed <- NA_real_ results$.setParameterType("iterations", C_PARAM_NOT_APPLICABLE) results$.setParameterType("seed", C_PARAM_NOT_APPLICABLE) } return(results) } # # Calculation of conditional power based on conditional Dunnett test # .getConditionalPowerSurvivalMultiArmConditionalDunnett <- function(..., results, design, stageResults, stage, allocationRatioPlanned, nPlanned, thetaH1) { .assertIsTrialDesignConditionalDunnett(design) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerSurvivalMultiArmConditionalDunnett", ignore = c("intersectionTest"), ... ) if (stage > 1) { warning("Conditional power is only calculated for the first (interim) stage", call. = FALSE) } gMax <- stageResults$getGMax() nPlanned <- c(rep(NA_real_, stage), nPlanned) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned if (length(thetaH1) == 1) { thetaH1 <- rep(thetaH1, gMax) results$.setParameterType("thetaH1", C_PARAM_GENERATED) } else { results$.setParameterType("thetaH1", C_PARAM_DEFAULT_VALUE) } if (stageResults$directionUpper) { standardizedEffect <- log(thetaH1 / stageResults$thetaH0) } else { standardizedEffect <- -log(thetaH1 / stageResults$thetaH0) } ctr <- .getClosedConditionalDunnettTestResults(stageResults = stageResults, design = design, stage = stage) for (g in 1:gMax) { if (!is.na(ctr$separatePValues[g, stage])) { results$conditionalPower[g, 2] <- 1 - stats::pnorm(.getOneMinusQNorm(min(ctr$conditionalErrorRate[ ctr$indices[, g] == 1, stage ], na.rm = TRUE)) - standardizedEffect[g] * sqrt(nPlanned[2])) } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned results$nPlanned <- nPlanned results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$thetaH1 <- thetaH1 return(results) } # # Calculation of conditional power and likelihood values for plotting the graph # .getConditionalPowerLikelihoodSurvivalMultiArm <- function(..., stageResults, stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaRange, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) .associatedArgumentsAreDefined(nPlanned = nPlanned, thetaRange = thetaRange) design <- stageResults$.design kMax <- design$kMax gMax <- stageResults$getGMax() intersectionTest <- stageResults$intersectionTest thetaRange <- .assertIsValidThetaH1ForMultiArm(thetaH1 = thetaRange) if (length(thetaRange) == 1) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'thetaRange' (", .arrayToString(thetaRange), ") must be at least 2" ) } treatmentArms <- numeric(gMax * length(thetaRange)) effectValues <- numeric(gMax * length(thetaRange)) condPowerValues <- numeric(gMax * length(thetaRange)) likelihoodValues <- numeric(gMax * length(thetaRange)) stdErr <- 2 / sqrt(stageResults$.dataInput$getOverallEvents(stage = stage, group = (1:gMax))) results <- ConditionalPowerResultsMultiArmSurvival( .design = design, .stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned ) j <- 1 for (i in seq(along = thetaRange)) { for (g in (1:gMax)) { treatmentArms[j] <- g effectValues[j] <- thetaRange[i] if (.isTrialDesignInverseNormal(design)) { condPowerValues[j] <- .getConditionalPowerSurvivalMultiArmInverseNormal( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i], ... )$conditionalPower[g, kMax] } else if (.isTrialDesignFisher(design)) { condPowerValues[j] <- .getConditionalPowerSurvivalMultiArmFisher( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i], iterations = iterations, seed = seed, ... )$conditionalPower[g, kMax] } else if (.isTrialDesignConditionalDunnett(design)) { condPowerValues[j] <- .getConditionalPowerSurvivalMultiArmConditionalDunnett( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i], ... )$conditionalPower[g, 2] } likelihoodValues[j] <- stats::dnorm( log(thetaRange[i]), log(stageResults$effectSizes[g, stage]), stdErr[g] ) / stats::dnorm(0, 0, stdErr[g]) j <- j + 1 } } subtitle <- paste0( "Intersection test = ", intersectionTest, ", Stage = ", stage, ", # of remaining events = ", sum(nPlanned), ", allocation ratio = ", .formatSubTitleValue(allocationRatioPlanned, "allocationRatioPlanned") ) return(list( treatmentArms = treatmentArms, xValues = effectValues, condPowerValues = condPowerValues, likelihoodValues = likelihoodValues, main = C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, xlab = "Hazard ratio", ylab = C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, sub = subtitle )) } rpact/R/f_design_sample_size_calculator.R0000644000175000017500000067716714153345060020454 0ustar nileshnilesh## | ## | *Sample size calculator* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5615 $ ## | Last changed: $Date: 2021-12-06 09:29:15 +0100 (Mo, 06 Dez 2021) $ ## | Last changed by: $Author: wassmer $ ## | .addEffectScaleBoundaryDataToDesignPlan <- function(designPlan) { .assertIsTrialDesignPlan(designPlan) design <- designPlan$.design if (.isTrialDesignPlanMeans(designPlan)) { if (design$kMax == 1 && designPlan$.isSampleSizeObject()) { designPlan$maxNumberOfSubjects <- designPlan$nFixed } boundaries <- .getEffectScaleBoundaryDataMeans(designPlan) } else if (.isTrialDesignPlanRates(designPlan)) { if (designPlan$.isSampleSizeObject()) { # comes from getSampleSize if (designPlan$groups == 1) { designPlan$directionUpper <- (designPlan$pi1 > designPlan$thetaH0) } else { if (designPlan$riskRatio) { designPlan$directionUpper <- (designPlan$pi1 / designPlan$pi2 > designPlan$thetaH0) } else { designPlan$directionUpper <- (designPlan$pi1 - designPlan$pi2 > designPlan$thetaH0) } } designPlan$.setParameterType("directionUpper", C_PARAM_GENERATED) } if (design$kMax == 1 && designPlan$.isSampleSizeObject()) { designPlan$maxNumberOfSubjects <- designPlan$nFixed } boundaries <- .getEffectScaleBoundaryDataRates(designPlan) } else if (.isTrialDesignPlanSurvival(designPlan)) { if (designPlan$.isSampleSizeObject()) { # comes from getSampleSize designPlan$directionUpper <- (designPlan$hazardRatio > designPlan$thetaH0) designPlan$.setParameterType("directionUpper", C_PARAM_GENERATED) } if (design$kMax == 1 && designPlan$.isSampleSizeObject()) { designPlan$eventsPerStage <- matrix(designPlan$eventsFixed, nrow = 1) } boundaries <- .getEffectScaleBoundaryDataSurvival(designPlan) } if (designPlan$.design$sided == 1) { designPlan$criticalValuesEffectScale <- boundaries$criticalValuesEffectScaleUpper designPlan$.setParameterType("criticalValuesEffectScale", C_PARAM_GENERATED) } else { designPlan$criticalValuesEffectScaleUpper <- boundaries$criticalValuesEffectScaleUpper designPlan$criticalValuesEffectScaleLower <- boundaries$criticalValuesEffectScaleLower designPlan$.setParameterType("criticalValuesEffectScaleUpper", C_PARAM_GENERATED) designPlan$.setParameterType("criticalValuesEffectScaleLower", C_PARAM_GENERATED) } if (!.isTrialDesignFisher(design) && any(design$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { if (design$sided == 1) { designPlan$futilityBoundsEffectScale <- round(boundaries$futilityBoundsEffectScaleUpper, 8) designPlan$.setParameterType("futilityBoundsEffectScale", C_PARAM_GENERATED) } else { designPlan$futilityBoundsEffectScaleUpper <- round(boundaries$futilityBoundsEffectScaleUpper, 8) designPlan$futilityBoundsEffectScaleLower <- round(boundaries$futilityBoundsEffectScaleLower, 8) designPlan$.setParameterType("futilityBoundsEffectScaleLower", C_PARAM_GENERATED) designPlan$.setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_GENERATED) } } } .getEffectScaleBoundaryDataMeans <- function(designPlan) { design <- designPlan$.design thetaH0 <- designPlan$thetaH0 stDev <- designPlan$stDev maxNumberOfSubjects <- designPlan$maxNumberOfSubjects allocationRatioPlanned <- designPlan$allocationRatioPlanned directionUpper <- designPlan$directionUpper futilityBoundsEffectScaleUpper <- rep(NA_real_, design$kMax - 1) # Initialising effect scale matrix futilityBoundsEffectScaleLower <- rep(NA_real_, design$kMax - 1) # Initialising effect scale matrix if (designPlan$normalApproximation) { criticalValues <- design$criticalValues futilityBounds <- design$futilityBounds } else { criticalValues <- stats::qt( 1 - design$stageLevels, design$informationRates %*% t(maxNumberOfSubjects) - designPlan$groups ) criticalValues[criticalValues > 50] <- NA_real_ # outside validated range if (any(is.na(criticalValues))) { warning("At least one computation of efficacy boundaries on effect scale not performed due to too small df", call. = FALSE) } futilityBounds <- stats::qt( stats::pnorm(design$futilityBounds), design$informationRates[1:(design$kMax - 1)] %*% t(maxNumberOfSubjects) - designPlan$groups ) futilityBounds[futilityBounds < -50] <- NA_real_ # outside validated range } futilityBounds[!is.na(futilityBounds) & futilityBounds <= C_FUTILITY_BOUNDS_DEFAULT] <- NA_real_ if (designPlan$groups == 1) { criticalValuesEffectScaleUpper <- thetaH0 + criticalValues * stDev / sqrt(design$informationRates %*% t(maxNumberOfSubjects)) criticalValuesEffectScaleLower <- thetaH0 - criticalValues * stDev / sqrt(design$informationRates %*% t(maxNumberOfSubjects)) if (!.isTrialDesignFisher(design) && !all(is.na(futilityBounds))) { futilityBoundsEffectScaleUpper <- thetaH0 + futilityBounds * stDev / sqrt(design$informationRates[1:(design$kMax - 1)] %*% t(maxNumberOfSubjects)) } if (!.isTrialDesignFisher(design) && design$sided == 2 && design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { futilityBoundsEffectScaleLower <- thetaH0 - futilityBounds * stDev / sqrt(design$informationRates[1:(design$kMax - 1)] %*% t(maxNumberOfSubjects)) } } else if (!designPlan$meanRatio) { criticalValuesEffectScaleUpper <- thetaH0 + criticalValues * stDev * (1 + allocationRatioPlanned) / (sqrt(allocationRatioPlanned * design$informationRates %*% t(maxNumberOfSubjects))) criticalValuesEffectScaleLower <- thetaH0 - criticalValues * stDev * (1 + allocationRatioPlanned) / (sqrt(allocationRatioPlanned * design$informationRates %*% t(maxNumberOfSubjects))) if (!.isTrialDesignFisher(design) && !all(is.na(futilityBounds))) { futilityBoundsEffectScaleUpper <- thetaH0 + futilityBounds * stDev * (1 + allocationRatioPlanned) / (sqrt(allocationRatioPlanned * design$informationRates[1:(design$kMax - 1)] %*% t(maxNumberOfSubjects))) } if (!.isTrialDesignFisher(design) && design$sided == 2 && design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { futilityBoundsEffectScaleLower <- thetaH0 - futilityBounds * stDev * (1 + allocationRatioPlanned) / (sqrt(allocationRatioPlanned * design$informationRates[1:(design$kMax - 1)] %*% t(maxNumberOfSubjects))) } } else { criticalValuesEffectScaleUpper <- thetaH0 + criticalValues * stDev * sqrt(1 + 1 / allocationRatioPlanned + thetaH0^2 * (1 + allocationRatioPlanned)) / (sqrt(design$informationRates %*% t(maxNumberOfSubjects))) criticalValuesEffectScaleLower <- thetaH0 - criticalValues * stDev * sqrt(1 + 1 / allocationRatioPlanned + thetaH0^2 * (1 + allocationRatioPlanned)) / (sqrt(design$informationRates %*% t(maxNumberOfSubjects))) if (!.isTrialDesignFisher(design) && !all(is.na(futilityBounds))) { futilityBoundsEffectScaleUpper <- thetaH0 + futilityBounds * stDev * sqrt(1 + 1 / allocationRatioPlanned + thetaH0^2 * (1 + allocationRatioPlanned)) / (sqrt(design$informationRates[1:(design$kMax - 1)] %*% t(maxNumberOfSubjects))) } if (!.isTrialDesignFisher(design) && design$sided == 2 && design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { futilityBoundsEffectScaleLower <- thetaH0 - futilityBounds * stDev * sqrt(1 + 1 / allocationRatioPlanned + thetaH0^2 * (1 + allocationRatioPlanned)) / (sqrt(design$informationRates[1:(design$kMax - 1)] %*% t(maxNumberOfSubjects))) } } directionUpper[is.na(directionUpper)] <- TRUE if (length(directionUpper) > 0 && all(!directionUpper)) { criticalValuesEffectScaleUpper <- -criticalValuesEffectScaleUpper + 2 * thetaH0 criticalValuesEffectScaleLower <- -criticalValuesEffectScaleLower + 2 * thetaH0 if (!all(is.na(futilityBoundsEffectScaleUpper))) { futilityBoundsEffectScaleUpper <- -futilityBoundsEffectScaleUpper + 2 * thetaH0 futilityBoundsEffectScaleLower <- -futilityBoundsEffectScaleLower + 2 * thetaH0 } } if (designPlan$meanRatio) { criticalValuesEffectScaleUpper[!is.na(criticalValuesEffectScaleUpper) & criticalValuesEffectScaleUpper <= 0] <- NA_real_ criticalValuesEffectScaleLower[!is.na(criticalValuesEffectScaleLower) & criticalValuesEffectScaleLower <= 0] <- NA_real_ futilityBoundsEffectScaleUpper[!is.na(futilityBoundsEffectScaleUpper) & futilityBoundsEffectScaleUpper <= 0] <- NA_real_ futilityBoundsEffectScaleLower[!is.na(futilityBoundsEffectScaleLower) & futilityBoundsEffectScaleLower <= 0] <- NA_real_ } return(list( criticalValuesEffectScaleUpper = matrix(criticalValuesEffectScaleUpper, nrow = design$kMax), criticalValuesEffectScaleLower = matrix(criticalValuesEffectScaleLower, nrow = design$kMax), futilityBoundsEffectScaleUpper = matrix(futilityBoundsEffectScaleUpper, nrow = design$kMax - 1), futilityBoundsEffectScaleLower = matrix(futilityBoundsEffectScaleLower, nrow = design$kMax - 1) )) } .getEffectScaleBoundaryDataRates <- function(designPlan) { design <- designPlan$.design thetaH0 <- designPlan$thetaH0 pi2 <- designPlan$pi2 maxNumberOfSubjects <- designPlan$maxNumberOfSubjects allocationRatioPlanned <- designPlan$allocationRatioPlanned directionUpper <- designPlan$directionUpper nParameters <- length(maxNumberOfSubjects) directionUpper[is.na(directionUpper)] <- TRUE criticalValuesEffectScaleUpper <- matrix(, nrow = design$kMax, ncol = nParameters) criticalValuesEffectScaleLower <- matrix(, nrow = design$kMax, ncol = nParameters) futilityBoundsEffectScaleUpper <- matrix(, nrow = design$kMax - 1, ncol = nParameters) futilityBoundsEffectScaleLower <- matrix(, nrow = design$kMax - 1, ncol = nParameters) if (length(allocationRatioPlanned) == 1) { allocationRatioPlanned <- rep(allocationRatioPlanned, nParameters) } futilityBounds <- design$futilityBounds futilityBounds[!is.na(futilityBounds) & futilityBounds <= C_FUTILITY_BOUNDS_DEFAULT] <- NA_real_ if (designPlan$groups == 1) { n1 <- design$informationRates %*% t(maxNumberOfSubjects) for (j in (1:nParameters)) { criticalValuesEffectScaleUpper[, j] <- thetaH0 + (2 * directionUpper[j] - 1) * design$criticalValues * sqrt(thetaH0 * (1 - thetaH0)) / sqrt(n1[, j]) if (design$sided == 2) { criticalValuesEffectScaleLower[, j] <- thetaH0 - (2 * directionUpper[j] - 1) * design$criticalValues * sqrt(thetaH0 * (1 - thetaH0)) / sqrt(n1[, j]) } if (!.isTrialDesignFisher(design) && !all(is.na(futilityBounds))) { futilityBoundsEffectScaleUpper[, j] <- thetaH0 + (2 * directionUpper[j] - 1) * futilityBounds * sqrt(thetaH0 * (1 - thetaH0)) / sqrt(n1[1:(design$kMax - 1), j]) } if (!.isTrialDesignFisher(design) && design$sided == 2 && design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { futilityBoundsEffectScaleLower[, j] <- thetaH0 - (2 * directionUpper[j] - 1) * futilityBounds * sqrt(thetaH0 * (1 - thetaH0)) / sqrt(n1[1:(design$kMax - 1), j]) } } } else if (!designPlan$riskRatio) { boundaries <- design$criticalValues # calculate pi1 that solves (pi1 - pi2 - thetaH0) / SE(pi1 - pi2 - thetaH0) # = crit by using Farrington & Manning approach for (j in (1:nParameters)) { n1 <- allocationRatioPlanned[j] * design$informationRates * maxNumberOfSubjects[j] / (1 + allocationRatioPlanned[j]) n2 <- n1 / allocationRatioPlanned[j] for (i in (1:length(boundaries))) { tryCatch( { pi1Bound <- uniroot( function(x) { fm <- .getFarringtonManningValues( rate1 = x, rate2 = pi2, theta = thetaH0, allocation = allocationRatioPlanned[j], method = "diff" ) (x - pi2 - thetaH0) / sqrt(fm$ml1 * (1 - fm$ml1) / n1[i] + fm$ml2 * (1 - fm$ml2) / n2[i]) - (2 * directionUpper[j] - 1) * boundaries[i] }, lower = 0, upper = 1, tol = .Machine$double.eps^0.5 )$root }, error = function(e) { pi1Bound <<- NA_real_ } ) criticalValuesEffectScaleUpper[i, j] <- pi1Bound - pi2 # difference to pi2 } if (design$sided == 2) { for (i in (1:length(boundaries))) { tryCatch( { pi1Bound <- uniroot( function(x) { fm <- .getFarringtonManningValues( rate1 = x, rate2 = pi2, theta = thetaH0, allocation = allocationRatioPlanned[j], method = "diff" ) (x - pi2 - thetaH0) / sqrt(fm$ml1 * (1 - fm$ml1) / n1[i] + fm$ml2 * (1 - fm$ml2) / n2[i]) + (2 * directionUpper[j] - 1) * boundaries[i] }, lower = 0, upper = 1, tol = .Machine$double.eps^0.5 )$root }, error = function(e) { pi1Bound <<- NA_real_ } ) criticalValuesEffectScaleLower[i, j] <- pi1Bound - pi2 # difference to pi2 } } } if (!.isTrialDesignFisher(design) && !all(is.na(futilityBounds))) { boundaries <- futilityBounds for (j in (1:nParameters)) { n1 <- allocationRatioPlanned[j] * design$informationRates * maxNumberOfSubjects[j] / (1 + allocationRatioPlanned[j]) n2 <- n1 / allocationRatioPlanned[j] for (i in (1:length(boundaries))) { tryCatch( { pi1Bound <- uniroot( function(x) { fm <- .getFarringtonManningValues( rate1 = x, rate2 = pi2, theta = thetaH0, allocation = allocationRatioPlanned[j], method = "diff" ) (x - pi2 - thetaH0) / sqrt(fm$ml1 * (1 - fm$ml1) / n1[i] + fm$ml2 * (1 - fm$ml2) / n2[i]) - (2 * directionUpper[j] - 1) * boundaries[i] }, lower = 0, upper = 1, tol = .Machine$double.eps^0.5 )$root }, error = function(e) { pi1Bound <<- NA_real_ } ) futilityBoundsEffectScaleUpper[i, j] <- pi1Bound - pi2 # difference to pi2 } } } if (!.isTrialDesignFisher(design) && design$sided == 2 && design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { boundaries <- -futilityBounds for (j in (1:nParameters)) { n1 <- allocationRatioPlanned[j] * design$informationRates * maxNumberOfSubjects[j] / (1 + allocationRatioPlanned[j]) n2 <- n1 / allocationRatioPlanned[j] for (i in (1:length(boundaries))) { tryCatch( { pi1Bound <- uniroot( function(x) { fm <- .getFarringtonManningValues( rate1 = x, rate2 = pi2, theta = thetaH0, allocation = allocationRatioPlanned[j], method = "diff" ) (x - pi2 - thetaH0) / sqrt(fm$ml1 * (1 - fm$ml1) / n1[i] + fm$ml2 * (1 - fm$ml2) / n2[i]) - (2 * directionUpper[j] - 1) * boundaries[i] }, lower = 0, upper = 1, tol = .Machine$double.eps^0.5 )$root }, error = function(e) { pi1Bound <<- NA_real_ } ) futilityBoundsEffectScaleLower[i, j] <- pi1Bound - pi2 # difference to pi2 } } } } else { boundaries <- design$criticalValues # calculate pi1 that solves (pi1 - thetaH0 * pi2) / SE(pi1 - thetaH0 * pi2) # = crit by using Farrington & Manning approach for (j in (1:nParameters)) { n1 <- allocationRatioPlanned[j] * design$informationRates * maxNumberOfSubjects[j] / (1 + allocationRatioPlanned[j]) n2 <- n1 / allocationRatioPlanned[j] for (i in (1:length(boundaries))) { tryCatch( { pi1Bound <- uniroot( function(x) { fm <- .getFarringtonManningValues( rate1 = x, rate2 = pi2, theta = thetaH0, allocation = allocationRatioPlanned[j], method = "ratio" ) (x - thetaH0 * pi2) / sqrt(fm$ml1 * (1 - fm$ml1) / n1[i] + thetaH0^2 * fm$ml2 * (1 - fm$ml2) / n2[i]) - (2 * directionUpper[j] - 1) * boundaries[i] }, lower = 0, upper = 1, tol = .Machine$double.eps^0.5 )$root }, error = function(e) { pi1Bound <<- NA_real_ } ) criticalValuesEffectScaleUpper[i, j] <- pi1Bound / pi2 # ratio to pi2 } if (design$sided == 2) { for (i in (1:length(boundaries))) { tryCatch( { pi1Bound <- uniroot( function(x) { fm <- .getFarringtonManningValues( rate1 = x, rate2 = pi2, theta = thetaH0, allocation = allocationRatioPlanned[j], method = "ratio" ) (x - thetaH0 * pi2) / sqrt(fm$ml1 * (1 - fm$ml1) / n1[i] + thetaH0^2 * fm$ml2 * (1 - fm$ml2) / n2[i]) + (2 * directionUpper[j] - 1) * boundaries[i] }, lower = 0, upper = 1, tol = .Machine$double.eps^0.5 )$root }, error = function(e) { pi1Bound <<- NA_real_ } ) criticalValuesEffectScaleLower[i, j] <- pi1Bound / pi2 # ratio to pi2 } } } if (!.isTrialDesignFisher(design) && !all(is.na(futilityBounds))) { boundaries <- futilityBounds for (j in (1:nParameters)) { n1 <- allocationRatioPlanned[j] * design$informationRates * maxNumberOfSubjects[j] / (1 + allocationRatioPlanned[j]) n2 <- n1 / allocationRatioPlanned[j] for (i in (1:length(boundaries))) { tryCatch( { pi1Bound <- uniroot( function(x) { fm <- .getFarringtonManningValues( rate1 = x, rate2 = pi2, theta = thetaH0, allocation = allocationRatioPlanned[j], method = "ratio" ) (x - thetaH0 * pi2) / sqrt(fm$ml1 * (1 - fm$ml1) / n1[i] + thetaH0^2 * fm$ml2 * (1 - fm$ml2) / n2[i]) - (2 * directionUpper[j] - 1) * boundaries[i] }, lower = 0, upper = 1, tol = .Machine$double.eps^0.5 )$root }, error = function(e) { pi1Bound <<- NA_real_ } ) futilityBoundsEffectScaleUpper[i, j] <- pi1Bound / pi2 # ratio to pi2 } } } if (!.isTrialDesignFisher(design) && design$sided == 2 && design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { boundaries <- -futilityBounds for (j in (1:nParameters)) { n1 <- allocationRatioPlanned[j] * design$informationRates * maxNumberOfSubjects[j] / (1 + allocationRatioPlanned[j]) n2 <- n1 / allocationRatioPlanned[j] for (i in (1:length(boundaries))) { tryCatch( { pi1Bound <- uniroot( function(x) { fm <- .getFarringtonManningValues( rate1 = x, rate2 = pi2, theta = thetaH0, allocation = allocationRatioPlanned[j], method = "ratio" ) (x - thetaH0 * pi2) / sqrt(fm$ml1 * (1 - fm$ml1) / n1[i] + thetaH0^2 * fm$ml2 * (1 - fm$ml2) / n2[i]) - (2 * directionUpper[j] - 1) * boundaries[i] }, lower = 0, upper = 1, tol = .Machine$double.eps^0.5 )$root }, error = function(e) { pi1Bound <<- NA_real_ } ) futilityBoundsEffectScaleLower[i, j] <- pi1Bound / pi2 # ratio to pi2 } } } } return(list( criticalValuesEffectScaleUpper = matrix(criticalValuesEffectScaleUpper, nrow = design$kMax), criticalValuesEffectScaleLower = matrix(criticalValuesEffectScaleLower, nrow = design$kMax), futilityBoundsEffectScaleUpper = matrix(futilityBoundsEffectScaleUpper, nrow = design$kMax - 1), futilityBoundsEffectScaleLower = matrix(futilityBoundsEffectScaleLower, nrow = design$kMax - 1) )) } .getEffectScaleBoundaryDataSurvival <- function(designPlan) { design <- designPlan$.design thetaH0 <- designPlan$thetaH0 eventsPerStage <- designPlan$eventsPerStage allocationRatioPlanned <- designPlan$allocationRatioPlanned directionUpper <- designPlan$directionUpper if (design$kMax == 1) { nParameters <- length(eventsPerStage) } else { nParameters <- ncol(eventsPerStage) } directionUpper[is.na(directionUpper)] <- TRUE if (length(allocationRatioPlanned) == 1) { allocationRatioPlanned <- rep(allocationRatioPlanned, nParameters) } futilityBounds <- design$futilityBounds futilityBounds[!is.na(futilityBounds) & futilityBounds <= C_FUTILITY_BOUNDS_DEFAULT] <- NA_real_ criticalValues <- design$criticalValues criticalValuesEffectScaleUpper <- matrix(, nrow = design$kMax, ncol = nParameters) criticalValuesEffectScaleLower <- matrix(, nrow = design$kMax, ncol = nParameters) futilityBoundsEffectScaleUpper <- matrix(, nrow = design$kMax - 1, ncol = nParameters) futilityBoundsEffectScaleLower <- matrix(, nrow = design$kMax - 1, ncol = nParameters) for (j in (1:nParameters)) { if (design$sided == 1) { criticalValuesEffectScaleUpper[, j] <- thetaH0 * (exp((2 * directionUpper[j] - 1) * criticalValues * (1 + allocationRatioPlanned[j]) / sqrt(allocationRatioPlanned[j] * eventsPerStage[, j]))) } else { criticalValuesEffectScaleUpper[, j] <- thetaH0 * (exp((2 * directionUpper[j] - 1) * criticalValues * (1 + allocationRatioPlanned[j]) / sqrt(allocationRatioPlanned[j] * eventsPerStage[, j]))) criticalValuesEffectScaleLower[, j] <- thetaH0 * (exp(-(2 * directionUpper[j] - 1) * criticalValues * (1 + allocationRatioPlanned[j]) / sqrt(allocationRatioPlanned[j] * eventsPerStage[, j]))) } if (!.isTrialDesignFisher(design) && !all(is.na(futilityBounds))) { futilityBoundsEffectScaleUpper[, j] <- thetaH0 * (exp((2 * directionUpper[j] - 1) * futilityBounds * (1 + allocationRatioPlanned[j]) / sqrt(allocationRatioPlanned[j] * eventsPerStage[1:(design$kMax - 1), j]))) } if (!.isTrialDesignFisher(design) && design$sided == 2 && design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { futilityBoundsEffectScaleLower[, j] <- thetaH0 * (exp(-(2 * directionUpper[j] - 1) * futilityBounds * (1 + allocationRatioPlanned[j]) / sqrt(allocationRatioPlanned[j] * eventsPerStage[1:(design$kMax - 1), j]))) } } return(list( criticalValuesEffectScaleUpper = matrix(criticalValuesEffectScaleUpper, nrow = design$kMax), criticalValuesEffectScaleLower = matrix(criticalValuesEffectScaleLower, nrow = design$kMax), futilityBoundsEffectScaleUpper = matrix(futilityBoundsEffectScaleUpper, nrow = design$kMax - 1), futilityBoundsEffectScaleLower = matrix(futilityBoundsEffectScaleLower, nrow = design$kMax - 1) )) } #' @title #' Get Sample Size Means #' #' @description #' Returns the sample size for testing means in one or two samples. #' #' @inheritParams param_design_with_default #' @inheritParams param_groups #' @param normalApproximation The type of computation of the p-values. If \code{TRUE}, the variance is #' assumed to be known, default is \code{FALSE}, i.e., the calculations are performed #' with the t distribution. #' @param meanRatio If \code{TRUE}, the sample size for #' one-sided testing of H0: \code{mu1 / mu2 = thetaH0} is calculated, default is \code{FALSE}. #' @inheritParams param_thetaH0 #' @inheritParams param_alternative #' @inheritParams param_stDev #' @inheritParams param_allocationRatioPlanned_sampleSize #' @inheritParams param_three_dots #' #' @details #' At given design the function calculates the stage-wise (non-cumulated) and maximum #' sample size for testing means. #' In a two treatment groups design, additionally, an allocation ratio = n1/n2 can be specified. #' A null hypothesis value thetaH0 != 0 for testing the difference of two means or #' thetaH0 != 1 for testing the ratio of two means can be specified. #' Critical bounds and stopping for futility bounds are provided at the effect scale #' (mean, mean difference, or mean ratio, respectively) for each sample size calculation separately. #' #' @template return_object_trial_design_plan #' @template how_to_get_help_for_generics #' #' @family sample size functions #' #' @template examples_get_sample_size_means #' #' @export #' getSampleSizeMeans <- function(design = NULL, ..., groups = 2, normalApproximation = FALSE, meanRatio = FALSE, thetaH0 = ifelse(meanRatio, 1, 0), alternative = seq(0.2, 1, 0.2), # C_ALTERNATIVE_DEFAULT stDev = 1, # C_STDEV_DEFAULT allocationRatioPlanned = NA_real_ # C_ALLOCATION_RATIO_DEFAULT ) { if (is.null(design)) { design <- .getDefaultDesign(..., type = "sampleSize") .warnInCaseOfUnknownArguments( functionName = "getSampleSizeMeans", ignore = .getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = FALSE), ... ) } else { .assertIsTrialDesign(design) .warnInCaseOfUnknownArguments(functionName = "getSampleSizeMeans", ...) .warnInCaseOfTwoSidedPowerArgument(...) } designPlan <- .createDesignPlanMeans( objectType = "sampleSize", design = design, normalApproximation = normalApproximation, meanRatio = meanRatio, thetaH0 = thetaH0, alternative = alternative, stDev = stDev, groups = groups, allocationRatioPlanned = allocationRatioPlanned, ... ) return(.getSampleSize(designPlan)) } .warnInCaseOfTwoSidedPowerArgument <- function(...) { args <- list(...) argNames <- names(args) if ("twoSidedPower" %in% argNames) { warning("'twoSidedPower' can only be defined in 'design'", call. = FALSE) } } .warnInCaseOfTwoSidedPowerIsDisabled <- function(design) { if (design$sided == 2 && !is.na(design$twoSidedPower) && !design$twoSidedPower && design$.getParameterType("twoSidedPower") == C_PARAM_USER_DEFINED) { warning("design$twoSidedPower = FALSE will be ignored because design$sided = 2", call. = FALSE) } } #' @title #' Get Sample Size Rates #' #' @description #' Returns the sample size for testing rates in one or two samples. #' #' @inheritParams param_design_with_default #' @inheritParams param_groups #' @param normalApproximation If \code{FALSE}, the sample size #' for the case of one treatment group is calculated exactly using the binomial distribution, #' default is \code{TRUE}. #' @param riskRatio If \code{TRUE}, the sample size for one-sided #' testing of H0: \code{pi1 / pi2 = thetaH0} is calculated, default is \code{FALSE}. #' @inheritParams param_thetaH0 #' @inheritParams param_pi1_rates #' @inheritParams param_pi2_rates #' @inheritParams param_allocationRatioPlanned_sampleSize #' @inheritParams param_three_dots #' #' @details #' At given design the function calculates the stage-wise (non-cumulated) and maximum sample size for testing rates. #' In a two treatment groups design, additionally, an allocation ratio = n1/n2 can be specified. #' If a null hypothesis value thetaH0 != 0 for testing the difference of two rates #' thetaH0 != 1 for testing the risk ratio is specified, the sample size #' formula according to Farrington & Manning (Statistics in Medicine, 1990) is used. #' Critical bounds and stopping for futility bounds are provided at the effect scale #' (rate, rate difference, or rate ratio, respectively) for each sample size calculation separately. #' For the two-sample case, the calculation here is performed at fixed pi2 as given as argument #' in the function. #' #' @template return_object_trial_design_plan #' @template how_to_get_help_for_generics #' #' @family sample size functions #' #' @template examples_get_sample_size_rates #' #' @export #' getSampleSizeRates <- function(design = NULL, ..., groups = 2, normalApproximation = TRUE, riskRatio = FALSE, thetaH0 = ifelse(riskRatio, 1, 0), pi1 = c(0.4, 0.5, 0.6), # C_PI_1_SAMPLE_SIZE_DEFAULT pi2 = 0.2, # C_PI_2_DEFAULT allocationRatioPlanned = NA_real_ # C_ALLOCATION_RATIO_DEFAULT ) { if (is.null(design)) { design <- .getDefaultDesign(..., type = "sampleSize") .warnInCaseOfUnknownArguments( functionName = "getSampleSizeRates", ignore = .getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = FALSE), ... ) } else { .assertIsTrialDesign(design) .warnInCaseOfUnknownArguments(functionName = "getSampleSizeRates", ...) .warnInCaseOfTwoSidedPowerArgument(...) } designPlan <- .createDesignPlanRates( objectType = "sampleSize", design = design, normalApproximation = normalApproximation, riskRatio = riskRatio, thetaH0 = thetaH0, pi1 = pi1, pi2 = pi2, groups = groups, allocationRatioPlanned = allocationRatioPlanned, ... ) return(.getSampleSize(designPlan)) } # Hidden parameter: # @param accountForObservationTimes If \code{accountForObservationTimes = TRUE}, the number of # subjects is calculated assuming specific accrual and follow-up time, default is \code{TRUE} # (see details). # If \code{accountForObservationTimes = FALSE}, only the event rates are used for the calculation # of the maximum number of subjects. # \code{accountForObservationTimes} can be selected as \code{FALSE}. In this case, # the number of subjects is calculated from the event probabilities only. # This kind of computation does not account for the specific accrual pattern and survival distribution. #' @title #' Get Sample Size Survival #' #' @description #' Returns the sample size for testing the hazard ratio in a two treatment groups survival design. #' #' @inheritParams param_design_with_default #' @inheritParams param_typeOfComputation #' @inheritParams param_allocationRatioPlanned_sampleSize #' @inheritParams param_thetaH0 #' @inheritParams param_lambda1 #' @inheritParams param_lambda2 #' @inheritParams param_pi1_survival #' @inheritParams param_pi2_survival #' @inheritParams param_median1 #' @inheritParams param_median2 #' @inheritParams param_piecewiseSurvivalTime #' @inheritParams param_accrualTime #' @inheritParams param_accrualIntensity #' @inheritParams param_accrualIntensityType #' @inheritParams param_eventTime #' @inheritParams param_hazardRatio #' @inheritParams param_kappa #' @inheritParams param_dropoutRate1 #' @inheritParams param_dropoutRate2 #' @inheritParams param_dropoutTime #' @param followUpTime The assumed (additional) follow-up time for the study, default is \code{6}. #' The total study duration is \code{accrualTime + followUpTime}. #' @param maxNumberOfSubjects If \code{maxNumberOfSubjects > 0} is specified, #' the follow-up time for the required number of events is determined. #' @inheritParams param_three_dots #' #' @details #' At given design the function calculates the number of events and an estimate for the #' necessary number of subjects for testing the hazard ratio in a survival design. #' It also calculates the time when the required events are expected under the given #' assumptions (exponentially, piecewise exponentially, or Weibull distributed survival times #' and constant or non-constant piecewise accrual). #' Additionally, an allocation ratio = \code{n1 / n2} can be specified where \code{n1} and \code{n2} are the number #' of subjects in the two treatment groups. #' #' Optional argument \code{accountForObservationTimes}: if \code{accountForObservationTimes = TRUE}, the number of #' subjects is calculated assuming specific accrual and follow-up time, default is \code{TRUE}. #' #' The formula of Kim & Tsiatis (Biometrics, 1990) #' is used to calculate the expected number of events under the alternative #' (see also Lakatos & Lan, Statistics in Medicine, 1992). These formulas are generalized #' to piecewise survival times and non-constant piecewise accrual over time.\cr #' #' Optional argument \code{accountForObservationTimes}: if \code{accountForObservationTimes = FALSE}, #' only the event rates are used for the calculation of the maximum number of subjects. #' #' @template details_piecewise_survival #' #' @template details_piecewise_accrual #' #' @template return_object_trial_design_plan #' @template how_to_get_help_for_generics #' #' @family sample size functions #' #' @template examples_get_sample_size_survival #' #' @export #' getSampleSizeSurvival <- function(design = NULL, ..., typeOfComputation = c("Schoenfeld", "Freedman", "HsiehFreedman"), thetaH0 = 1, # C_THETA_H0_SURVIVAL_DEFAULT pi1 = NA_real_, pi2 = NA_real_, lambda1 = NA_real_, lambda2 = NA_real_, median1 = NA_real_, median2 = NA_real_, kappa = 1, hazardRatio = NA_real_, piecewiseSurvivalTime = NA_real_, allocationRatioPlanned = NA_real_, # C_ALLOCATION_RATIO_DEFAULT eventTime = 12L, # C_EVENT_TIME_DEFAULT accrualTime = c(0L, 12L), # C_ACCRUAL_TIME_DEFAULT accrualIntensity = 0.1, # C_ACCRUAL_INTENSITY_DEFAULT accrualIntensityType = c("auto", "absolute", "relative"), followUpTime = NA_real_, maxNumberOfSubjects = NA_real_, dropoutRate1 = 0, # C_DROP_OUT_RATE_1_DEFAULT dropoutRate2 = 0, # C_DROP_OUT_RATE_2_DEFAULT dropoutTime = 12L # C_DROP_OUT_TIME_DEFAULT ) { if (is.null(design)) { design <- .getDefaultDesign(..., type = "sampleSize", ignore = c("accountForObservationTimes")) .warnInCaseOfUnknownArguments( functionName = "getSampleSizeSurvival", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = FALSE), "accountForObservationTimes"), ... ) } else { .assertIsTrialDesign(design) .warnInCaseOfUnknownArguments(functionName = "getSampleSizeSurvival", ..., ignore = c("accountForObservationTimes")) .warnInCaseOfTwoSidedPowerArgument(...) } if (!is.na(maxNumberOfSubjects) && maxNumberOfSubjects == 0) { maxNumberOfSubjects <- NA_real_ } # identify accrual time case accrualSetup <- getAccrualTime( accrualTime = accrualTime, accrualIntensity = accrualIntensity, accrualIntensityType = accrualIntensityType, maxNumberOfSubjects = maxNumberOfSubjects, showWarnings = FALSE ) accrualSetup$.validate() accountForObservationTimes <- .getOptionalArgument("accountForObservationTimes", ...) if (is.null(accountForObservationTimes)) { accountForObservationTimes <- TRUE } if (!accrualSetup$maxNumberOfSubjectsCanBeCalculatedDirectly && accrualSetup$followUpTimeMustBeUserDefined) { if (is.na(followUpTime)) { if (accrualSetup$piecewiseAccrualEnabled && !accrualSetup$endOfAccrualIsUserDefined) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'followUpTime', 'maxNumberOfSubjects' or end of accrual must be defined") } stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'followUpTime' or 'maxNumberOfSubjects' must be defined") } if (followUpTime == Inf) { followUpTime <- 1e12 } if (!any(is.na(hazardRatio)) && !is.na(thetaH0)) { .assertIsValidHazardRatio(hazardRatio, thetaH0) } pwst <- getPiecewiseSurvivalTime( piecewiseSurvivalTime = piecewiseSurvivalTime, lambda1 = lambda1, lambda2 = lambda2, pi1 = pi1, pi2 = pi2, median1 = median1, median2 = median2, hazardRatio = hazardRatio, eventTime = eventTime, kappa = kappa, .silent = TRUE ) paramName <- NULL if (!pwst$piecewiseSurvivalEnabled) { if (pwst$.getParameterType("pi1") == C_PARAM_USER_DEFINED || pwst$.getParameterType("pi1") == C_PARAM_DEFAULT_VALUE || pwst$.getParameterType("pi2") == C_PARAM_USER_DEFINED) { paramName <- "pi1" } else if (pwst$.getParameterType("lambda1") == C_PARAM_USER_DEFINED || pwst$.getParameterType("lambda2") == C_PARAM_USER_DEFINED) { paramName <- "lambda1" } else if (pwst$.getParameterType("hazardRatio") == C_PARAM_USER_DEFINED) { paramName <- "hazardRatio" } else if (pwst$.getParameterType("median1") == C_PARAM_USER_DEFINED || pwst$.getParameterType("median2") == C_PARAM_USER_DEFINED) { paramName <- "median1" } } else if (pwst$.getParameterType("hazardRatio") == C_PARAM_USER_DEFINED) { paramName <- "hazardRatio" } if (!is.null(paramName)) { paramValue <- pwst[[paramName]] if (!is.null(paramValue) && length(paramValue) > 1) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the calulation of 'maxNumberOfSubjects' for given 'followUpTime' ", "is only available for a single '", paramName, "'; ", paramName, " = ", .arrayToString( paramValue, vectorLookAndFeelEnabled = TRUE ) ) } } hr <- hazardRatio if (all(is.na(hazardRatio))) { hr <- pwst$hazardRatio } if (all(is.na(hazardRatio))) { .assertIsValidHazardRatio(hr, thetaH0) } maxNumberOfSubjectsTarget <- NA_real_ withCallingHandlers( { # search for accrual time that provides a result at <- accrualSetup$accrualTime additionalAccrual <- 1 searchAccrualTimeEnabled <- TRUE maxSearchIterations <- 50 maxNumberOfSubjectsLower <- NA_real_ maxNumberOfSubjectsLowerBefore <- 0 sampleSize <- NULL expectionMessage <- NA_character_ while (searchAccrualTimeEnabled && maxSearchIterations >= 0 && (is.na(maxNumberOfSubjectsLower) || maxNumberOfSubjectsLower < maxNumberOfSubjectsLowerBefore || maxNumberOfSubjectsLower < 1e8)) { tryCatch( { maxNumberOfSubjectsLowerBefore <- ifelse(is.na(maxNumberOfSubjectsLower), 0, maxNumberOfSubjectsLower) maxNumberOfSubjectsLower <- getAccrualTime( accrualTime = c(at, at[length(at)] + additionalAccrual), accrualIntensity = accrualSetup$accrualIntensity, accrualIntensityType = accrualIntensityType )$maxNumberOfSubjects additionalAccrual <- 2 * additionalAccrual sampleSize <- .getSampleSizeSurvival( design = design, typeOfComputation = typeOfComputation, thetaH0 = thetaH0, pi2 = pi2, pi1 = pi1, allocationRatioPlanned = allocationRatioPlanned, accountForObservationTimes = accountForObservationTimes, eventTime = eventTime, accrualTime = accrualSetup$accrualTime, accrualIntensity = accrualSetup$accrualIntensity, kappa = kappa, piecewiseSurvivalTime = piecewiseSurvivalTime, lambda2 = lambda2, lambda1 = lambda1, median1 = median1, median2 = median2, followUpTime = NA_real_, maxNumberOfSubjects = maxNumberOfSubjectsLower, dropoutRate1 = dropoutRate1, dropoutRate2 = dropoutRate2, dropoutTime = dropoutTime, hazardRatio = hazardRatio ) searchAccrualTimeEnabled <- FALSE }, error = function(e) { expectionMessage <<- e$message } ) maxSearchIterations <- maxSearchIterations - 1 } if (is.null(sampleSize) || is.na(sampleSize$followUpTime)) { if (!is.na(expectionMessage) && grepl("'allocationRatioPlanned' > 0", expectionMessage)) { stop(expectionMessage, call. = FALSE) } stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'additionalAccrual' could not be found, change accrual time specification", call. = FALSE ) } # define lower bound for maxNumberOfSubjects maxNumberOfSubjectsLower <- ceiling(max(na.omit(c( sampleSize$eventsFixed, as.vector(sampleSize$eventsPerStage) )))) if (is.na(maxNumberOfSubjectsLower)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjectsLower' could not be found", call. = FALSE) } # check whether accrual time already fulfills requirement # (followUpTime < given value) or need to be increased, # then define upper bound for maxNumberOfSubjects maxSearchIterations <- 50 maxNumberOfSubjectsUpper <- NA_real_ fut <- sampleSize$followUpTime iterations <- 1 while (fut <= followUpTime) { fut <- 2 * abs(fut) iterations <- iterations + 1 if (iterations > 50) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "search algorithm failed to end", call. = FALSE) } } while (!is.na(fut) && fut > followUpTime && maxSearchIterations >= 0) { maxNumberOfSubjectsUpper <- getAccrualTime( accrualTime = c(at, at[length(at)] + additionalAccrual), accrualIntensity = accrualSetup$accrualIntensity, accrualIntensityType = accrualIntensityType )$maxNumberOfSubjects additionalAccrual <- 2 * additionalAccrual fut <- .getSampleSizeSurvival( design = design, typeOfComputation = typeOfComputation, thetaH0 = thetaH0, pi2 = pi2, pi1 = pi1, allocationRatioPlanned = allocationRatioPlanned, accountForObservationTimes = accountForObservationTimes, eventTime = eventTime, accrualTime = accrualSetup$accrualTime, accrualIntensity = accrualSetup$accrualIntensity, kappa = kappa, piecewiseSurvivalTime = piecewiseSurvivalTime, lambda2 = lambda2, lambda1 = lambda1, median1 = median1, median2 = median2, followUpTime = NA_real_, maxNumberOfSubjects = maxNumberOfSubjectsUpper, dropoutRate1 = dropoutRate1, dropoutRate2 = dropoutRate2, dropoutTime = dropoutTime, hazardRatio = hazardRatio )$followUpTime maxSearchIterations <- maxSearchIterations - 1 } if (is.na(maxNumberOfSubjectsUpper)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'maxNumberOfSubjectsUpper' could not be found ", "(fut = ", fut, ", followUpTime = ", followUpTime, ")", call. = FALSE ) } # use maxNumberOfSubjectsLower and maxNumberOfSubjectsUpper to find end of accrual if (dropoutRate1 != 0 || dropoutRate2 != 0) { # Adjust lower bound for given dropouts assuming exponential distribution if (is.na(allocationRatioPlanned)) { allocationRatioPlanned <- C_ALLOCATION_RATIO_DEFAULT } maxNumberOfSubjectsLower <- maxNumberOfSubjectsLower / ((allocationRatioPlanned * (1 - dropoutRate1)^((accrualSetup$accrualTime[length(accrualSetup$accrualTime)] + additionalAccrual) / dropoutTime) + (1 - dropoutRate2)^((accrualSetup$accrualTime[length(accrualSetup$accrualTime)] + additionalAccrual) / dropoutTime)) / (allocationRatioPlanned + 1)) prec <- 1 maxSearchIterations <- 50 while (prec > 1e-04 && maxSearchIterations >= 0) { maxNumberOfSubjectsTarget <- (maxNumberOfSubjectsLower + maxNumberOfSubjectsUpper) / 2 fut <- .getSampleSizeSurvival( design = design, typeOfComputation = typeOfComputation, thetaH0 = thetaH0, pi2 = pi2, pi1 = pi1, allocationRatioPlanned = allocationRatioPlanned, accountForObservationTimes = accountForObservationTimes, eventTime = eventTime, accrualTime = accrualSetup$accrualTime, accrualIntensity = accrualSetup$accrualIntensity, kappa = kappa, piecewiseSurvivalTime = piecewiseSurvivalTime, lambda2 = lambda2, lambda1 = lambda1, median1 = median1, median2 = median2, followUpTime = NA_real_, maxNumberOfSubjects = maxNumberOfSubjectsTarget, dropoutRate1 = dropoutRate1, dropoutRate2 = dropoutRate2, dropoutTime = dropoutTime, hazardRatio = hazardRatio )$followUpTime ifelse(fut <= followUpTime, maxNumberOfSubjectsUpper <- maxNumberOfSubjectsTarget, maxNumberOfSubjectsLower <- maxNumberOfSubjectsTarget ) prec <- maxNumberOfSubjectsUpper - maxNumberOfSubjectsLower maxSearchIterations <- maxSearchIterations - 1 } } else { maxNumberOfSubjectsTarget <- .getOneDimensionalRootBisectionMethod( fun = function(x) { fut <- .getSampleSizeSurvival( design = design, typeOfComputation = typeOfComputation, thetaH0 = thetaH0, pi2 = pi2, pi1 = pi1, allocationRatioPlanned = allocationRatioPlanned, accountForObservationTimes = accountForObservationTimes, eventTime = eventTime, accrualTime = accrualSetup$accrualTime, accrualIntensity = accrualSetup$accrualIntensity, kappa = kappa, piecewiseSurvivalTime = piecewiseSurvivalTime, lambda2 = lambda2, lambda1 = lambda1, median1 = median1, median2 = median2, followUpTime = NA_real_, maxNumberOfSubjects = x, dropoutRate1 = dropoutRate1, dropoutRate2 = dropoutRate2, dropoutTime = dropoutTime, hazardRatio = hazardRatio )$followUpTime return(followUpTime - fut) }, lower = maxNumberOfSubjectsLower, upper = maxNumberOfSubjectsUpper, tolerance = 1e-04, acceptResultsOutOfTolerance = TRUE, maxSearchIterations = 50, direction = 0, suppressWarnings = FALSE, callingFunctionInformation = "getSampleSizeSurvival" ) } }, warning = function(w) { invokeRestart("muffleWarning") } ) if (is.na(maxNumberOfSubjectsTarget)) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to calculate 'maxNumberOfSubjects' by given 'followUpTime' ", "(lower = ", maxNumberOfSubjectsLower, ", upper = ", maxNumberOfSubjectsUpper, ")" ) } sampleSizeSurvival <- .getSampleSizeSurvival( design = design, typeOfComputation = typeOfComputation, thetaH0 = thetaH0, pi2 = pi2, pi1 = pi1, allocationRatioPlanned = allocationRatioPlanned, accountForObservationTimes = accountForObservationTimes, eventTime = eventTime, accrualTime = accrualSetup$accrualTime, accrualIntensity = accrualSetup$accrualIntensity, kappa = kappa, piecewiseSurvivalTime = piecewiseSurvivalTime, lambda2 = lambda2, lambda1 = lambda1, median1 = median1, median2 = median2, followUpTime = NA_real_, maxNumberOfSubjects = maxNumberOfSubjectsTarget, dropoutRate1 = dropoutRate1, dropoutRate2 = dropoutRate2, dropoutTime = dropoutTime, hazardRatio = hazardRatio ) sampleSizeSurvival$.setParameterType("followUpTime", C_PARAM_USER_DEFINED) sampleSizeSurvival$.accrualTime <- accrualSetup if (!is.na(sampleSizeSurvival$followUpTime)) { if (followUpTime == 1e12) { followUpTime <- Inf } if (sampleSizeSurvival$followUpTime >= -1e-02 && sampleSizeSurvival$followUpTime <= 1e-02) { sampleSizeSurvival$followUpTime <- 0 } if (sampleSizeSurvival$followUpTime < followUpTime - 1e-02 || sampleSizeSurvival$followUpTime > followUpTime + 1e-02) { sampleSizeSurvival$.setParameterType("followUpTime", C_PARAM_GENERATED) warning("User defined 'followUpTime' (", followUpTime, ") ignored because ", "follow-up time is ", round(sampleSizeSurvival$followUpTime, 4), call. = FALSE ) } } sampleSizeSurvival$.setParameterType("maxNumberOfSubjects", C_PARAM_GENERATED) sampleSizeSurvival$.setParameterType("accrualTime", C_PARAM_GENERATED) return(sampleSizeSurvival) } return(.getSampleSizeSurvival( design = design, typeOfComputation = typeOfComputation, thetaH0 = thetaH0, pi2 = pi2, pi1 = pi1, allocationRatioPlanned = allocationRatioPlanned, accountForObservationTimes = accountForObservationTimes, eventTime = eventTime, accrualTime = accrualTime, accrualIntensity = accrualIntensity, accrualIntensityType = accrualIntensityType, kappa = kappa, piecewiseSurvivalTime = piecewiseSurvivalTime, lambda2 = lambda2, lambda1 = lambda1, median1 = median1, median2 = median2, followUpTime = followUpTime, maxNumberOfSubjects = maxNumberOfSubjects, dropoutRate1 = dropoutRate1, dropoutRate2 = dropoutRate2, dropoutTime = dropoutTime, hazardRatio = hazardRatio )) } .getSampleSizeSurvival <- function(..., design = NULL, typeOfComputation = c("Schoenfeld", "Freedman", "HsiehFreedman"), thetaH0 = 1, pi2 = NA_real_, pi1 = NA_real_, allocationRatioPlanned = NA_real_, accountForObservationTimes = TRUE, eventTime = C_EVENT_TIME_DEFAULT, accrualTime = C_ACCRUAL_TIME_DEFAULT, accrualIntensity = C_ACCRUAL_INTENSITY_DEFAULT, accrualIntensityType = c("auto", "absolute", "relative"), kappa = 1, piecewiseSurvivalTime = NA_real_, lambda2 = NA_real_, lambda1 = NA_real_, median1 = NA_real_, median2 = NA_real_, followUpTime = NA_real_, maxNumberOfSubjects = NA_real_, dropoutRate1 = 0, dropoutRate2 = dropoutRate1, dropoutTime = NA_real_, hazardRatio = NA_real_) { designPlan <- .createDesignPlanSurvival( objectType = "sampleSize", design = design, typeOfComputation = typeOfComputation, thetaH0 = thetaH0, pi2 = pi2, pi1 = pi1, allocationRatioPlanned = allocationRatioPlanned, accountForObservationTimes = accountForObservationTimes, eventTime = eventTime, accrualTime = accrualTime, accrualIntensity = accrualIntensity, accrualIntensityType = accrualIntensityType, kappa = kappa, piecewiseSurvivalTime = piecewiseSurvivalTime, lambda2 = lambda2, lambda1 = lambda1, median1 = median1, median2 = median2, followUpTime = followUpTime, maxNumberOfSubjects = maxNumberOfSubjects, dropoutRate1 = dropoutRate1, dropoutRate2 = dropoutRate2, dropoutTime = dropoutTime, hazardRatio = hazardRatio ) return(.getSampleSize(designPlan)) } .createDesignPlanSurvival <- function(..., objectType = c("power", "sampleSize"), design, typeOfComputation = c("Schoenfeld", "Freedman", "HsiehFreedman"), thetaH0, pi2, pi1, allocationRatioPlanned, accountForObservationTimes, eventTime, accrualTime, accrualIntensity, accrualIntensityType, kappa, piecewiseSurvivalTime, lambda2, lambda1, median1, median2, followUpTime = NA_real_, directionUpper = NA, maxNumberOfEvents = NA_real_, maxNumberOfSubjects, dropoutRate1, dropoutRate2, dropoutTime, hazardRatio) { objectType <- match.arg(objectType) typeOfComputation <- .matchArgument(typeOfComputation, "Schoenfeld") .assertIsTrialDesignInverseNormalOrGroupSequential(design) .assertIsValidAlphaAndBeta(design$alpha, design$beta) .assertIsValidSidedParameter(design$sided) .assertIsSingleLogical(accountForObservationTimes, "accountForObservationTimes", naAllowed = TRUE) .assertIsSingleNumber(thetaH0, "thetaH0") .assertIsValidThetaH0(thetaH0, endpoint = "survival", groups = 2) .assertIsValidKappa(kappa) directionUpper <- .assertIsValidDirectionUpper(directionUpper, design$sided, objectType) if (objectType == "power") { .assertIsSingleNumber(maxNumberOfEvents, "maxNumberOfEvents") .assertIsInClosedInterval(maxNumberOfEvents, "maxNumberOfEvents", lower = 1, upper = maxNumberOfSubjects ) } if (!any(is.na(pi1)) && (any(pi1 <= 0) || any(pi1 >= 1))) { stop( C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "event rate 'pi1' (", .arrayToString(pi1), ") is out of bounds (0; 1)" ) } if (!any(is.na(pi2)) && (any(pi2 <= 0) || any(pi2 >= 1))) { stop( C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "event rate 'pi2' (", .arrayToString(pi2), ") is out of bounds (0; 1)" ) } if (design$sided == 2 && thetaH0 != 1) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "two-sided case is implemented for superiority testing only (i.e., thetaH0 = 1)" ) } if (thetaH0 <= 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "null hypothesis hazard ratio is not allowed be negative or zero" ) } if (!(typeOfComputation %in% c("Schoenfeld", "Freedman", "HsiehFreedman"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "computation type ('", typeOfComputation, "') must be one of the following: ", "'Schoenfeld', 'Freedman', or 'HsiehFreedman' " ) } if (typeOfComputation != "Schoenfeld" && thetaH0 != 1) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "Freedman test calculation is possible only for superiority testing (thetaH0 != 1)" ) } if (is.numeric(accrualTime) && all(is.na(accrualTime))) { accrualTime <- C_ACCRUAL_TIME_DEFAULT } if (all(is.na(accrualIntensity))) { accrualIntensity <- C_ACCRUAL_INTENSITY_DEFAULT } accrualSetup <- getAccrualTime( accrualTime = accrualTime, accrualIntensity = accrualIntensity, accrualIntensityType = accrualIntensityType, maxNumberOfSubjects = maxNumberOfSubjects ) accrualSetup$.validate() if (is.na(allocationRatioPlanned)) { allocationRatioPlanned <- C_ALLOCATION_RATIO_DEFAULT } .assertIsValidAllocationRatioPlannedSampleSize(allocationRatioPlanned, maxNumberOfSubjects) designPlan <- TrialDesignPlanSurvival( design = design, typeOfComputation = typeOfComputation, thetaH0 = thetaH0, allocationRatioPlanned = allocationRatioPlanned, accountForObservationTimes = accountForObservationTimes, eventTime = eventTime, accrualTime = accrualSetup$.getAccrualTimeWithoutLeadingZero(), accrualIntensity = accrualSetup$accrualIntensity, kappa = kappa, followUpTime = followUpTime, maxNumberOfSubjects = maxNumberOfSubjects, dropoutRate1 = dropoutRate1, dropoutRate2 = dropoutRate2, dropoutTime = dropoutTime, hazardRatio = hazardRatio ) .setValueAndParameterType( designPlan, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT ) .setValueAndParameterType(designPlan, "dropoutRate1", dropoutRate1, C_DROP_OUT_RATE_1_DEFAULT) .setValueAndParameterType(designPlan, "dropoutRate2", dropoutRate2, C_DROP_OUT_RATE_2_DEFAULT) .setValueAndParameterType(designPlan, "dropoutTime", dropoutTime, C_DROP_OUT_TIME_DEFAULT) .setValueAndParameterType(designPlan, "kappa", kappa, 1) designPlan$.setSampleSizeObject(objectType) designPlan$criticalValuesPValueScale <- matrix(design$stageLevels, ncol = 1) if (design$sided == 2) { designPlan$criticalValuesPValueScale <- designPlan$criticalValuesPValueScale * 2 designPlan$.setParameterType("criticalValuesPValueScale", C_PARAM_GENERATED) } if (any(design$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { designPlan$futilityBoundsPValueScale <- matrix(1 - stats::pnorm(design$futilityBounds), ncol = 1) designPlan$.setParameterType("futilityBoundsPValueScale", C_PARAM_GENERATED) } designPlan$.accrualTime <- accrualSetup designPlan$totalAccrualTime <- accrualSetup$accrualTime[length(accrualSetup$accrualTime)] if (length(accrualSetup$accrualTime) > 2) { designPlan$.setParameterType("totalAccrualTime", C_PARAM_GENERATED) } else { designPlan$.setParameterType("totalAccrualTime", C_PARAM_NOT_APPLICABLE) } if (is.na(maxNumberOfSubjects)) { if (!is.na(accrualSetup$maxNumberOfSubjects)) { designPlan$maxNumberOfSubjects <- accrualSetup$maxNumberOfSubjects designPlan$.setParameterType( "maxNumberOfSubjects", accrualSetup$.getParameterType("maxNumberOfSubjects") ) } } else if (maxNumberOfSubjects == 0) { designPlan$.setParameterType("maxNumberOfSubjects", C_PARAM_GENERATED) } else { designPlan$.setParameterType("maxNumberOfSubjects", C_PARAM_USER_DEFINED) } if (identical(as.integer(accrualSetup$accrualTime), C_ACCRUAL_TIME_DEFAULT) || identical( as.integer(c(0L, accrualSetup$.getAccrualTimeWithoutLeadingZero())), C_ACCRUAL_TIME_DEFAULT )) { designPlan$.setParameterType("accrualTime", C_PARAM_DEFAULT_VALUE) } else { designPlan$.setParameterType("accrualTime", accrualSetup$.getParameterType("accrualTime")) } if (length(designPlan$accrualIntensity) == 1 && designPlan$accrualIntensity == C_ACCRUAL_INTENSITY_DEFAULT) { designPlan$.setParameterType("accrualIntensity", C_PARAM_DEFAULT_VALUE) } else { designPlan$.setParameterType( "accrualIntensity", accrualSetup$.getParameterType("accrualIntensity") ) } .assertIsSingleNumber(designPlan$eventTime, "eventTime") .assertIsSingleNumber(designPlan$allocationRatioPlanned, "allocationRatioPlanned") .assertIsSingleNumber(designPlan$kappa, "kappa") if (objectType == "power") { .assertIsValidMaxNumberOfSubjects(designPlan$maxNumberOfSubjects) } .assertIsSingleNumber(designPlan$dropoutRate1, "dropoutRate1") .assertIsSingleNumber(designPlan$dropoutRate2, "dropoutRate2") .assertIsSingleNumber(designPlan$dropoutTime, "dropoutTime") if (objectType == "power") { pi1Default <- C_PI_1_DEFAULT } else { pi1Default <- C_PI_1_SAMPLE_SIZE_DEFAULT } designPlan$.piecewiseSurvivalTime <- getPiecewiseSurvivalTime( piecewiseSurvivalTime = piecewiseSurvivalTime, lambda2 = lambda2, lambda1 = lambda1, median1 = median1, median2 = median2, hazardRatio = hazardRatio, pi1 = pi1, pi2 = pi2, eventTime = eventTime, kappa = kappa, .pi1Default = pi1Default ) designPlan$.setParameterType("kappa", designPlan$.piecewiseSurvivalTime$.getParameterType("kappa")) if (designPlan$.piecewiseSurvivalTime$.getParameterType("pi1") == C_PARAM_DEFAULT_VALUE && length(designPlan$.piecewiseSurvivalTime$pi1) > 1 && length(accrualSetup$accrualIntensity) > 1 && all(accrualSetup$accrualIntensity < 1)) { designPlan$.piecewiseSurvivalTime$pi1 <- designPlan$.piecewiseSurvivalTime$pi1[1] warning("Only the first default 'pi1' (", designPlan$.piecewiseSurvivalTime$pi1, ") was used ", "because the accrual intensities (", .arrayToString(accrualSetup$accrualIntensity), ") ", "were defined relative (all accrual intensities are < 1)", call. = FALSE ) } .initDesignPlanSurvival(designPlan) designPlan$.setParameterType("followUpTime", C_PARAM_NOT_APPLICABLE) if (designPlan$accountForObservationTimes) { .assertIsSingleNumber(dropoutRate1, "dropoutRate1") .assertIsSingleNumber(dropoutRate2, "dropoutRate2") .assertIsSingleNumber(dropoutTime, "dropoutTime") if (!is.na(dropoutTime) && dropoutTime <= 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dropoutTime' (", dropoutTime, ") must be > 0") } if (dropoutRate1 < 0 || dropoutRate1 >= 1) { stop( C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'dropoutRate1' (", dropoutRate1, ") is out of bounds [0; 1)" ) } if (dropoutRate2 < 0 || dropoutRate2 >= 1) { stop( C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'dropoutRate2' (", dropoutRate2, ") is out of bounds [0; 1)" ) } if (!is.na(eventTime) && eventTime <= 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'eventTime' (", eventTime, ") must be > 0") } .assertIsValidAccrualTime(accrualSetup$.getAccrualTimeWithoutLeadingZero()) .assertIsValidFollowUpTime(followUpTime) .setValueAndParameterType(designPlan, "followUpTime", followUpTime, C_FOLLOW_UP_TIME_DEFAULT) if (.isUserDefinedMaxNumberOfSubjects(designPlan) && !is.null(followUpTime) && length(followUpTime) == 1 && !is.na(followUpTime)) { warning("Follow-up time will be calculated, value entered (", followUpTime, ") is not taken into account", call. = FALSE ) } else if (is.na(followUpTime)) { designPlan$followUpTime <- C_FOLLOW_UP_TIME_DEFAULT designPlan$.setParameterType("followUpTime", C_PARAM_DEFAULT_VALUE) } if (objectType == "power") { designPlan$followUpTime <- NA_real_ designPlan$.setParameterType("followUpTime", C_PARAM_NOT_APPLICABLE) } } else { for (p in c( "accrualTime", "accrualIntensity", "eventTime", "dropoutRate1", "dropoutRate2", "dropoutTime", "followUpTime", "analysisTime", "studyDuration" )) { designPlan$.setParameterType(p, C_PARAM_NOT_APPLICABLE) } if (designPlan$.getParameterType("accrualTime") == C_PARAM_USER_DEFINED || !identical(accrualTime, C_ACCRUAL_TIME_DEFAULT)) { designPlan$.warnInCaseArgumentExists(accrualSetup$accrualTime, "accrualTime") } if (!identical(eventTime, C_EVENT_TIME_DEFAULT)) { designPlan$.warnInCaseArgumentExists(eventTime, "eventTime") } designPlan$.warnInCaseArgumentExists(dropoutRate1, "dropoutRate1") designPlan$.warnInCaseArgumentExists(dropoutRate2, "dropoutRate2") if (!identical(dropoutTime, C_DROP_OUT_TIME_DEFAULT)) { designPlan$.warnInCaseArgumentExists(dropoutTime, "dropoutTime") } designPlan$.warnInCaseArgumentExists(maxNumberOfSubjects, "maxNumberOfSubjects") if (!identical(followUpTime, C_FOLLOW_UP_TIME_DEFAULT)) { designPlan$.warnInCaseArgumentExists(followUpTime, "followUpTime") } } .setValueAndParameterType(designPlan, "directionUpper", directionUpper, TRUE) if (objectType == "power") { .setValueAndParameterType(designPlan, "maxNumberOfEvents", maxNumberOfEvents, NA_real_) designPlan$.setParameterType("accountForObservationTimes", C_PARAM_NOT_APPLICABLE) } return(designPlan) } .isUserDefinedMaxNumberOfSubjects <- function(designPlan) { if (!is.null(designPlan) && length(designPlan$.getParameterType("maxNumberOfSubjects")) > 0) { if (designPlan$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { return(TRUE) } } return(!is.null(designPlan$maxNumberOfSubjects) && length(designPlan$maxNumberOfSubjects) == 1 && !is.na(designPlan$maxNumberOfSubjects) && designPlan$maxNumberOfSubjects > 0) } .initDesignPlanSurvivalByPiecewiseSurvivalTimeObject <- function(designPlan, pwstSetup) { designPlan$pi1 <- pwstSetup$pi1 designPlan$.setParameterType("pi1", pwstSetup$.getParameterType("pi1")) designPlan$pi2 <- pwstSetup$pi2 designPlan$.setParameterType("pi2", pwstSetup$.getParameterType("pi2")) designPlan$hazardRatio <- pwstSetup$hazardRatio designPlan$.setParameterType("hazardRatio", pwstSetup$.getParameterType("hazardRatio")) designPlan$lambda1 <- pwstSetup$lambda1 designPlan$.setParameterType("lambda1", pwstSetup$.getParameterType("lambda1")) designPlan$lambda2 <- pwstSetup$lambda2 designPlan$.setParameterType("lambda2", pwstSetup$.getParameterType("lambda2")) designPlan$median1 <- pwstSetup$median1 designPlan$.setParameterType("median1", pwstSetup$.getParameterType("median1")) designPlan$median2 <- pwstSetup$median2 designPlan$.setParameterType("median2", pwstSetup$.getParameterType("median2")) designPlan$piecewiseSurvivalTime <- pwstSetup$piecewiseSurvivalTime designPlan$.setParameterType( "piecewiseSurvivalTime", pwstSetup$.getParameterType("piecewiseSurvivalTime") ) designPlan$eventTime <- pwstSetup$eventTime designPlan$.setParameterType("eventTime", pwstSetup$.getParameterType("eventTime")) if (pwstSetup$.isLambdaBased()) { return(length(designPlan$hazardRatio)) } return(length(designPlan$pi1)) } .initDesignPlanSurvival <- function(designPlan) { numberOfResults <- .initDesignPlanSurvivalByPiecewiseSurvivalTimeObject( designPlan, designPlan$.piecewiseSurvivalTime) if (designPlan$.piecewiseSurvivalTime$.isLambdaBased()) { if (length(designPlan$accountForObservationTimes) == 0 || is.na(designPlan$accountForObservationTimes) || !designPlan$accountForObservationTimes) { designPlan$accountForObservationTimes <- TRUE designPlan$.setParameterType("accountForObservationTimes", C_PARAM_DEFAULT_VALUE) } if (!designPlan$accountForObservationTimes) { designPlan$accountForObservationTimes <- TRUE warning("'accountForObservationTimes' was set to TRUE ", "because piecewise exponential survival function is enabled", call. = FALSE ) } } else { if (.isUserDefinedMaxNumberOfSubjects(designPlan)) { if (length(designPlan$accountForObservationTimes) != 0 && !is.na(designPlan$accountForObservationTimes) && !designPlan$accountForObservationTimes) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accountForObservationTimes' must be TRUE because 'maxNumberOfSubjects' is > 0" ) } designPlan$.setParameterType("accountForObservationTimes", C_PARAM_GENERATED) designPlan$accountForObservationTimes <- TRUE } else { if (length(designPlan$accountForObservationTimes) == 0 || is.na(designPlan$accountForObservationTimes)) { designPlan$accountForObservationTimes <- FALSE designPlan$.setParameterType("accountForObservationTimes", C_PARAM_DEFAULT_VALUE) } else { designPlan$.setParameterType( "accountForObservationTimes", ifelse(designPlan$accountForObservationTimes, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED ) ) } } } designPlan$.setParameterType("omega", C_PARAM_NOT_APPLICABLE) if (designPlan$.isSampleSizeObject()) { designPlan$.setParameterType("directionUpper", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("maxNumberOfEvents", C_PARAM_NOT_APPLICABLE) } return(numberOfResults = numberOfResults) } .warnInCaseOfDefinedPiValue <- function(designPlan, piValueName) { piValue <- designPlan[[piValueName]] if (!is.null(piValue) && !is.na(piValue) && length(piValue) > 0) { designPlan$.setParameterType(piValueName, C_PARAM_NOT_APPLICABLE) warning("'pi2' (", .arrayToString(piValue), ") will be ignored ", "because piecewise exponential survival function is enabled", call. = FALSE ) designPlan[[piValueName]] <- NA_real_ } } .getSampleSize <- function(designPlan) { if (.isTrialDesignPlanMeans(designPlan) || .isTrialDesignPlanRates(designPlan)) { if (identical(designPlan$allocationRatioPlanned, 0)) { designPlan$optimumAllocationRatio <- TRUE designPlan$.setParameterType("optimumAllocationRatio", C_PARAM_USER_DEFINED) } if (.isTrialDesignPlanMeans(designPlan)) { sampleSizeFixed <- .getSampleSizeFixedMeans( alpha = designPlan$getAlpha(), beta = designPlan$getBeta(), sided = designPlan$getSided(), twoSidedPower = designPlan$getTwoSidedPower(), normalApproximation = designPlan$normalApproximation, meanRatio = designPlan$meanRatio, thetaH0 = designPlan$thetaH0, alternative = designPlan$alternative, stDev = designPlan$stDev, groups = designPlan$groups, allocationRatioPlanned = designPlan$allocationRatioPlanned ) } else { sampleSizeFixed <- .getSampleSizeFixedRates( alpha = designPlan$getAlpha(), beta = designPlan$getBeta(), sided = designPlan$getSided(), normalApproximation = designPlan$normalApproximation, riskRatio = designPlan$riskRatio, thetaH0 = designPlan$thetaH0, pi1 = designPlan$pi1, pi2 = designPlan$pi2, groups = designPlan$groups, allocationRatioPlanned = designPlan$allocationRatioPlanned ) } # Fixed designPlan$nFixed <- sampleSizeFixed$nFixed designPlan$.setParameterType("nFixed", C_PARAM_GENERATED) if (designPlan$groups == 2) { designPlan$nFixed1 <- sampleSizeFixed$n1Fixed designPlan$nFixed2 <- sampleSizeFixed$n2Fixed designPlan$.setParameterType("nFixed1", C_PARAM_GENERATED) designPlan$.setParameterType("nFixed2", C_PARAM_GENERATED) designPlan$numberOfSubjects1 <- matrix(designPlan$nFixed1, nrow = 1) designPlan$numberOfSubjects2 <- matrix(designPlan$nFixed2, nrow = 1) } designPlan$numberOfSubjects <- matrix(designPlan$nFixed, nrow = 1) if (!is.null(sampleSizeFixed$allocationRatioPlanned) && (length(designPlan$allocationRatioPlanned) != length(sampleSizeFixed$allocationRatioPlanned) || sum(designPlan$allocationRatioPlanned == sampleSizeFixed$allocationRatioPlanned) != length(designPlan$allocationRatioPlanned))) { designPlan$allocationRatioPlanned <- sampleSizeFixed$allocationRatioPlanned designPlan$.setParameterType("allocationRatioPlanned", C_PARAM_GENERATED) } # Sequential if (designPlan$.design$kMax > 1) { designCharacteristics <- getDesignCharacteristics(designPlan$.design) if (.isTrialDesignPlanMeans(designPlan)) { sampleSizeSequential <- .getSampleSizeSequentialMeans( sampleSizeFixed, designCharacteristics ) } else { sampleSizeSequential <- .getSampleSizeSequentialRates( sampleSizeFixed, designCharacteristics ) } designPlan$informationRates <- sampleSizeSequential$informationRates if (ncol(designPlan$informationRates) == 1 && identical(designPlan$informationRates[, 1], designPlan$.design$informationRates)) { designPlan$.setParameterType("informationRates", C_PARAM_NOT_APPLICABLE) } else { designPlan$.setParameterType("informationRates", C_PARAM_GENERATED) } designPlan$maxNumberOfSubjects <- sampleSizeSequential$maxNumberOfSubjects designPlan$.setParameterType("maxNumberOfSubjects", C_PARAM_GENERATED) if (designPlan$groups == 2) { designPlan$maxNumberOfSubjects1 <- .getNumberOfSubjects1( designPlan$maxNumberOfSubjects, designPlan$allocationRatioPlanned ) designPlan$maxNumberOfSubjects2 <- .getNumberOfSubjects2( designPlan$maxNumberOfSubjects, designPlan$allocationRatioPlanned ) designPlan$.setParameterType("maxNumberOfSubjects1", C_PARAM_GENERATED) designPlan$.setParameterType("maxNumberOfSubjects2", C_PARAM_GENERATED) } designPlan$numberOfSubjects <- sampleSizeSequential$numberOfSubjects designPlan$.setParameterType("numberOfSubjects", C_PARAM_GENERATED) if (designPlan$groups == 2) { designPlan$numberOfSubjects1 <- sampleSizeSequential$numberOfSubjects1 designPlan$numberOfSubjects2 <- sampleSizeSequential$numberOfSubjects2 designPlan$.setParameterType("numberOfSubjects1", C_PARAM_GENERATED) designPlan$.setParameterType("numberOfSubjects2", C_PARAM_GENERATED) } designPlan$expectedNumberOfSubjectsH0 <- sampleSizeSequential$expectedNumberOfSubjectsH0 designPlan$expectedNumberOfSubjectsH01 <- sampleSizeSequential$expectedNumberOfSubjectsH01 designPlan$expectedNumberOfSubjectsH1 <- sampleSizeSequential$expectedNumberOfSubjectsH1 designPlan$.setParameterType("expectedNumberOfSubjectsH0", C_PARAM_GENERATED) designPlan$.setParameterType("expectedNumberOfSubjectsH01", C_PARAM_GENERATED) designPlan$.setParameterType("expectedNumberOfSubjectsH1", C_PARAM_GENERATED) designPlan$.setParameterType("eventsFixed", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("nFixed1", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("nFixed2", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("nFixed", C_PARAM_NOT_APPLICABLE) if (designPlan$allocationRatioPlanned[1] == 1) { designPlan$.setParameterType("numberOfSubjects1", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("numberOfSubjects2", C_PARAM_NOT_APPLICABLE) } if (!is.null(sampleSizeSequential$rejectPerStage)) { designPlan$rejectPerStage <- matrix(sampleSizeSequential$rejectPerStage, nrow = designPlan$.design$kMax ) designPlan$.setParameterType("rejectPerStage", C_PARAM_GENERATED) designPlan$earlyStop <- sum(designPlan$rejectPerStage[1:(designPlan$.design$kMax - 1), ]) designPlan$.setParameterType("earlyStop", C_PARAM_GENERATED) } if (!is.null(sampleSizeSequential$futilityPerStage) && any(designPlan$.design$futilityBounds != C_FUTILITY_BOUNDS_DEFAULT)) { designPlan$futilityPerStage <- matrix(sampleSizeSequential$futilityPerStage, nrow = designPlan$.design$kMax - 1 ) designPlan$.setParameterType("futilityPerStage", C_PARAM_GENERATED) designPlan$futilityStop <- sum(designPlan$futilityPerStage) designPlan$.setParameterType("futilityStop", C_PARAM_GENERATED) designPlan$earlyStop <- designPlan$earlyStop + sum(designPlan$futilityPerStage) } } .addEffectScaleBoundaryDataToDesignPlan(designPlan) return(designPlan) } else if (.isTrialDesignPlanSurvival(designPlan)) { # Fixed designPlan <- .getSampleSizeFixedSurvival(designPlan) # Sequential if (designPlan$.design$kMax > 1) { designCharacteristics <- getDesignCharacteristics(designPlan$.design) designPlan <- .getSampleSizeSequentialSurvival(designPlan, designCharacteristics) } if (designPlan$accountForObservationTimes && !any(is.na(designPlan$followUpTime)) && all(designPlan$followUpTime == C_FOLLOW_UP_TIME_DEFAULT)) { designPlan$.setParameterType("followUpTime", C_PARAM_DEFAULT_VALUE) } .addEffectScaleBoundaryDataToDesignPlan(designPlan) if (designPlan$.getParameterType("maxNumberOfSubjects") == C_PARAM_GENERATED && designPlan$.accrualTime$.getParameterType("maxNumberOfSubjects") != C_PARAM_GENERATED && all(designPlan$accrualIntensity < 1)) { numberOfDefinedAccrualIntensities <- length(designPlan$accrualIntensity) accrualTime <- designPlan$accrualTime if (length(accrualTime) > 0 && accrualTime[1] != 0) { accrualTime <- c(0, accrualTime) } if (any(designPlan$accrualIntensity < 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualIntensityRelative' (", .arrayToString(designPlan$accrualIntensity), ") must be >= 0" ) } designPlan$accrualIntensityRelative <- designPlan$accrualIntensity if (identical(designPlan$accrualIntensityRelative, C_ACCRUAL_INTENSITY_DEFAULT)) { designPlan$.setParameterType("accrualIntensityRelative", C_PARAM_NOT_APPLICABLE) } else { designPlan$.setParameterType( "accrualIntensityRelative", designPlan$.getParameterType("accrualIntensity") ) } accrualIntensityAbsolute <- c() for (maxNumberOfSubjects in designPlan$maxNumberOfSubjects) { accrualSetup <- getAccrualTime( accrualTime = accrualTime, accrualIntensity = designPlan$accrualIntensityRelative, accrualIntensityType = "relative", maxNumberOfSubjects = maxNumberOfSubjects ) accrualIntensityAbsolute <- c(accrualIntensityAbsolute, accrualSetup$accrualIntensity) } designPlan$accrualIntensity <- accrualIntensityAbsolute designPlan$.setParameterType("accrualIntensity", C_PARAM_GENERATED) if (numberOfDefinedAccrualIntensities > 1) { paramName <- NULL if (designPlan$.getParameterType("pi1") == C_PARAM_USER_DEFINED || designPlan$.getParameterType("pi1") == C_PARAM_DEFAULT_VALUE || designPlan$.getParameterType("pi2") == C_PARAM_USER_DEFINED) { paramName <- "pi1" } else if (designPlan$.getParameterType("median1") == C_PARAM_USER_DEFINED || designPlan$.getParameterType("median2") == C_PARAM_USER_DEFINED) { paramName <- "median1" } if (!is.null(paramName)) { paramValue <- designPlan[[paramName]] if (!is.null(paramValue) && length(paramValue) > 1) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the definition of relative accrual intensities ", "(all 'accrualIntensity' values < 1) ", "is only available for a single value ", "(", paramName, " = ", .arrayToString( paramValue, vectorLookAndFeelEnabled = TRUE ), ")" ) } } } } designPlan$maxNumberOfEvents <- designPlan$eventsPerStage[designPlan$.design$kMax, ] designPlan$.setParameterType("maxNumberOfEvents", C_PARAM_GENERATED) if (!any(is.na(designPlan$followUpTime))) { if (any(designPlan$followUpTime < -1e-02)) { warning("Accrual duration longer than maximal study ", "duration (time to maximal number of events); followUpTime = ", .arrayToString(designPlan$followUpTime), call. = FALSE ) } } else { indices <- which(is.na(designPlan$followUpTime)) warning("Follow-up time could not be calculated for pi1 = ", .arrayToString(designPlan$pi1[indices]), call. = FALSE ) } if (designPlan$.getParameterType("accountForObservationTimes") != C_PARAM_USER_DEFINED) { designPlan$.setParameterType("accountForObservationTimes", C_PARAM_NOT_APPLICABLE) } designPlan$.setParameterType("omega", C_PARAM_NOT_APPLICABLE) .addStudyDurationToDesignPlan(designPlan) return(designPlan) } stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "unknown trial plan class '", class(designPlan), "'") } .checkFollowUpTime <- function(followUpTime) { if (is.null(followUpTime) || length(followUpTime) == 0) { return(invisible()) } naFollowUpTimes <- c() negativeFollowUpTimes <- c() for (i in 1:length(followUpTime)) { if (is.na(followUpTime[i])) { naFollowUpTimes <- c(naFollowUpTimes, i) } else if (followUpTime[i] < -1e-02) { negativeFollowUpTimes <- c(negativeFollowUpTimes, i) } } if (length(negativeFollowUpTimes) > 0) { warning("Accrual duration longer than maximal study ", "duration (time to maximal number of events; 'followUpTime' = ", .arrayToString(followUpTime), ")", call. = FALSE ) } if (length(naFollowUpTimes) > 0) { if (length(naFollowUpTimes) == 1) { warning("Follow-up time could not be calculated", call. = FALSE) } else { warning("Follow-up time 'followUpTime[1]' could not be calculated", call. = FALSE) } } } .getSampleSizeFixedMeans <- function(..., alpha = 0.025, beta = 0.2, sided = 1, twoSidedPower = C_TWO_SIDED_POWER_DEFAULT, normalApproximation = FALSE, meanRatio = FALSE, thetaH0 = 0, alternative = C_ALTERNATIVE_DEFAULT, stDev = C_STDEV_DEFAULT, groups = 2, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT) { nFixed <- rep(NA_real_, length(alternative)) for (i in 1:length(alternative)) { theta <- alternative[i] if (groups == 1) { if (sided == 1 || !twoSidedPower) { if (normalApproximation == FALSE) { up <- 2 while (stats::pt( stats::qt(1 - alpha / sided, up - 1), max(0.001, up - 1), sqrt(up) * abs(theta - thetaH0) / stDev ) > beta) { up <- 2 * up } nFixed[i] <- .getOneDimensionalRoot( function(n) { return(stats::pt( stats::qt(1 - alpha / sided, max(0.001, n - 1)), max(0.001, n - 1), sqrt(n) * abs(theta - thetaH0) / stDev ) - beta) }, lower = 0.001, upper = up, tolerance = 1e-04, callingFunctionInformation = ".getSampleSizeFixedMeans" ) } else { nFixed[i] <- (.getOneMinusQNorm(alpha / sided) + .getOneMinusQNorm(beta))^2 / ((theta - thetaH0) / stDev)^2 } } else { up <- 2 while (stats::pt( stats::qt(1 - alpha / 2, max(0.001, up - 1)), max(0.001, up - 1), sqrt(up) * (theta - thetaH0) / stDev ) - stats::pt( -stats::qt(1 - alpha / 2, max(0.001, up - 1)), max(0.001, up - 1), sqrt(up) * (theta - thetaH0) / stDev ) > beta) { up <- 2 * up } if (normalApproximation == FALSE) { nFixed[i] <- .getOneDimensionalRoot( function(n) { return(stats::pt( stats::qt(1 - alpha / 2, max(0.001, n - 1)), max(0.001, n - 1), sqrt(n) * (theta - thetaH0) / stDev ) - stats::pt( -stats::qt(1 - alpha / 2, max(0.001, n - 1)), max(0.001, n - 1), sqrt(n) * (theta - thetaH0) / stDev ) - beta) }, lower = 0.001, upper = up, tolerance = 1e-04, callingFunctionInformation = ".getSampleSizeFixedMeans" ) } else { nFixed[i] <- .getOneDimensionalRoot( function(n) { return(stats::pnorm(.getOneMinusQNorm(alpha / 2) - sqrt(n) * (theta - thetaH0) / stDev) - stats::pnorm(-.getOneMinusQNorm(alpha / 2) - sqrt(n) * (theta - thetaH0) / stDev) - beta) }, lower = 0.001, upper = up, tolerance = 1e-04, callingFunctionInformation = ".getSampleSizeFixedMeans" ) } } } else if (groups == 2) { if (sided == 1 || !twoSidedPower) { if (!meanRatio) { # allocationRatioPlanned = 0 provides optimum sample size if (allocationRatioPlanned == 0) { allocationRatioPlanned <- 1 } if (normalApproximation == FALSE) { up <- 2 while (stats::pt( stats::qt(1 - alpha / sided, up * (1 + allocationRatioPlanned) - 2), up * (1 + allocationRatioPlanned) - 2, sqrt(up) * sqrt(allocationRatioPlanned / (1 + allocationRatioPlanned)) * abs(theta - thetaH0) / stDev ) > beta) { up <- 2 * up } n2Fixed <- .getOneDimensionalRoot( function(x) { return(stats::pt( stats::qt(1 - alpha / sided, max( 0.001, x * (1 + allocationRatioPlanned) - 2 )), max(0.001, x * (1 + allocationRatioPlanned) - 2), sqrt(x) * sqrt(allocationRatioPlanned / (1 + allocationRatioPlanned)) * abs(theta - thetaH0) / stDev ) - beta) }, lower = 0.001, upper = up, tolerance = 1e-04, callingFunctionInformation = ".getSampleSizeFixedMeans" ) nFixed[i] <- n2Fixed * (1 + allocationRatioPlanned) } else { nFixed[i] <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * (.getOneMinusQNorm(alpha / sided) + .getOneMinusQNorm(beta))^2 / ((theta - thetaH0) / stDev)^2 } } else { # allocationRatioPlanned = 0 provides optimum sample size if (allocationRatioPlanned == 0) { allocationRatioPlanned <- 1 / thetaH0 } if (!normalApproximation) { up <- 2 while (stats::pt( stats::qt( 1 - alpha / sided, up * (1 + allocationRatioPlanned) - 2 ), up * (1 + allocationRatioPlanned) - 2, sqrt(up * allocationRatioPlanned / (1 + allocationRatioPlanned * thetaH0^2)) * abs(theta - thetaH0) / stDev ) > beta) { up <- 2 * up } n2Fixed <- .getOneDimensionalRoot( function(n2) { return(stats::pt( stats::qt(1 - alpha / sided, max( 0.001, n2 * (1 + allocationRatioPlanned) - 2 )), max(0.001, n2 * (1 + allocationRatioPlanned) - 2), sqrt(n2 * allocationRatioPlanned / (1 + allocationRatioPlanned * thetaH0^2)) * abs(theta - thetaH0) / stDev ) - beta) }, lower = 0.001, upper = up, tolerance = 1e-04, callingFunctionInformation = ".getSampleSizeFixedMeans" ) nFixed[i] <- n2Fixed * (1 + allocationRatioPlanned) } else { nFixed[i] <- (1 + 1 / allocationRatioPlanned + thetaH0^2 * (1 + allocationRatioPlanned)) * (.getOneMinusQNorm(alpha / sided) + .getOneMinusQNorm(beta))^2 / ((theta - thetaH0) / stDev)^2 } } } else { if (!normalApproximation) { if (allocationRatioPlanned == 0) { allocationRatioPlanned <- 1 } up <- 2 while (stats::pt( stats::qt(1 - alpha / 2, max(0.001, up * (1 + allocationRatioPlanned) - 2)), max(0.001, up * (1 + allocationRatioPlanned) - 2), sqrt(up) * sqrt(allocationRatioPlanned / (1 + allocationRatioPlanned)) * (theta - thetaH0) / stDev ) - stats::pt( -stats::qt( 1 - alpha / 2, up * (1 + allocationRatioPlanned) - 2 ), up * (1 + allocationRatioPlanned) - 2, sqrt(up) * sqrt(allocationRatioPlanned / (1 + allocationRatioPlanned)) * (theta - thetaH0) / stDev ) > beta) { up <- 2 * up } n2Fixed <- .getOneDimensionalRoot( function(n2) { return(stats::pt( stats::qt(1 - alpha / 2, max(0.001, n2 * (1 + allocationRatioPlanned) - 2)), max(0.001, n2 * (1 + allocationRatioPlanned) - 2), sqrt(n2) * sqrt(allocationRatioPlanned / (1 + allocationRatioPlanned)) * (theta - thetaH0) / stDev ) - stats::pt( -stats::qt( 1 - alpha / 2, max(0.001, n2 * (1 + allocationRatioPlanned) - 2) ), max(0.001, n2 * (1 + allocationRatioPlanned) - 2), sqrt(n2) * sqrt(allocationRatioPlanned / (1 + allocationRatioPlanned)) * (theta - thetaH0) / stDev ) - beta) }, lower = 0.001, upper = up, tolerance = 1e-04, callingFunctionInformation = ".getSampleSizeFixedMeans" ) nFixed[i] <- n2Fixed * (1 + allocationRatioPlanned) } else { up <- 2 while (stats::pnorm(.getOneMinusQNorm(alpha / 2) - sqrt(up / 4) * (theta - thetaH0) / stDev) - stats::pnorm(-.getOneMinusQNorm(alpha / 2) - sqrt(up / 4) * (theta - thetaH0) / stDev) > beta) { up <- 2 * up } nFixed[i] <- (1 + allocationRatioPlanned)^2 / (4 * allocationRatioPlanned) * .getOneDimensionalRoot( function(n) { return(stats::pnorm(.getOneMinusQNorm(alpha / 2) - sqrt(n / 4) * (theta - thetaH0) / stDev) - stats::pnorm(-.getOneMinusQNorm(alpha / 2) - sqrt(n / 4) * (theta - thetaH0) / stDev) - beta) }, lower = 0.001, upper = up, tolerance = 1e-04, callingFunctionInformation = ".getSampleSizeFixedMeans" ) } } } } if (groups == 1) { return(list( alpha = alpha, beta = beta, sided = sided, groups = groups, thetaH0 = thetaH0, alternative = alternative, stDev = stDev, normalApproximation = normalApproximation, nFixed = nFixed )) } else if (groups == 2) { n1Fixed <- nFixed * allocationRatioPlanned / (1 + allocationRatioPlanned) n2Fixed <- n1Fixed / allocationRatioPlanned return(list( alpha = alpha, beta = beta, sided = sided, groups = groups, allocationRatioPlanned = allocationRatioPlanned, thetaH0 = thetaH0, meanRatio = meanRatio, alternative = alternative, stDev = stDev, normalApproximation = normalApproximation, n1Fixed = n1Fixed, n2Fixed = n2Fixed, nFixed = nFixed )) } } .getSampleSizeSequentialMeans <- function(fixedSampleSize, designCharacteristics) { kMax <- designCharacteristics$.design$kMax numberOfSubjects <- matrix(NA_real_, kMax, length(fixedSampleSize$alternative)) numberOfSubjects1 <- matrix(NA_real_, kMax, length(fixedSampleSize$alternative)) numberOfSubjects2 <- matrix(NA_real_, kMax, length(fixedSampleSize$alternative)) maxNumberOfSubjects <- rep(NA_real_, length(fixedSampleSize$alternative)) expectedNumberOfSubjectsH0 <- rep(NA_real_, length(fixedSampleSize$alternative)) expectedNumberOfSubjectsH01 <- rep(NA_real_, length(fixedSampleSize$alternative)) expectedNumberOfSubjectsH1 <- rep(NA_real_, length(fixedSampleSize$alternative)) informationRates <- designCharacteristics$information / designCharacteristics$shift for (i in (1:length(fixedSampleSize$alternative))) { maxNumberOfSubjects[i] <- fixedSampleSize$nFixed[i] * designCharacteristics$inflationFactor numberOfSubjects[, i] <- maxNumberOfSubjects[i] * c(informationRates[1], (informationRates[2:kMax] - informationRates[1:(kMax - 1)])) expectedNumberOfSubjectsH0[i] <- designCharacteristics$averageSampleNumber0 * fixedSampleSize$nFixed[i] expectedNumberOfSubjectsH01[i] <- designCharacteristics$averageSampleNumber01 * fixedSampleSize$nFixed[i] expectedNumberOfSubjectsH1[i] <- designCharacteristics$averageSampleNumber1 * fixedSampleSize$nFixed[i] if (fixedSampleSize$groups == 2) { if (length(fixedSampleSize$allocationRatioPlanned) > 1) { allocationRatioPlanned <- fixedSampleSize$allocationRatioPlanned[i] } else { allocationRatioPlanned <- fixedSampleSize$allocationRatioPlanned } numberOfSubjects1[, i] <- numberOfSubjects[, i] * allocationRatioPlanned / (1 + allocationRatioPlanned) numberOfSubjects2[, i] <- numberOfSubjects[, i] / (1 + allocationRatioPlanned) } } if (fixedSampleSize$groups == 1) { return(list( alpha = fixedSampleSize$alpha, beta = fixedSampleSize$beta, sided = fixedSampleSize$sided, groups = fixedSampleSize$groups, thetaH0 = fixedSampleSize$thetaH0, alternative = fixedSampleSize$alternative, stDev = fixedSampleSize$stDev, normalApproximation = fixedSampleSize$normalApproximation, informationRates = matrix(informationRates, ncol = 1), maxNumberOfSubjects = maxNumberOfSubjects, numberOfSubjects = .getColumnCumSum(numberOfSubjects), expectedNumberOfSubjectsH0 = expectedNumberOfSubjectsH0, expectedNumberOfSubjectsH01 = expectedNumberOfSubjectsH01, expectedNumberOfSubjectsH1 = expectedNumberOfSubjectsH1, rejectPerStage = designCharacteristics$rejectionProbabilities, futilityPerStage = designCharacteristics$futilityProbabilities )) } else { return(list( alpha = fixedSampleSize$alpha, beta = fixedSampleSize$beta, sided = fixedSampleSize$sided, groups = fixedSampleSize$groups, allocationRatioPlanned = fixedSampleSize$allocationRatioPlanned, thetaH0 = fixedSampleSize$thetaH0, alternative = fixedSampleSize$alternative, stDev = fixedSampleSize$stDev, normalApproximation = fixedSampleSize$normalApproximation, meanRatio = fixedSampleSize$meanRatio, informationRates = matrix(informationRates, ncol = 1), maxNumberOfSubjects = maxNumberOfSubjects, numberOfSubjects = .getColumnCumSum(numberOfSubjects), numberOfSubjects1 = .getColumnCumSum(numberOfSubjects1), numberOfSubjects2 = .getColumnCumSum(numberOfSubjects2), expectedNumberOfSubjectsH0 = expectedNumberOfSubjectsH0, expectedNumberOfSubjectsH01 = expectedNumberOfSubjectsH01, expectedNumberOfSubjectsH1 = expectedNumberOfSubjectsH1, rejectPerStage = designCharacteristics$rejectionProbabilities, futilityPerStage = designCharacteristics$futilityProbabilities )) } } .getColumnCumSum <- function(x) { if (is.matrix(x)) { result <- x for (i in 1:ncol(x)) { result[, i] <- cumsum(x[, i]) } return(result) } return(cumsum(x)) } .getFarringtonManningValuesDiff <- function(..., rate1, rate2, theta, allocation) { if (theta == 0) { ml1 <- (allocation * rate1 + rate2) / (1 + allocation) ml2 <- ml1 return(c(ml1, ml2)) } a <- 1 + 1 / allocation b <- -(1 + 1 / allocation + rate1 + rate2 / allocation + theta * (1 / allocation + 2)) c <- theta^2 + theta * (2 * rate1 + 1 / allocation + 1) + rate1 + rate2 / allocation d <- -theta * (1 + theta) * rate1 v <- b^3 / (3 * a)^3 - b * c / (6 * a^2) + d / (2 * a) if (!is.na(v) && (v == 0)) { u <- sqrt(b^2 / (3 * a)^2 - c / (3 * a)) w <- acos(-1) / 2 } else { u <- sign(v) * sqrt(b^2 / (3 * a)^2 - c / (3 * a)) w <- 1 / 3 * (acos(-1) + acos(v / u^3)) } ml1 <- min(max(0, 2 * u * cos(w) - b / (3 * a)), 1) ml2 <- min(max(0, ml1 - theta), 1) return(c(ml1, ml2)) } .getFarringtonManningValuesRatio <- function(..., rate1, rate2, theta, allocation) { if (theta == 1) { ml1 <- (allocation * rate1 + rate2) / (1 + allocation) ml2 <- ml1 return(c(ml1, ml2)) } a <- 1 + 1 / allocation b <- -((1 + rate2 / allocation) * theta + 1 / allocation + rate1) c <- (rate1 + rate2 / allocation) * theta ml1 <- (-b - sqrt(b^2 - 4 * a * c)) / (2 * a) ml2 <- ml1 / theta return(c(ml1, ml2)) } # # @title # Get Farrington Manning Values # # @description # Calculates and returns the maximum likelihood estimates under H0. # # @details # Calculation of maximum likelihood estimates under # H0: pi1 - pi2 = theta or H0: pi1 / pi2 = theta # # @references # Farrington & Manning (1990) # Wassmer (2003) # # @keywords internal # .getFarringtonManningValues <- function(rate1, rate2, theta, allocation, method = c("diff", "ratio")) { method <- match.arg(method) if (method == "diff") { ml <- .getFarringtonManningValuesDiff(rate1 = rate1, rate2 = rate2, theta = theta, allocation = allocation) } else { ml <- .getFarringtonManningValuesRatio(rate1 = rate1, rate2 = rate2, theta = theta, allocation = allocation) } return(list(theta = theta, method = method, ml1 = ml[1], ml2 = ml[2])) } .getSampleSizeFixedRates <- function(..., alpha = 0.025, beta = 0.2, sided = 1, normalApproximation = TRUE, riskRatio = FALSE, thetaH0 = 0, pi1 = seq(0.4, 0.6, 0.1), pi2 = 0.2, groups = 2, allocationRatioPlanned = 1) { if (groups == 1) { nFixed <- rep(NA_real_, length(pi1)) for (i in 1:length(pi1)) { if (normalApproximation) { nFixed[i] <- (.getOneMinusQNorm(alpha / sided) * sqrt(thetaH0 * (1 - thetaH0)) + .getOneMinusQNorm(beta) * sqrt(pi1[i] * (1 - pi1[i])))^2 / (pi1[i] - thetaH0)^2 } else { ifelse(pi1[i] > thetaH0, lower.tail <- FALSE, lower.tail <- TRUE) iterations <- 1 if (lower.tail) { nup <- 2 while ((stats::pbinom(stats::qbinom(alpha, nup, thetaH0, lower.tail = lower.tail) - 1, nup, pi1[i], lower.tail = lower.tail ) < 1 - beta) && (iterations <= 50)) { nup <- 2 * nup iterations <- iterations + 1 } if (iterations > 50) { nFixed[i] <- Inf } else { prec <- 2 nlow <- 2 while (prec > 1) { nFixed[i] <- round((nlow + nup) / 2) ifelse(stats::pbinom(stats::qbinom(alpha, nFixed[i], thetaH0, lower.tail = lower.tail) - 1, nFixed[i], pi1[i], lower.tail = lower.tail ) < 1 - beta, nlow <- nFixed[i], nup <- nFixed[i] ) prec <- nup - nlow } if (stats::pbinom(stats::qbinom(alpha, nFixed[i], thetaH0, lower.tail = lower.tail) - 1, nFixed[i], pi1[i], lower.tail = lower.tail ) < 1 - beta) { nFixed[i] <- nFixed[i] + 1 } } } else { nup <- 2 while ((stats::pbinom(stats::qbinom(alpha, nup, thetaH0, lower.tail = lower.tail), nup, pi1[i], lower.tail = lower.tail ) < 1 - beta) && (iterations <= 50)) { nup <- 2 * nup iterations <- iterations + 1 } if (iterations > 50) { nFixed[i] <- Inf } else { prec <- 2 nlow <- 2 while (prec > 1) { nFixed[i] <- round((nlow + nup) / 2) ifelse(stats::pbinom(stats::qbinom(alpha, nFixed[i], thetaH0, lower.tail = lower.tail), nFixed[i], pi1[i], lower.tail = lower.tail ) < 1 - beta, nlow <- nFixed[i], nup <- nFixed[i] ) prec <- nup - nlow } if (stats::pbinom(stats::qbinom(alpha, nFixed[i], thetaH0, lower.tail = lower.tail), nFixed[i], pi1[i], lower.tail = lower.tail ) < 1 - beta) { nFixed[i] <- nFixed[i] + 1 } } } } } return(list( alpha = alpha, beta = beta, sided = sided, groups = groups, thetaH0 = thetaH0, pi1 = pi1, normalApproximation = normalApproximation, nFixed = nFixed )) } if (groups == 2) { n1Fixed <- rep(NA_real_, length(pi1)) n2Fixed <- rep(NA_real_, length(pi1)) nFixed <- rep(NA_real_, length(pi1)) if (allocationRatioPlanned == 0) { allocationRatioPlannedVec <- rep(NA_real_, length(pi1)) } for (i in 1:length(pi1)) { if (!riskRatio) { # allocationRatioPlanned = 0 provides optimum sample size if (allocationRatioPlanned == 0) { allocationRatioPlannedVec[i] <- stats::optimize(function(x) { fm <- .getFarringtonManningValues( rate1 = pi1[i], rate2 = pi2, theta = thetaH0, allocation = x, method = "diff" ) n1 <- (.getOneMinusQNorm(alpha / sided) * sqrt(fm$ml1 * (1 - fm$ml1) + fm$ml2 * (1 - fm$ml2) * x) + .getOneMinusQNorm(beta) * sqrt(pi1[i] * (1 - pi1[i]) + pi2 * (1 - pi2) * x))^2 / (pi1[i] - pi2 - thetaH0)^2 return((1 + x) / x * n1) }, interval = c(0, 5), tol = 0.0001)$minimum fm <- .getFarringtonManningValues( rate1 = pi1[i], rate2 = pi2, theta = thetaH0, allocation = allocationRatioPlannedVec[i], method = "diff" ) n1Fixed[i] <- (.getOneMinusQNorm(alpha / sided) * sqrt(fm$ml1 * (1 - fm$ml1) + fm$ml2 * (1 - fm$ml2) * allocationRatioPlannedVec[i]) + .getOneMinusQNorm(beta) * sqrt(pi1[i] * (1 - pi1[i]) + pi2 * (1 - pi2) * allocationRatioPlannedVec[i]))^2 / (pi1[i] - pi2 - thetaH0)^2 } else { fm <- .getFarringtonManningValues( rate1 = pi1[i], rate2 = pi2, theta = thetaH0, allocation = allocationRatioPlanned, method = "diff" ) n1Fixed[i] <- (.getOneMinusQNorm(alpha / sided) * sqrt(fm$ml1 * (1 - fm$ml1) + fm$ml2 * (1 - fm$ml2) * allocationRatioPlanned) + .getOneMinusQNorm(beta) * sqrt(pi1[i] * (1 - pi1[i]) + pi2 * (1 - pi2) * allocationRatioPlanned))^2 / (pi1[i] - pi2 - thetaH0)^2 } } else { if (allocationRatioPlanned == 0) { # allocationRatioPlanned = 0 provides optimum sample size allocationRatioPlannedVec[i] <- stats::optimize(function(x) { fm <- .getFarringtonManningValues( rate1 = pi1[i], rate2 = pi2, theta = thetaH0, allocation = x, method = "ratio" ) n1 <- (.getOneMinusQNorm(alpha / sided) * sqrt(fm$ml1 * (1 - fm$ml1) + fm$ml2 * (1 - fm$ml2) * x * thetaH0^2) + .getOneMinusQNorm(beta) * sqrt(pi1[i] * (1 - pi1[i]) + pi2 * (1 - pi2) * x * thetaH0^2))^2 / (pi1[i] - thetaH0 * pi2)^2 return((1 + x) / x * n1) }, interval = c(0, 5), tol = 0.0001)$minimum fm <- .getFarringtonManningValues( rate1 = pi1[i], rate2 = pi2, theta = thetaH0, allocation = allocationRatioPlannedVec[i], method = "ratio" ) n1Fixed[i] <- (.getOneMinusQNorm(alpha / sided) * sqrt(fm$ml1 * (1 - fm$ml1) + fm$ml2 * (1 - fm$ml2) * allocationRatioPlannedVec[i] * thetaH0^2) + .getOneMinusQNorm(beta) * sqrt(pi1[i] * (1 - pi1[i]) + pi2 * (1 - pi2) * allocationRatioPlannedVec[i] * thetaH0^2))^2 / (pi1[i] - thetaH0 * pi2)^2 } else { fm <- .getFarringtonManningValues( rate1 = pi1[i], rate2 = pi2, theta = thetaH0, allocation = allocationRatioPlanned, method = "ratio" ) n1Fixed[i] <- (.getOneMinusQNorm(alpha / sided) * sqrt(fm$ml1 * (1 - fm$ml1) + fm$ml2 * (1 - fm$ml2) * allocationRatioPlanned * thetaH0^2) + .getOneMinusQNorm(beta) * sqrt(pi1[i] * (1 - pi1[i]) + pi2 * (1 - pi2) * allocationRatioPlanned * thetaH0^2))^2 / (pi1[i] - thetaH0 * pi2)^2 } } } if (allocationRatioPlanned == 0) { allocationRatioPlanned <- allocationRatioPlannedVec } n2Fixed <- n1Fixed / allocationRatioPlanned nFixed <- n1Fixed + n2Fixed return(list( alpha = alpha, beta = beta, sided = sided, groups = groups, allocationRatioPlanned = allocationRatioPlanned, thetaH0 = thetaH0, pi1 = pi1, pi2 = pi2, normalApproximation = normalApproximation, riskRatio = riskRatio, n1Fixed = n1Fixed, n2Fixed = n2Fixed, nFixed = nFixed )) } } .getSampleSizeSequentialRates <- function(fixedSampleSize, designCharacteristics) { kMax <- designCharacteristics$.design$kMax numberOfSubjects <- matrix(NA_real_, kMax, length(fixedSampleSize$pi1)) numberOfSubjects1 <- matrix(NA_real_, kMax, length(fixedSampleSize$pi1)) numberOfSubjects2 <- matrix(NA_real_, kMax, length(fixedSampleSize$pi1)) maxNumberOfSubjects <- rep(NA_real_, length(fixedSampleSize$pi1)) expectedNumberOfSubjectsH0 <- rep(NA_real_, length(fixedSampleSize$pi1)) expectedNumberOfSubjectsH01 <- rep(NA_real_, length(fixedSampleSize$pi1)) expectedNumberOfSubjectsH1 <- rep(NA_real_, length(fixedSampleSize$pi1)) informationRates <- designCharacteristics$information / designCharacteristics$shift for (i in 1:length(fixedSampleSize$pi1)) { maxNumberOfSubjects[i] <- fixedSampleSize$nFixed[i] * designCharacteristics$inflationFactor numberOfSubjects[, i] <- maxNumberOfSubjects[i] * c( informationRates[1], (informationRates[2:kMax] - informationRates[1:(kMax - 1)]) ) expectedNumberOfSubjectsH0[i] <- designCharacteristics$averageSampleNumber0 * fixedSampleSize$nFixed[i] expectedNumberOfSubjectsH01[i] <- designCharacteristics$averageSampleNumber01 * fixedSampleSize$nFixed[i] expectedNumberOfSubjectsH1[i] <- designCharacteristics$averageSampleNumber1 * fixedSampleSize$nFixed[i] if (fixedSampleSize$groups == 2) { if (length(fixedSampleSize$allocationRatioPlanned) > 1) { allocationRatioPlanned <- fixedSampleSize$allocationRatioPlanned[i] } else { allocationRatioPlanned <- fixedSampleSize$allocationRatioPlanned } numberOfSubjects1[, i] <- numberOfSubjects[, i] * allocationRatioPlanned / (1 + allocationRatioPlanned) numberOfSubjects2[, i] <- numberOfSubjects[, i] / (1 + allocationRatioPlanned) } } if (fixedSampleSize$groups == 1) { return(list( alpha = fixedSampleSize$alpha, beta = fixedSampleSize$beta, sided = fixedSampleSize$sided, groups = fixedSampleSize$groups, thetaH0 = fixedSampleSize$thetaH0, pi1 = fixedSampleSize$pi1, normalApproximation = fixedSampleSize$normalApproximation, informationRates = matrix(informationRates, ncol = 1), maxNumberOfSubjects = maxNumberOfSubjects, numberOfSubjects = .getColumnCumSum(numberOfSubjects), expectedNumberOfSubjectsH0 = expectedNumberOfSubjectsH0, expectedNumberOfSubjectsH01 = expectedNumberOfSubjectsH01, expectedNumberOfSubjectsH1 = expectedNumberOfSubjectsH1, rejectPerStage = designCharacteristics$rejectionProbabilities, futilityPerStage = designCharacteristics$futilityProbabilities )) } else { return(list( alpha = fixedSampleSize$alpha, beta = fixedSampleSize$beta, sided = fixedSampleSize$sided, groups = fixedSampleSize$groups, allocationRatioPlanned = fixedSampleSize$allocationRatioPlanned, thetaH0 = fixedSampleSize$thetaH0, pi1 = fixedSampleSize$pi1, pi2 = fixedSampleSize$pi2, normalApproximation = fixedSampleSize$normalApproximation, riskRatio = fixedSampleSize$riskRatio, informationRates = matrix(informationRates, ncol = 1), maxNumberOfSubjects = maxNumberOfSubjects, numberOfSubjects = .getColumnCumSum(numberOfSubjects), numberOfSubjects1 = .getColumnCumSum(numberOfSubjects1), numberOfSubjects2 = .getColumnCumSum(numberOfSubjects2), expectedNumberOfSubjectsH0 = expectedNumberOfSubjectsH0, expectedNumberOfSubjectsH01 = expectedNumberOfSubjectsH01, expectedNumberOfSubjectsH1 = expectedNumberOfSubjectsH1, rejectPerStage = designCharacteristics$rejectionProbabilities, futilityPerStage = designCharacteristics$futilityProbabilities )) } } .getPiecewiseExpStartTimesWithoutLeadingZero <- function(piecewiseSurvivalTime) { if (is.null(piecewiseSurvivalTime) || length(piecewiseSurvivalTime) == 0 || all(is.na(piecewiseSurvivalTime))) { return(NA_real_) } if (piecewiseSurvivalTime[1] != 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the first value of 'piecewiseSurvivalTime' (", .arrayToString(piecewiseSurvivalTime), ") must be 0", call. = FALSE ) } if (length(piecewiseSurvivalTime) == 1) { return(numeric(0)) } if (length(piecewiseSurvivalTime) < 2) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'piecewiseSurvivalTime' (", length(piecewiseSurvivalTime), ") must be > 1" ) } return(piecewiseSurvivalTime[2:length(piecewiseSurvivalTime)]) } .getEventProbabilityFunction <- function(..., time, piecewiseLambda, piecewiseSurvivalTime, phi, kappa) { if (length(piecewiseLambda) == 1) { if (kappa != 1 && phi > 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "Weibull distribution cannot ", "be used together with specified dropout rate (use simulation instead)", call. = FALSE ) } return(piecewiseLambda / (piecewiseLambda + phi) * pweibull(time, shape = kappa, scale = 1 / (piecewiseLambda + phi), lower.tail = TRUE, log.p = FALSE)) } if (length(piecewiseSurvivalTime) != length(piecewiseLambda)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'piecewiseSurvivalTime' (", .arrayToString(piecewiseSurvivalTime), ") must be equal to length of 'piecewiseLambda' (", .arrayToString(piecewiseLambda), ")" ) } piecewiseSurvivalTime <- .getPiecewiseExpStartTimesWithoutLeadingZero(piecewiseSurvivalTime) if (kappa != 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "Weibull distribution cannot be used for piecewise survival definition", call. = FALSE ) } len <- length(piecewiseSurvivalTime) for (i in 1:len) { if (i == 1) { if (time <= piecewiseSurvivalTime[1]) { return(piecewiseLambda[1] / (piecewiseLambda[1] + phi) * (1 - exp(-((piecewiseLambda[1] + phi) * time)))) } } else if (i == 2) { cdfPart <- piecewiseLambda[1] / (piecewiseLambda[1] + phi) * (1 - exp(-((piecewiseLambda[1] + phi) * piecewiseSurvivalTime[1]))) if (time <= piecewiseSurvivalTime[2]) { cdfFactor <- piecewiseLambda[1] * piecewiseSurvivalTime[1] cdf <- cdfPart + piecewiseLambda[2] / (piecewiseLambda[2] + phi) * exp(-cdfFactor) * ( exp(-phi * piecewiseSurvivalTime[1]) - exp(-piecewiseLambda[2] * (time - piecewiseSurvivalTime[1]) - phi * time)) return(cdf) } } else if (i == 3) { cdfPart <- cdfPart + piecewiseLambda[2] / (piecewiseLambda[2] + phi) * exp(-piecewiseLambda[1] * piecewiseSurvivalTime[1]) * ( exp(-phi * piecewiseSurvivalTime[1]) - exp(-piecewiseLambda[2] * (piecewiseSurvivalTime[2] - piecewiseSurvivalTime[1]) - phi * piecewiseSurvivalTime[2])) if (time <= piecewiseSurvivalTime[3]) { cdfFactor <- piecewiseLambda[1] * piecewiseSurvivalTime[1] + piecewiseLambda[2] * (piecewiseSurvivalTime[2] - piecewiseSurvivalTime[1]) cdf <- cdfPart + piecewiseLambda[3] / (piecewiseLambda[3] + phi) * exp(-cdfFactor) * ( exp(-phi * piecewiseSurvivalTime[2]) - exp(-piecewiseLambda[3] * (time - piecewiseSurvivalTime[2]) - phi * time)) return(cdf) } } else if (i > 3) { cdfFactor <- piecewiseLambda[1] * piecewiseSurvivalTime[1] + sum(piecewiseLambda[2:(i - 2)] * (piecewiseSurvivalTime[2:(i - 2)] - piecewiseSurvivalTime[1:(i - 3)])) cdfPart <- cdfPart + piecewiseLambda[i - 1] / (piecewiseLambda[i - 1] + phi) * exp(-cdfFactor) * ( exp(-phi * piecewiseSurvivalTime[i - 2]) - exp(-piecewiseLambda[i - 1] * (piecewiseSurvivalTime[i - 1] - piecewiseSurvivalTime[i - 2]) - phi * piecewiseSurvivalTime[i - 1])) if (time <= piecewiseSurvivalTime[i]) { cdfFactor <- piecewiseLambda[1] * piecewiseSurvivalTime[1] + sum(piecewiseLambda[2:(i - 1)] * (piecewiseSurvivalTime[2:(i - 1)] - piecewiseSurvivalTime[1:(i - 2)])) cdf <- cdfPart + piecewiseLambda[i] / (piecewiseLambda[i] + phi) * exp(-cdfFactor) * ( exp(-phi * piecewiseSurvivalTime[i - 1]) - exp(-piecewiseLambda[i] * (time - piecewiseSurvivalTime[i - 1]) - phi * time)) return(cdf) } } } if (len == 1) { cdfPart <- piecewiseLambda[1] / (piecewiseLambda[1] + phi) * (1 - exp(-((piecewiseLambda[1] + phi) * piecewiseSurvivalTime[1]))) } else if (len == 2) { cdfFactor <- piecewiseLambda[1] * piecewiseSurvivalTime[1] cdfPart <- cdfPart + piecewiseLambda[len] / (piecewiseLambda[len] + phi) * exp(-cdfFactor) * ( exp(-phi * piecewiseSurvivalTime[len - 1]) - exp(-piecewiseLambda[len] * (piecewiseSurvivalTime[len] - piecewiseSurvivalTime[len - 1]) - phi * piecewiseSurvivalTime[len])) } else { cdfFactor <- piecewiseLambda[1] * piecewiseSurvivalTime[1] + sum(piecewiseLambda[2:(len - 1)] * (piecewiseSurvivalTime[2:(len - 1)] - piecewiseSurvivalTime[1:(len - 2)])) cdfPart <- cdfPart + piecewiseLambda[len] / (piecewiseLambda[len] + phi) * exp(-cdfFactor) * ( exp(-phi * piecewiseSurvivalTime[len - 1]) - exp(-piecewiseLambda[len] * (piecewiseSurvivalTime[len] - piecewiseSurvivalTime[len - 1]) - phi * piecewiseSurvivalTime[len])) } if (len == 1) { cdfFactor <- piecewiseLambda[1] * piecewiseSurvivalTime[1] } else { cdfFactor <- cdfFactor + piecewiseLambda[len] * (piecewiseSurvivalTime[len] - piecewiseSurvivalTime[len - 1]) } cdf <- cdfPart + piecewiseLambda[len + 1] / (piecewiseLambda[len + 1] + phi) * exp(-cdfFactor) * ( exp(-phi * piecewiseSurvivalTime[len]) - exp(-piecewiseLambda[len + 1] * (time - piecewiseSurvivalTime[len]) - phi * time)) return(cdf) } .getEventProbabilityFunctionVec <- function(..., timeVector, piecewiseLambda, piecewiseSurvivalTime, phi, kappa) { result <- c() for (time in timeVector) { result <- c(result, .getEventProbabilityFunction( time = time, piecewiseLambda = piecewiseLambda, piecewiseSurvivalTime = piecewiseSurvivalTime, phi = phi, kappa = kappa )) } return(result) } #' @title #' Get Event Probabilities #' #' @description #' Returns the event probabilities for specified parameters at given time vector. #' #' @param time A numeric vector with time values. #' @inheritParams param_lambda1 #' @inheritParams param_lambda2 #' @inheritParams param_piecewiseSurvivalTime #' @inheritParams param_hazardRatio #' @inheritParams param_kappa #' @inheritParams param_allocationRatioPlanned_sampleSize #' @inheritParams param_accrualTime #' @inheritParams param_accrualIntensity #' @inheritParams param_accrualIntensityType #' @inheritParams param_dropoutRate1 #' @inheritParams param_dropoutRate2 #' @inheritParams param_dropoutTime #' @param maxNumberOfSubjects If \code{maxNumberOfSubjects > 0} is specified, #' the end of accrual at specified \code{accrualIntensity} for the specified #' number of subjects is determined or \code{accrualIntensity} is calculated #' at fixed end of accrual. #' @inheritParams param_three_dots #' #' @details #' The function computes the overall event probabilities in a two treatment groups design. #' For details of the parameters see \code{\link{getSampleSizeSurvival}}. #' #' @return Returns a \code{\link{EventProbabilities}} object. #' The following generics (R generic functions) are available for this result object: #' \itemize{ #' \item \code{\link[=names.FieldSet]{names}} to obtain the field names, #' \item \code{\link[=print.FieldSet]{print}} to print the object, #' \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, #' \item \code{\link[=plot.EventProbabilities]{plot}} to plot the object, #' \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, #' \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. #' } #' @template how_to_get_help_for_generics #' #' @template examples_get_event_probabilities #' #' @export #' getEventProbabilities <- function(time, ..., accrualTime = c(0L, 12L), # C_ACCRUAL_TIME_DEFAULT accrualIntensity = 0.1, # C_ACCRUAL_INTENSITY_DEFAULT accrualIntensityType = c("auto", "absolute", "relative"), kappa = 1, piecewiseSurvivalTime = NA_real_, lambda2 = NA_real_, lambda1 = NA_real_, allocationRatioPlanned = 1, hazardRatio = NA_real_, dropoutRate1 = 0, # C_DROP_OUT_RATE_1_DEFAULT dropoutRate2 = 0, # C_DROP_OUT_RATE_2_DEFAULT dropoutTime = 12L, # C_DROP_OUT_TIME_DEFAULT maxNumberOfSubjects = NA_real_) { .warnInCaseOfUnknownArguments(functionName = "getEventProbabilities", ...) .assertIsNumericVector(time, "time") .assertIsValidMaxNumberOfSubjects(maxNumberOfSubjects, naAllowed = TRUE) .assertIsValidAllocationRatioPlannedSampleSize(allocationRatioPlanned, maxNumberOfSubjects) .assertIsValidKappa(kappa) .assertIsSingleNumber(hazardRatio, "hazardRatio", naAllowed = TRUE) if (!is.na(dropoutTime) && dropoutTime <= 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dropoutTime' (", dropoutTime, ") must be > 0", call. = FALSE) } if (dropoutRate1 < 0 || dropoutRate1 >= 1) { stop( C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'dropoutRate1' (", dropoutRate1, ") is out of bounds [0; 1)" ) } if (dropoutRate2 < 0 || dropoutRate2 >= 1) { stop( C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'dropoutRate2' (", dropoutRate2, ") is out of bounds [0; 1)" ) } accrualSetup <- getAccrualTime( accrualTime = accrualTime, accrualIntensity = accrualIntensity, accrualIntensityType = accrualIntensityType, maxNumberOfSubjects = maxNumberOfSubjects ) accrualTime <- accrualSetup$.getAccrualTimeWithoutLeadingZero() accrualIntensity <- accrualSetup$accrualIntensity maxNumberOfSubjects <- accrualSetup$maxNumberOfSubjects setting <- getPiecewiseSurvivalTime( piecewiseSurvivalTime = piecewiseSurvivalTime, lambda2 = lambda2, lambda1 = lambda1, hazardRatio = hazardRatio, kappa = kappa, delayedResponseAllowed = TRUE, .lambdaBased = TRUE ) if (!setting$delayedResponseEnabled && length(setting$lambda1) > 1 && setting$.getParameterType("lambda1") == C_PARAM_USER_DEFINED) { warning("Only the first 'lambda1' (", lambda1[1], ") was used to calculate event probabilities", call. = FALSE) setting <- getPiecewiseSurvivalTime( piecewiseSurvivalTime = piecewiseSurvivalTime, lambda2 = lambda2, lambda1 = lambda1[1], hazardRatio = hazardRatio, kappa = kappa, delayedResponseAllowed = TRUE, .lambdaBased = TRUE ) } piecewiseSurvivalTime <- setting$piecewiseSurvivalTime lambda2 <- setting$lambda2 lambda1 <- setting$lambda1 hazardRatio <- setting$hazardRatio phi <- -log(1 - c(dropoutRate1, dropoutRate2)) / dropoutTime if (length(accrualTime) != length(accrualIntensity)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'accrualTime' (", (length(accrualTime) + 1), ") must be equal to length of 'accrualIntensity' (", length(accrualIntensity), ")" ) } if (any(accrualIntensity <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all values of 'accrualIntensity' must be > 0") } if (any(accrualTime <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all values of 'accrualTime' must be > 0") } if (kappa != 1 && any(phi > 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "for Weibull distribution (kappa != 1) drop-out rates (phi) cannot be specified" ) } if (any(phi < 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all drop-out rates (phi) must be >= 0") } .assertIsNumericVector(lambda2, "lambda2") if (any(lambda2 <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all rates (lambda2) must be > 0") } eventProbabilities <- EventProbabilities( .piecewiseSurvivalTime = setting, .accrualTime = accrualSetup, time = time, accrualTime = accrualTime, accrualIntensity = accrualIntensity, kappa = kappa, piecewiseSurvivalTime = piecewiseSurvivalTime, lambda1 = lambda1, lambda2 = lambda2, allocationRatioPlanned = allocationRatioPlanned, hazardRatio = hazardRatio, dropoutRate1 = dropoutRate1, dropoutRate2 = dropoutRate2, dropoutTime = dropoutTime, maxNumberOfSubjects = maxNumberOfSubjects ) eventProbabilities$.setParameterType("time", C_PARAM_USER_DEFINED) eventProbabilities$.setParameterType( "accrualTime", accrualSetup$.getParameterType("accrualTime") ) eventProbabilities$.setParameterType( "accrualIntensity", accrualSetup$.getParameterType("accrualIntensity") ) eventProbabilities$.setParameterType("kappa", setting$.getParameterType("kappa")) eventProbabilities$.setParameterType( "piecewiseSurvivalTime", setting$.getParameterType("piecewiseSurvivalTime") ) eventProbabilities$.setParameterType("lambda1", setting$.getParameterType("lambda1")) eventProbabilities$.setParameterType("lambda2", setting$.getParameterType("lambda2")) .setValueAndParameterType(eventProbabilities, "allocationRatioPlanned", allocationRatioPlanned, 1) eventProbabilities$.setParameterType("hazardRatio", setting$.getParameterType("hazardRatio")) .setValueAndParameterType(eventProbabilities, "dropoutRate1", dropoutRate1, C_DROP_OUT_RATE_1_DEFAULT) .setValueAndParameterType(eventProbabilities, "dropoutRate2", dropoutRate2, C_DROP_OUT_RATE_2_DEFAULT) .setValueAndParameterType(eventProbabilities, "dropoutTime", dropoutTime, C_DROP_OUT_TIME_DEFAULT) eventProbabilities$.setParameterType( "maxNumberOfSubjects", accrualSetup$.getParameterType("maxNumberOfSubjects") ) eventProbabilities$overallEventProbabilities <- numeric(0) eventProbabilities$eventProbabilities1 <- numeric(0) eventProbabilities$eventProbabilities2 <- numeric(0) for (timeValue in time) { eventProbs <- .getEventProbabilitiesGroupwise( time = timeValue, accrualTimeVector = accrualSetup$.getAccrualTimeWithoutLeadingZero(), accrualIntensity = accrualSetup$accrualIntensity, lambda2 = lambda2, lambda1 = lambda1, piecewiseSurvivalTime = piecewiseSurvivalTime, phi = phi, kappa = kappa, allocationRatioPlanned = allocationRatioPlanned, hazardRatio = hazardRatio ) eventProbabilities$overallEventProbabilities <- c( eventProbabilities$overallEventProbabilities, .getEventProbabilitiesOverall(eventProbs, allocationRatioPlanned) ) eventProbabilities$eventProbabilities1 <- c( eventProbabilities$eventProbabilities1, eventProbs[1] ) eventProbabilities$eventProbabilities2 <- c( eventProbabilities$eventProbabilities2, eventProbs[2] ) } eventProbabilities$.setParameterType("overallEventProbabilities", C_PARAM_GENERATED) eventProbabilities$.setParameterType("eventProbabilities1", C_PARAM_GENERATED) eventProbabilities$.setParameterType("eventProbabilities2", C_PARAM_GENERATED) return(eventProbabilities) } #' @title #' Get Number Of Subjects #' #' @description #' Returns the number of recruited subjects at given time vector. #' #' @param time A numeric vector with time values. #' @inheritParams param_accrualTime #' @inheritParams param_accrualIntensity #' @inheritParams param_accrualIntensityType #' @param maxNumberOfSubjects If \code{maxNumberOfSubjects > 0} is specified, #' the end of accrual at specified \code{accrualIntensity} for the specified number of #' subjects is determined or \code{accrualIntensity} is calculated at fixed end of accrual. #' @inheritParams param_three_dots #' #' @details #' Calculate number of subjects over time range at given accrual time vector #' and accrual intensity. Intensity can either be defined in absolute or #' relative terms (for the latter, \code{maxNumberOfSubjects} needs to be defined)\cr #' The function is used by \code{\link{getSampleSizeSurvival}}. #' #' @return Returns a \code{\link{NumberOfSubjects}} object. #' The following generics (R generic functions) are available for this result object: #' \itemize{ #' \item \code{\link[=names.FieldSet]{names}} to obtain the field names, #' \item \code{\link[=print.FieldSet]{print}} to print the object, #' \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, #' \item \code{\link[=plot.NumberOfSubjects]{plot}} to plot the object, #' \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, #' \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. #' } #' @template how_to_get_help_for_generics #' #' @seealso \code{\link{AccrualTime}} for defining the accrual time. #' #' @template examples_get_number_of_subjects #' #' @export #' getNumberOfSubjects <- function(time, ..., accrualTime = c(0L, 12L), # C_ACCRUAL_TIME_DEFAULT accrualIntensity = 0.1, # C_ACCRUAL_INTENSITY_DEFAULT accrualIntensityType = c("auto", "absolute", "relative"), maxNumberOfSubjects = NA_real_) { .warnInCaseOfUnknownArguments(functionName = "getNumberOfSubjects", ...) .assertIsNumericVector(time, "time") accrualSetup <- getAccrualTime( accrualTime = accrualTime, accrualIntensity = accrualIntensity, accrualIntensityType = accrualIntensityType, maxNumberOfSubjects = maxNumberOfSubjects ) accrualTime <- accrualSetup$.getAccrualTimeWithoutLeadingZero() accrualIntensity <- accrualSetup$accrualIntensity maxNumberOfSubjects <- accrualSetup$maxNumberOfSubjects if (length(accrualTime) != length(accrualIntensity)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'accrualTime' (", length(accrualTime), ") must be equal to length of 'accrualIntensity' (", length(accrualIntensity), ")" ) } if (any(accrualIntensity < 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all values of 'accrualIntensity' must be >= 0") } if (all(accrualIntensity < 1)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "at least one value of 'accrualIntensity' must be >= 1") } if (any(accrualTime <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all values of 'accrualTime' must be > 0") } numberOfSubjects <- .getNumberOfSubjects( time = time, accrualTime = accrualTime, accrualIntensity = accrualIntensity, maxNumberOfSubjects = maxNumberOfSubjects ) result <- NumberOfSubjects( .accrualTime = accrualSetup, time = time, accrualTime = accrualTime, accrualIntensity = accrualIntensity, maxNumberOfSubjects = maxNumberOfSubjects, numberOfSubjects = numberOfSubjects ) result$.setParameterType("time", C_PARAM_USER_DEFINED) result$.setParameterType("accrualTime", accrualSetup$.getParameterType("accrualTime")) result$.setParameterType("accrualIntensity", accrualSetup$.getParameterType("accrualIntensity")) result$.setParameterType("maxNumberOfSubjects", accrualSetup$.getParameterType("maxNumberOfSubjects")) result$.setParameterType("numberOfSubjects", C_PARAM_GENERATED) return(result) } .getLambda <- function(..., groupNumber, lambda2, lambda1, hazardRatio, kappa) { if (groupNumber == 1) { if (!any(is.na(lambda1))) { return(lambda1) } lambda2 <- lambda2 * hazardRatio^(1 / kappa) } return(lambda2) } .getEventProbabilitiesGroupwise <- function(..., time, accrualTimeVector, accrualIntensity, lambda2, lambda1, piecewiseSurvivalTime, phi, kappa, allocationRatioPlanned, hazardRatio) { .assertIsSingleNumber(time, "time") if (length(accrualTimeVector) > 1 && accrualTimeVector[1] == 0) { accrualTimeVector <- accrualTimeVector[2:length(accrualTimeVector)] } accrualTimeVectorLength <- length(accrualTimeVector) densityIntervals <- accrualTimeVector if (accrualTimeVectorLength > 1) { densityIntervals[2:accrualTimeVectorLength] <- accrualTimeVector[2:accrualTimeVectorLength] - accrualTimeVector[1:(accrualTimeVectorLength - 1)] } if (length(densityIntervals) > 1 && length(accrualIntensity) > 1 && length(densityIntervals) != length(accrualIntensity)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'densityIntervals' (", .arrayToString(densityIntervals), ") and 'accrualIntensity' (", .arrayToString(accrualIntensity), ") must have same length" ) } densityVector <- accrualIntensity / sum(densityIntervals * accrualIntensity) eventProbs <- rep(NA_real_, 2) for (k in 1:accrualTimeVectorLength) { if (time <= accrualTimeVector[k]) { for (groupNumber in c(1, 2)) { # two groups: 1 = treatment, 2 = control lambdaTemp <- .getLambda( groupNumber = groupNumber, lambda2 = lambda2, lambda1 = lambda1, hazardRatio = hazardRatio, kappa = kappa ) inner <- function(x) { .getEventProbabilityFunctionVec( timeVector = x, piecewiseLambda = lambdaTemp, piecewiseSurvivalTime = piecewiseSurvivalTime, phi = phi[groupNumber], kappa = kappa ) } timeValue1 <- 0 if (k > 1) { timeValue1 <- time - accrualTimeVector[1] } eventProbs[groupNumber] <- densityVector[1] * integrate(inner, timeValue1, time)$value if (k > 2) { for (j in 2:(k - 1)) { eventProbs[groupNumber] <- eventProbs[groupNumber] + densityVector[j] * integrate( inner, time - accrualTimeVector[j], time - accrualTimeVector[j - 1] )$value } } if (k > 1) { eventProbs[groupNumber] <- eventProbs[groupNumber] + densityVector[k] * integrate(inner, 0, time - accrualTimeVector[k - 1])$value } } return(eventProbs) } } for (groupNumber in c(1, 2)) { lambdaTemp <- .getLambda( groupNumber = groupNumber, lambda2 = lambda2, lambda1 = lambda1, hazardRatio = hazardRatio, kappa = kappa ) inner <- function(x) { .getEventProbabilityFunctionVec( timeVector = x, piecewiseLambda = lambdaTemp, piecewiseSurvivalTime = piecewiseSurvivalTime, phi = phi[groupNumber], kappa = kappa ) } eventProbs[groupNumber] <- densityVector[1] * integrate(inner, time - accrualTimeVector[1], time)$value if (accrualTimeVectorLength > 1) { for (j in (2:accrualTimeVectorLength)) { eventProbs[groupNumber] <- eventProbs[groupNumber] + densityVector[j] * integrate( inner, time - accrualTimeVector[j], time - accrualTimeVector[j - 1] )$value } } } return(eventProbs) } .getEventProbabilitiesOverall <- function(eventProbs, allocationRatioPlanned) { return((allocationRatioPlanned * eventProbs[1] + eventProbs[2]) / (1 + allocationRatioPlanned)) } .getEventProbabilities <- function(..., time, accrualTimeVector, accrualIntensity, lambda2, lambda1, piecewiseSurvivalTime, phi, kappa, allocationRatioPlanned, hazardRatio) { eventProbs <- .getEventProbabilitiesGroupwise( time = time, accrualTimeVector = accrualTimeVector, accrualIntensity = accrualIntensity, lambda2 = lambda2, lambda1 = lambda1, piecewiseSurvivalTime = piecewiseSurvivalTime, phi = phi, kappa = kappa, allocationRatioPlanned = allocationRatioPlanned, hazardRatio = hazardRatio ) return(.getEventProbabilitiesOverall(eventProbs, allocationRatioPlanned)) } .getEventsFixed <- function(..., typeOfComputation = c("Schoenfeld", "Freedman", "HsiehFreedman"), twoSidedPower, alpha, beta, sided, hazardRatio, thetaH0, allocationRatioPlanned) { typeOfComputation <- match.arg(typeOfComputation) if (typeOfComputation == "Schoenfeld") { eventsFixed <- (.getOneMinusQNorm(alpha / sided) + .getOneMinusQNorm(beta))^2 / (log(hazardRatio) - log(thetaH0))^2 * (1 + allocationRatioPlanned)^2 / allocationRatioPlanned if (twoSidedPower && (sided == 2)) { up <- 2 * eventsFixed eventsFixed <- .getOneDimensionalRoot( function(n) { return(stats::pnorm(.getOneMinusQNorm(alpha / 2) - sqrt(n) * (log(hazardRatio) - log(thetaH0)) * sqrt(allocationRatioPlanned) / (1 + allocationRatioPlanned)) - stats::pnorm(-.getOneMinusQNorm(alpha / 2) - sqrt(n) * (log(hazardRatio) - log(thetaH0)) * sqrt(allocationRatioPlanned) / (1 + allocationRatioPlanned)) - beta) }, lower = 0.001, upper = up, tolerance = 1e-04, callingFunctionInformation = ".getEventsFixed" ) } return(eventsFixed) } if (typeOfComputation == "Freedman") { eventsFixed <- (.getOneMinusQNorm(alpha / sided) + .getOneMinusQNorm(beta))^2 * (1 + hazardRatio * allocationRatioPlanned)^2 / (1 - hazardRatio)^2 / allocationRatioPlanned if (twoSidedPower && (sided == 2)) { up <- 2 * eventsFixed eventsFixed <- .getOneDimensionalRoot( function(n) { return(stats::pnorm(.getOneMinusQNorm(alpha / 2) - sqrt(n) * sqrt(allocationRatioPlanned) * (1 - hazardRatio) / (1 + allocationRatioPlanned * hazardRatio)) - stats::pnorm(-.getOneMinusQNorm(alpha / 2) - sqrt(n) * sqrt(allocationRatioPlanned) * (1 - hazardRatio) / (1 + allocationRatioPlanned * hazardRatio)) - beta) }, lower = 0.001, upper = up, tolerance = 1e-04, callingFunctionInformation = ".getEventsFixed" ) } return(eventsFixed) } if (typeOfComputation == "HsiehFreedman") { eventsFixed <- (.getOneMinusQNorm(alpha / sided) + .getOneMinusQNorm(beta))^2 * (1 + hazardRatio)^2 / (1 - hazardRatio)^2 * (1 + allocationRatioPlanned)^2 / (4 * allocationRatioPlanned) if (twoSidedPower && sided == 2) { up <- 2 * eventsFixed eventsFixed <- .getOneDimensionalRoot( function(n) { return(stats::pnorm(.getOneMinusQNorm(alpha / 2) - sqrt(n) * 2 * sqrt(allocationRatioPlanned) / (1 + allocationRatioPlanned) * (1 - hazardRatio) / (1 + hazardRatio)) - stats::pnorm(-.getOneMinusQNorm(alpha / 2) - sqrt(n) * 2 * sqrt(allocationRatioPlanned) / (1 + allocationRatioPlanned) * (1 - hazardRatio) / (1 + hazardRatio)) - beta) }, lower = 0.001, upper = up, tolerance = 1e-04, callingFunctionInformation = ".getEventsFixed" ) } return(eventsFixed) } } .getSampleSizeFixedSurvival <- function(designPlan) { alpha <- designPlan$getAlpha() beta <- designPlan$getBeta() sided <- designPlan$getSided() twoSidedPower <- designPlan$getTwoSidedPower() typeOfComputation <- designPlan$typeOfComputation thetaH0 <- designPlan$thetaH0 pi1 <- designPlan$pi1 pi2 <- designPlan$pi2 allocationRatioPlanned <- designPlan$allocationRatioPlanned accountForObservationTimes <- designPlan$accountForObservationTimes accrualTime <- designPlan$accrualTime kappa <- designPlan$kappa piecewiseSurvivalTime <- designPlan$piecewiseSurvivalTime maxNumberOfSubjects <- designPlan$maxNumberOfSubjects hazardRatio <- designPlan$hazardRatio .assertIsValidHazardRatio(hazardRatio, thetaH0) if (designPlan$.piecewiseSurvivalTime$.isLambdaBased()) { numberOfResults <- length(hazardRatio) } else { numberOfResults <- length(pi1) } designPlan$eventsFixed <- rep(NA_real_, numberOfResults) # number of events designPlan$nFixed <- rep(NA_real_, numberOfResults) # number of subjects designPlan$omega <- rep(NA_real_, numberOfResults) # probability of an event calculateAllocationRatioPlanned <- FALSE if (allocationRatioPlanned == 0) { allocationRatioPlannedVec <- rep(NA_real_, numberOfResults) calculateAllocationRatioPlanned <- TRUE designPlan$optimumAllocationRatio <- TRUE designPlan$.setParameterType("optimumAllocationRatio", C_PARAM_USER_DEFINED) } userDefinedMaxNumberOfSubjects <- .isUserDefinedMaxNumberOfSubjects(designPlan) if (userDefinedMaxNumberOfSubjects && allocationRatioPlanned == 0) { stop( C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "determination of optimum allocation ('allocationRatioPlanned' = 0) not possible ", "for given 'maxNumberOfSubjects' (", designPlan$maxNumberOfSubjects, ")" ) } if (userDefinedMaxNumberOfSubjects) { timeVector <- rep(NA_real_, numberOfResults) } designPlan$.calculateFollowUpTime <- FALSE lambda1 <- designPlan$lambda1 if (designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { lambda1 <- rep(NA_real_, numberOfResults) } for (i in 1:numberOfResults) { phi <- -c( log(1 - designPlan$dropoutRate1), log(1 - designPlan$dropoutRate2) ) / designPlan$dropoutTime if (!userDefinedMaxNumberOfSubjects) { if (calculateAllocationRatioPlanned) { # allocationRatioPlanned = 0 provides optimum sample size allocationRatioPlanned <- stats::optimize(function(x) { numberEvents <- .getEventsFixed( typeOfComputation = typeOfComputation, twoSidedPower = twoSidedPower, alpha = alpha, beta = beta, sided = sided, hazardRatio = hazardRatio[i], thetaH0 = thetaH0, allocationRatioPlanned = x ) if (!accountForObservationTimes) { probEvent <- (x * pi1[i] + pi2) / (1 + x) } else { probEvent <- .getEventProbabilities( time = accrualTime[length(accrualTime)] + designPlan$followUpTime, accrualTimeVector = accrualTime, accrualIntensity = designPlan$accrualIntensity, lambda2 = designPlan$lambda2, lambda1 = lambda1[i], piecewiseSurvivalTime = piecewiseSurvivalTime, phi = phi, kappa = kappa, allocationRatioPlanned = x, hazardRatio = hazardRatio[i] ) } return(numberEvents / probEvent) }, interval = c(0, 5), tol = 0.0001)$minimum allocationRatioPlannedVec[i] <- allocationRatioPlanned } designPlan$eventsFixed[i] <- .getEventsFixed( typeOfComputation = typeOfComputation, twoSidedPower = twoSidedPower, alpha = alpha, beta = beta, sided = sided, hazardRatio = hazardRatio[i], thetaH0 = thetaH0, allocationRatioPlanned = allocationRatioPlanned ) if (!accountForObservationTimes) { designPlan$omega[i] <- (allocationRatioPlanned * pi1[i] + pi2) / (1 + allocationRatioPlanned) } else { designPlan$omega[i] <- .getEventProbabilities( time = accrualTime[length(accrualTime)] + designPlan$followUpTime, accrualTimeVector = accrualTime, accrualIntensity = designPlan$accrualIntensity, lambda2 = designPlan$lambda2, lambda1 = lambda1[i], piecewiseSurvivalTime = piecewiseSurvivalTime, phi = phi, kappa = kappa, allocationRatioPlanned = allocationRatioPlanned, hazardRatio = hazardRatio[i] ) } designPlan$.setParameterType("omega", C_PARAM_GENERATED) designPlan$nFixed[i] <- designPlan$eventsFixed[i] / designPlan$omega[i] } else { if (length(maxNumberOfSubjects) > 1) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of user defined 'maxNumberOfSubjects' (", .arrayToString(maxNumberOfSubjects), ") must be 1" ) } designPlan$.calculateFollowUpTime <- TRUE designPlan$eventsFixed[i] <- .getEventsFixed( typeOfComputation = typeOfComputation, twoSidedPower = twoSidedPower, alpha = alpha, beta = beta, sided = sided, hazardRatio = hazardRatio[i], thetaH0 = thetaH0, allocationRatioPlanned = allocationRatioPlanned ) designPlan$nFixed[i] <- maxNumberOfSubjects if (designPlan$eventsFixed[i] > maxNumberOfSubjects) { if (length(hazardRatio) > 1) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sprintf( paste0( "'maxNumberOfSubjects' (%s) is smaller than the number ", "of events (%.3f) at index %s (hazard ratio = %.3f)" ), maxNumberOfSubjects, designPlan$eventsFixed[i], i, hazardRatio[i] ) ) } else { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sprintf( paste0( "'maxNumberOfSubjects' (%s) is smaller than the number ", "of events (%.3f)" ), maxNumberOfSubjects, designPlan$eventsFixed[i] ) ) } } up <- 2 iterate <- 1 while (designPlan$eventsFixed[i] / .getEventProbabilities( time = up, accrualTimeVector = accrualTime, accrualIntensity = designPlan$accrualIntensity, lambda2 = designPlan$lambda2, lambda1 = lambda1[i], piecewiseSurvivalTime = piecewiseSurvivalTime, phi = phi, kappa = kappa, allocationRatioPlanned = allocationRatioPlanned, hazardRatio = hazardRatio[i] ) > maxNumberOfSubjects) { up <- 2 * up iterate <- iterate + 1 if (iterate > 50) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the number of subjects is too small to reach maximum number of events ", "(presumably due to drop-out rates), search algorithm failed" ) } } timeVector[i] <- .getOneDimensionalRoot( function(x) { designPlan$eventsFixed[i] / .getEventProbabilities( time = x, accrualTimeVector = accrualTime, accrualIntensity = designPlan$accrualIntensity, lambda2 = designPlan$lambda2, lambda1 = lambda1[i], piecewiseSurvivalTime = piecewiseSurvivalTime, phi = phi, kappa = kappa, allocationRatioPlanned = allocationRatioPlanned, hazardRatio = hazardRatio[i] ) - maxNumberOfSubjects }, lower = 0, upper = up, tolerance = 1e-06, callingFunctionInformation = ".getSampleSizeFixedSurvival" ) if (!is.na(timeVector[i])) { designPlan$omega[i] <- .getEventProbabilities( time = timeVector[i], accrualTimeVector = accrualTime, accrualIntensity = designPlan$accrualIntensity, lambda2 = designPlan$lambda2, lambda1 = lambda1[i], piecewiseSurvivalTime = piecewiseSurvivalTime, phi = phi, kappa = kappa, allocationRatioPlanned = allocationRatioPlanned, hazardRatio = hazardRatio[i] ) designPlan$.setParameterType("omega", C_PARAM_GENERATED) } } } if (calculateAllocationRatioPlanned) { allocationRatioPlanned <- allocationRatioPlannedVec designPlan$allocationRatioPlanned <- allocationRatioPlanned designPlan$.setParameterType("allocationRatioPlanned", C_PARAM_GENERATED) } if (userDefinedMaxNumberOfSubjects) { designPlan$followUpTime <- timeVector - accrualTime[length(accrualTime)] designPlan$.setParameterType("followUpTime", C_PARAM_GENERATED) } designPlan$nFixed2 <- designPlan$nFixed / (1 + allocationRatioPlanned) designPlan$nFixed1 <- designPlan$nFixed2 * allocationRatioPlanned if (designPlan$.design$kMax == 1 && designPlan$.accrualTime$.isRelativeAccrualIntensity(designPlan$accrualIntensity)) { designPlan$accrualIntensity <- designPlan$nFixed / designPlan$accrualTime designPlan$.setParameterType("accrualIntensity", C_PARAM_GENERATED) } designPlan$numberOfSubjects1 <- matrix(designPlan$nFixed1, nrow = 1) designPlan$numberOfSubjects2 <- matrix(designPlan$nFixed2, nrow = 1) if (!designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { eventRatio <- allocationRatioPlanned * pi1 / pi2 } else { eventRatio <- NA_real_ } # Fixed designPlan$hazardRatio <- hazardRatio designPlan$expectedEventsH1 <- designPlan$eventsFixed designPlan$maxNumberOfSubjects <- designPlan$nFixed designPlan$numberOfSubjects <- matrix(designPlan$nFixed, nrow = 1) designPlan$.setParameterType("eventsFixed", C_PARAM_GENERATED) designPlan$.setParameterType("nFixed1", C_PARAM_GENERATED) designPlan$.setParameterType("nFixed2", C_PARAM_GENERATED) designPlan$.setParameterType("nFixed", C_PARAM_GENERATED) if (designPlan$accountForObservationTimes) { designPlan$analysisTime <- matrix(accrualTime[length(accrualTime)] + designPlan$followUpTime, nrow = 1) designPlan$.setParameterType("analysisTime", C_PARAM_GENERATED) } return(designPlan) } # note that fixed sample size must be calculated before on 'designPlan' .getSampleSizeSequentialSurvival <- function(designPlan, designCharacteristics) { if (designPlan$.piecewiseSurvivalTime$.isLambdaBased()) { numberOfResults <- length(designPlan$hazardRatio) } else { numberOfResults <- length(designPlan$pi1) } kMax <- designCharacteristics$.design$kMax designPlan$eventsPerStage <- matrix(NA_real_, kMax, numberOfResults) analysisTime <- matrix(NA_real_, kMax, numberOfResults) numberOfSubjects <- matrix(NA_real_, kMax, numberOfResults) designPlan$expectedEventsH0 <- rep(NA_real_, numberOfResults) designPlan$expectedEventsH01 <- rep(NA_real_, numberOfResults) designPlan$expectedEventsH1 <- rep(NA_real_, numberOfResults) expectedNumberOfSubjectsH1 <- rep(NA_real_, numberOfResults) studyDuration <- rep(NA_real_, numberOfResults) designPlan$omega <- rep(NA_real_, numberOfResults) informationRates <- designCharacteristics$information / designCharacteristics$shift lambda1 <- designPlan$lambda1 if (designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { lambda1 <- rep(NA_real_, numberOfResults) } if (designPlan$accountForObservationTimes && designPlan$.calculateFollowUpTime) { designPlan$followUpTime <- rep(NA_real_, numberOfResults) } for (i in 1:numberOfResults) { designPlan$eventsPerStage[, i] <- designPlan$eventsFixed[i] * informationRates * designCharacteristics$inflationFactor if (!designPlan$accountForObservationTimes) { if (length(designPlan$allocationRatioPlanned) > 1) { allocationRatioPlanned <- designPlan$allocationRatioPlanned[i] } else { allocationRatioPlanned <- designPlan$allocationRatioPlanned } designPlan$omega[i] <- (allocationRatioPlanned * designPlan$pi1[i] + designPlan$pi2) / (1 + allocationRatioPlanned) designPlan$.setParameterType("omega", C_PARAM_GENERATED) numberOfSubjects[kMax, i] <- designPlan$eventsPerStage[kMax, i] / designPlan$omega[i] } else { phi <- -c(log(1 - designPlan$dropoutRate1), log(1 - designPlan$dropoutRate2)) / designPlan$dropoutTime if (designPlan$.calculateFollowUpTime) { if (designPlan$eventsPerStage[kMax, i] > designPlan$maxNumberOfSubjects[i]) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sprintf( paste0( "the number of subjects (%s) is smaller than the number ", "of events (%s) at stage %s" ), designPlan$maxNumberOfSubjects[i], designPlan$eventsPerStage[kMax, i], i ) ) } up <- 2 iterate <- 1 while (designPlan$eventsPerStage[kMax, i] / .getEventProbabilities( time = up, accrualTimeVector = designPlan$accrualTime, accrualIntensity = designPlan$accrualIntensity, lambda2 = designPlan$lambda2, lambda1 = lambda1[i], piecewiseSurvivalTime = designPlan$piecewiseSurvivalTime, phi = phi, kappa = designPlan$kappa, allocationRatioPlanned = designPlan$allocationRatioPlanned, hazardRatio = designPlan$hazardRatio[i] ) > designPlan$maxNumberOfSubjects[i]) { up <- 2 * up iterate <- iterate + 1 if (iterate > 50) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the number of subjects is too small to reach maximum number of events ", "(presumably due to drop-out rates)" ) } } totalTime <- .getOneDimensionalRoot( function(x) { designPlan$eventsPerStage[kMax, i] / designPlan$maxNumberOfSubjects[i] - .getEventProbabilities( time = x, accrualTimeVector = designPlan$accrualTime, accrualIntensity = designPlan$accrualIntensity, lambda2 = designPlan$lambda2, lambda1 = lambda1[i], piecewiseSurvivalTime = designPlan$piecewiseSurvivalTime, phi = phi, kappa = designPlan$kappa, allocationRatioPlanned = designPlan$allocationRatioPlanned, hazardRatio = designPlan$hazardRatio[i] ) }, lower = 0, upper = up, tolerance = 1e-06, callingFunctionInformation = ".getSampleSizeSequentialSurvival" ) # analysis times for (j in 1:kMax) { analysisTime[j, i] <- .getOneDimensionalRoot( function(x) { designPlan$eventsPerStage[j, i] / designPlan$maxNumberOfSubjects[i] - .getEventProbabilities( time = x, accrualTimeVector = designPlan$accrualTime, accrualIntensity = designPlan$accrualIntensity, lambda2 = designPlan$lambda2, lambda1 = lambda1[i], piecewiseSurvivalTime = designPlan$piecewiseSurvivalTime, phi = phi, kappa = designPlan$kappa, allocationRatioPlanned = designPlan$allocationRatioPlanned, hazardRatio = designPlan$hazardRatio[i] ) }, lower = 0, upper = totalTime, tolerance = 1e-06, acceptResultsOutOfTolerance = TRUE, callingFunctionInformation = ".getSampleSizeSequentialSurvival" ) } analysisTime[kMax, i] <- totalTime designPlan$followUpTime[i] <- totalTime - designPlan$accrualTime[length(designPlan$accrualTime)] numberOfSubjects[, i] <- .getNumberOfSubjects( time = analysisTime[, i], accrualTime = designPlan$accrualTime, accrualIntensity = designPlan$accrualIntensity, maxNumberOfSubjects = designPlan$maxNumberOfSubjects[i] ) } else { if (length(designPlan$allocationRatioPlanned) > 1) { allocationRatioPlanned <- designPlan$allocationRatioPlanned[i] } else { allocationRatioPlanned <- designPlan$allocationRatioPlanned } if (is.na(designPlan$followUpTime)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'followUpTime' must be defined because 'designPlan$.calculateFollowUpTime' = FALSE" ) } designPlan$omega[i] <- .getEventProbabilities( time = designPlan$accrualTime[length(designPlan$accrualTime)] + designPlan$followUpTime, accrualTimeVector = designPlan$accrualTime, accrualIntensity = designPlan$accrualIntensity, lambda2 = designPlan$lambda2, lambda1 = lambda1[i], piecewiseSurvivalTime = designPlan$piecewiseSurvivalTime, phi = phi, kappa = designPlan$kappa, allocationRatioPlanned = allocationRatioPlanned, hazardRatio = designPlan$hazardRatio[i] ) designPlan$.setParameterType("omega", C_PARAM_GENERATED) numberOfSubjects[kMax, i] <- designPlan$eventsPerStage[kMax, i] / designPlan$omega[i] # Analysis times for (j in 1:(kMax - 1)) { analysisTime[j, i] <- .getOneDimensionalRoot( function(x) { designPlan$eventsPerStage[j, i] / numberOfSubjects[kMax, i] - .getEventProbabilities( time = x, accrualTimeVector = designPlan$accrualTime, accrualIntensity = designPlan$accrualIntensity, lambda2 = designPlan$lambda2, lambda1 = lambda1[i], piecewiseSurvivalTime = designPlan$piecewiseSurvivalTime, phi = phi, kappa = designPlan$kappa, allocationRatioPlanned = allocationRatioPlanned, hazardRatio = designPlan$hazardRatio[i] ) }, lower = 0, upper = designPlan$accrualTime[length(designPlan$accrualTime)] + designPlan$followUpTime, tolerance = 1e-06, callingFunctionInformation = ".getSampleSizeSequentialSurvival" ) } analysisTime[kMax, i] <- designPlan$accrualTime[length(designPlan$accrualTime)] + designPlan$followUpTime numberOfSubjects[, i] <- .getNumberOfSubjects( time = analysisTime[, i], accrualTime = designPlan$accrualTime, accrualIntensity = designPlan$accrualIntensity, maxNumberOfSubjects = numberOfSubjects[kMax, i] ) } stoppingProbs <- designCharacteristics$rejectionProbabilities + c(designCharacteristics$futilityProbabilities, 0) if (all(is.na(designCharacteristics$futilityProbabilities))) { warning("Expected number of subjects H1 and study duration H1 ", "cannot be calculated because the futility probabilities ", "are not applicable for the specified design", call. = FALSE ) } stoppingProbs[kMax] <- 1 - sum(stoppingProbs[1:(kMax - 1)]) studyDuration[i] <- analysisTime[, i] %*% stoppingProbs expectedNumberOfSubjectsH1[i] <- numberOfSubjects[, i] %*% stoppingProbs } designPlan$expectedEventsH0[i] <- designCharacteristics$averageSampleNumber0 * designPlan$eventsFixed[i] designPlan$expectedEventsH01[i] <- designCharacteristics$averageSampleNumber01 * designPlan$eventsFixed[i] designPlan$expectedEventsH1[i] <- designCharacteristics$averageSampleNumber1 * designPlan$eventsFixed[i] designPlan$.setParameterType("expectedEventsH0", C_PARAM_GENERATED) designPlan$.setParameterType("expectedEventsH01", C_PARAM_GENERATED) designPlan$.setParameterType("expectedEventsH1", C_PARAM_GENERATED) designPlan$numberOfSubjects2 <- numberOfSubjects / (1 + designPlan$allocationRatioPlanned) designPlan$numberOfSubjects1 <- designPlan$numberOfSubjects2 * designPlan$allocationRatioPlanned designPlan$.setParameterType("numberOfSubjects1", C_PARAM_GENERATED) designPlan$.setParameterType("numberOfSubjects2", C_PARAM_GENERATED) } if (!is.null(designCharacteristics$rejectionProbabilities)) { designPlan$rejectPerStage <- matrix(designCharacteristics$rejectionProbabilities, nrow = designPlan$.design$kMax ) designPlan$.setParameterType("rejectPerStage", C_PARAM_GENERATED) designPlan$earlyStop <- sum(designPlan$rejectPerStage[1:(designPlan$.design$kMax - 1), ]) designPlan$.setParameterType("earlyStop", C_PARAM_GENERATED) } if (!is.null(designCharacteristics$futilityProbabilities) && any(designPlan$.design$futilityBounds != C_FUTILITY_BOUNDS_DEFAULT)) { designPlan$futilityPerStage <- matrix(designCharacteristics$futilityProbabilities, nrow = designPlan$.design$kMax - 1 ) designPlan$.setParameterType("futilityPerStage", C_PARAM_GENERATED) designPlan$futilityStop <- sum(designPlan$futilityPerStage) designPlan$.setParameterType("futilityStop", C_PARAM_GENERATED) designPlan$earlyStop <- designPlan$earlyStop + sum(designPlan$futilityPerStage) } designPlan$informationRates <- matrix(informationRates, ncol = 1) if (!is.matrix(numberOfSubjects)) { designPlan$numberOfSubjects <- matrix(numberOfSubjects[kMax, ], nrow = 1) } else { designPlan$numberOfSubjects <- numberOfSubjects } designPlan$maxNumberOfSubjects <- designPlan$numberOfSubjects[kMax, ] if (designPlan$.getParameterType("maxNumberOfSubjects") == C_PARAM_NOT_APPLICABLE || length(designPlan$maxNumberOfSubjects) > 1) { designPlan$.setParameterType("maxNumberOfSubjects", C_PARAM_GENERATED) } designPlan$maxNumberOfSubjects1 <- .getNumberOfSubjects1( designPlan$maxNumberOfSubjects, designPlan$allocationRatioPlanned ) designPlan$maxNumberOfSubjects2 <- .getNumberOfSubjects2( designPlan$maxNumberOfSubjects, designPlan$allocationRatioPlanned ) designPlan$.setParameterType("maxNumberOfSubjects1", C_PARAM_GENERATED) designPlan$.setParameterType("maxNumberOfSubjects2", C_PARAM_GENERATED) if (ncol(designPlan$informationRates) == 1 && identical(designPlan$informationRates[, 1], designPlan$.design$informationRates)) { designPlan$.setParameterType("informationRates", C_PARAM_NOT_APPLICABLE) } else { designPlan$.setParameterType("informationRates", C_PARAM_GENERATED) } designPlan$.setParameterType("numberOfSubjects", C_PARAM_GENERATED) designPlan$.setParameterType("eventsPerStage", C_PARAM_GENERATED) if (designPlan$accountForObservationTimes) { designPlan$analysisTime <- analysisTime designPlan$expectedNumberOfSubjectsH1 <- expectedNumberOfSubjectsH1 designPlan$studyDuration <- studyDuration designPlan$studyDurationH1 <- studyDuration # deprecated designPlan$.setParameterType("analysisTime", C_PARAM_GENERATED) designPlan$.setParameterType("expectedNumberOfSubjectsH1", C_PARAM_GENERATED) designPlan$.setParameterType("studyDuration", C_PARAM_GENERATED) } designPlan$.setParameterType("eventsFixed", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("nFixed1", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("nFixed2", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("nFixed", C_PARAM_NOT_APPLICABLE) if (designPlan$allocationRatioPlanned[1] == 1) { designPlan$.setParameterType("numberOfSubjects1", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("numberOfSubjects2", C_PARAM_NOT_APPLICABLE) } designPlan$.calculateFollowUpTime <- NA return(designPlan) } # Note that 'directionUpper' and 'maxNumberOfSubjects' are only applicable # for 'objectType' = "sampleSize" .createDesignPlanMeans <- function(..., objectType = c("power", "sampleSize"), design, normalApproximation = FALSE, meanRatio = FALSE, thetaH0 = ifelse(meanRatio, 1, 0), alternative = NA_real_, stDev = C_STDEV_DEFAULT, directionUpper = NA, maxNumberOfSubjects = NA_real_, groups = 2, allocationRatioPlanned = NA_real_) { objectType <- match.arg(objectType) .assertIsTrialDesignInverseNormalOrGroupSequential(design) .assertIsValidAlphaAndBeta(design$alpha, design$beta) .assertIsValidSidedParameter(design$sided) .assertIsValidStandardDeviation(stDev) .assertIsValidGroupsParameter(groups) .assertIsSingleNumber(thetaH0, "thetaH0") .assertIsSingleLogical(meanRatio, "meanRatio") .assertIsValidThetaH0(thetaH0, endpoint = "means", groups = groups, ratioEnabled = meanRatio) .assertIsSingleLogical(normalApproximation, "normalApproximation") if (meanRatio) { if (identical(alternative, C_ALTERNATIVE_POWER_SIMULATION_DEFAULT)) { alternative <- C_ALTERNATIVE_POWER_SIMULATION_MEAN_RATIO_DEFAULT } .assertIsInOpenInterval(alternative, "alternative", 0, NULL, naAllowed = TRUE) } directionUpper <- .assertIsValidDirectionUpper(directionUpper, design$sided, objectType) if (objectType == "sampleSize" && !any(is.na(alternative))) { if (design$sided == 1 && any(alternative - thetaH0 <= 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "any 'alternative' (", .arrayToString(alternative), ") must be > 'thetaH0' (", thetaH0, ")" ) } if (any(alternative - thetaH0 == 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "any 'alternative' (", .arrayToString(alternative), ") must be != 'thetaH0' (", thetaH0, ")" ) } } designPlan <- TrialDesignPlanMeans(design = design, meanRatio = meanRatio) designPlan$.setSampleSizeObject(objectType) designPlan$criticalValuesPValueScale <- matrix(design$stageLevels, ncol = 1) if (design$sided == 2) { designPlan$criticalValuesPValueScale <- designPlan$criticalValuesPValueScale * 2 designPlan$.setParameterType("criticalValuesPValueScale", C_PARAM_GENERATED) } if (any(design$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { designPlan$futilityBoundsPValueScale <- matrix(1 - stats::pnorm(design$futilityBounds), ncol = 1) designPlan$.setParameterType("futilityBoundsPValueScale", C_PARAM_GENERATED) } if (groups == 2) { if (design$sided == 2 && ((thetaH0 != 0 && !meanRatio) || (thetaH0 != 1 && meanRatio))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "two-sided case is implemented only for superiority testing (i.e., thetaH0 = ", ifelse(meanRatio, 1, 0), ")" ) } if (is.na(allocationRatioPlanned)) { allocationRatioPlanned <- C_ALLOCATION_RATIO_DEFAULT } if (allocationRatioPlanned < 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'allocationRatioPlanned' (", allocationRatioPlanned, ") must be >= 0" ) } .setValueAndParameterType(designPlan, "allocationRatioPlanned", allocationRatioPlanned, 1) if (meanRatio && thetaH0 <= 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "null hypothesis mean ratio is not allowed be negative or zero, ", "i.e., 'thetaH0' must be > 0 if 'meanRatio' = TRUE" ) } } .setValueAndParameterType(designPlan, "normalApproximation", normalApproximation, FALSE) .setValueAndParameterType(designPlan, "meanRatio", meanRatio, FALSE) .setValueAndParameterType(designPlan, "thetaH0", thetaH0, 0) if (objectType == "power") { .setValueAndParameterType( designPlan, "alternative", alternative, C_ALTERNATIVE_POWER_SIMULATION_DEFAULT ) } else { .setValueAndParameterType(designPlan, "alternative", alternative, C_ALTERNATIVE_DEFAULT) } .setValueAndParameterType(designPlan, "stDev", stDev, C_STDEV_DEFAULT) if (objectType == "power") { .assertIsValidMaxNumberOfSubjects(maxNumberOfSubjects) .setValueAndParameterType(designPlan, "maxNumberOfSubjects", maxNumberOfSubjects, NA_real_) .setValueAndParameterType(designPlan, "directionUpper", directionUpper, TRUE) designPlan$.setParameterType("effect", C_PARAM_GENERATED) } .setValueAndParameterType(designPlan, "groups", groups, 2) if (groups == 1) { if (isTRUE(meanRatio)) { warning("'meanRatio' (", meanRatio, ") will be ignored ", "because it is not applicable for 'groups' = 1", call. = FALSE) } designPlan$.setParameterType("meanRatio", C_PARAM_NOT_APPLICABLE) if (length(allocationRatioPlanned) == 1 && !is.na(allocationRatioPlanned)) { warning("'allocationRatioPlanned' (", allocationRatioPlanned, ") will be ignored because it is not applicable for 'groups' = 1", call. = FALSE ) } designPlan$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) } return(designPlan) } # Note that 'directionUpper' and 'maxNumberOfSubjects' are only applicable for 'objectType' = "sampleSize" .createDesignPlanRates <- function(..., objectType = c("power", "sampleSize"), design, normalApproximation = TRUE, riskRatio = FALSE, thetaH0 = ifelse(riskRatio, 1, 0), pi1 = C_PI_1_SAMPLE_SIZE_DEFAULT, pi2 = C_PI_2_DEFAULT, directionUpper = NA, maxNumberOfSubjects = NA_real_, groups = 2, allocationRatioPlanned = NA_real_) { objectType <- match.arg(objectType) .assertIsTrialDesignInverseNormalOrGroupSequential(design) .assertIsValidAlphaAndBeta(design$alpha, design$beta) .assertIsValidSidedParameter(design$sided) .assertIsValidGroupsParameter(groups) .assertIsSingleLogical(normalApproximation, "normalApproximation") .assertIsSingleLogical(riskRatio, "riskRatio") directionUpper <- .assertIsValidDirectionUpper(directionUpper, design$sided, objectType) if (groups == 1) { if (!any(is.na(pi1)) && any(pi1 == thetaH0) && (objectType == "sampleSize")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "any 'pi1' (", .arrayToString(pi1), ") must be != 'thetaH0' (", thetaH0, ")" ) } if (any(is.na(pi1)) || any(pi1 <= 0) || any(pi1 >= 1)) { stop( C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "probability 'pi1' (", .arrayToString(pi1), ") is out of bounds (0; 1)" ) } if (thetaH0 >= 1 || thetaH0 <= 0) { stop(C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'thetaH0' (", thetaH0, ") is out of bounds (0; 1)") } if (!normalApproximation && design$sided == 2) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "exact sample size calculation not available for two-sided testing" ) } } else if (groups == 2) { if (!any(is.na(c(pi1, pi2))) && any(pi1 - pi2 == thetaH0) && (objectType == "sampleSize") && !riskRatio) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "any 'pi1 - pi2' (", .arrayToString(pi1 - pi2), ") must be != 'thetaH0' (", thetaH0, ")" ) } if (!any(is.na(c(pi1, pi2))) && any(pi1 / pi2 == thetaH0) && (objectType == "sampleSize") && riskRatio) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "any 'pi1 / pi2' (", .arrayToString(pi1 / pi2), ") must be != 'thetaH0' (", thetaH0, ")" ) } if (any(is.na(pi1)) || any(pi1 <= 0) || any(pi1 >= 1)) { stop( C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "probability 'pi1' (", .arrayToString(pi1), ") is out of bounds (0; 1)" ) } if (any(is.na(pi2)) || any(pi2 <= 0) || any(pi2 >= 1)) { stop( C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "probability 'pi2' (", .arrayToString(pi2), ") is out of bounds (0; 1)" ) } if (design$sided == 2 && ((thetaH0 != 0 && !riskRatio) || (thetaH0 != 1 && riskRatio))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "two-sided case is implemented only for superiority testing") } if (!normalApproximation) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "only normal approximation case is implemented for two groups" ) } if (is.na(allocationRatioPlanned)) { allocationRatioPlanned <- C_ALLOCATION_RATIO_DEFAULT } if (allocationRatioPlanned < 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'allocationRatioPlanned' (", allocationRatioPlanned, ") must be >= 0" ) } if (riskRatio && thetaH0 <= 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "null hypothesis risk ratio is not allowed be negative or zero, ", "i.e., 'thetaH0' must be > 0 if 'riskRatio' = TRUE" ) } } designPlan <- TrialDesignPlanRates(design = design) designPlan$.setSampleSizeObject(objectType) designPlan$criticalValuesPValueScale <- matrix(design$stageLevels, ncol = 1) if (design$sided == 2) { designPlan$criticalValuesPValueScale <- designPlan$criticalValuesPValueScale * 2 designPlan$.setParameterType("criticalValuesPValueScale", C_PARAM_GENERATED) } if (any(design$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { designPlan$futilityBoundsPValueScale <- matrix(1 - stats::pnorm(design$futilityBounds), ncol = 1) designPlan$.setParameterType("futilityBoundsPValueScale", C_PARAM_GENERATED) } if (objectType == "power") { .assertIsValidMaxNumberOfSubjects(maxNumberOfSubjects) .setValueAndParameterType(designPlan, "maxNumberOfSubjects", maxNumberOfSubjects, NA_real_) .setValueAndParameterType(designPlan, "directionUpper", directionUpper, TRUE) designPlan$.setParameterType("effect", C_PARAM_GENERATED) } .setValueAndParameterType(designPlan, "normalApproximation", normalApproximation, TRUE) .setValueAndParameterType(designPlan, "thetaH0", thetaH0, ifelse(riskRatio, 1, 0)) .assertIsValidThetaH0(thetaH0, endpoint = "rates", groups = groups, ratioEnabled = riskRatio) if (objectType == "power") { .setValueAndParameterType(designPlan, "pi1", pi1, C_PI_1_DEFAULT) } else { .setValueAndParameterType(designPlan, "pi1", pi1, C_PI_1_SAMPLE_SIZE_DEFAULT) } .setValueAndParameterType(designPlan, "pi2", pi2, 0.2) if (groups == 1) { if (designPlan$.getParameterType("pi2") == C_PARAM_USER_DEFINED) { warning("'pi2' (", pi2, ") will be ignored ", "because it is not applicable for 'groups' = 1", call. = FALSE) } designPlan$.setParameterType("pi2", C_PARAM_NOT_APPLICABLE) if (isTRUE(riskRatio)) { warning("'riskRatio' (", riskRatio, ") will be ignored ", "because it is not applicable for 'groups' = 1", call. = FALSE) } designPlan$.setParameterType("riskRatio", C_PARAM_NOT_APPLICABLE) if (length(allocationRatioPlanned) == 1 && !is.na(allocationRatioPlanned)) { warning("'allocationRatioPlanned' (", allocationRatioPlanned, ") will be ignored because it is not applicable for 'groups' = 1", call. = FALSE ) } designPlan$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) } else { .setValueAndParameterType(designPlan, "riskRatio", riskRatio, FALSE) .setValueAndParameterType( designPlan, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT ) } .setValueAndParameterType(designPlan, "groups", groups, 2) return(designPlan) } #' @title #' Get Power Means #' #' @description #' Returns the power, stopping probabilities, and expected sample size for #' testing means in one or two samples at given sample size. #' #' @inheritParams param_design_with_default #' @inheritParams param_groups #' @param normalApproximation The type of computation of the p-values. If \code{TRUE}, the variance is #' assumed to be known, default is \code{FALSE}, i.e., the calculations are performed #' with the t distribution. #' @param meanRatio If \code{TRUE}, the sample size for #' one-sided testing of H0: \code{mu1 / mu2 = thetaH0} is calculated, default is \code{FALSE}. #' @inheritParams param_thetaH0 #' @inheritParams param_alternative #' @inheritParams param_stDev #' @inheritParams param_allocationRatioPlanned #' @inheritParams param_directionUpper #' @inheritParams param_maxNumberOfSubjects #' @inheritParams param_three_dots #' #' @details #' At given design the function calculates the power, stopping probabilities, #' and expected sample size, for testing means at given sample size. #' In a two treatment groups design, additionally, an #' allocation ratio = \code{n1 / n2} can be specified. #' A null hypothesis value thetaH0 != 0 for testing the difference of two means #' or \code{thetaH0 != 1} for testing the ratio of two means can be specified. #' For the specified sample size, critical bounds and stopping for futility #' bounds are provided at the effect scale (mean, mean difference, or #' mean ratio, respectively) #' #' @template return_object_trial_design_plan #' @template how_to_get_help_for_generics #' #' @family power functions #' #' @template examples_get_power_means #' #' @export #' getPowerMeans <- function(design = NULL, ..., groups = 2L, normalApproximation = FALSE, meanRatio = FALSE, thetaH0 = ifelse(meanRatio, 1, 0), alternative = seq(0, 1, 0.2), # C_ALTERNATIVE_POWER_SIMULATION_DEFAULT stDev = 1, # C_STDEV_DEFAULT directionUpper = NA, maxNumberOfSubjects = NA_real_, allocationRatioPlanned = NA_real_ # C_ALLOCATION_RATIO_DEFAULT ) { .assertIsValidMaxNumberOfSubjects(maxNumberOfSubjects) if (is.null(design)) { design <- .getDefaultDesign(..., type = "power") .warnInCaseOfUnknownArguments( functionName = "getPowerMeans", ignore = .getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), ... ) } else { .warnInCaseOfUnknownArguments(functionName = "getPowerMeans", ...) .assertIsTrialDesign(design) .warnInCaseOfTwoSidedPowerArgument(...) .warnInCaseOfTwoSidedPowerIsDisabled(design) } designPlan <- .createDesignPlanMeans( objectType = "power", design = design, normalApproximation = normalApproximation, meanRatio = meanRatio, thetaH0 = thetaH0, alternative = alternative, stDev = stDev, directionUpper = directionUpper, maxNumberOfSubjects = maxNumberOfSubjects, groups = groups, allocationRatioPlanned = allocationRatioPlanned, ... ) if (designPlan$groups == 1) { theta <- (designPlan$alternative - designPlan$thetaH0) / designPlan$stDev if (!is.na(designPlan$directionUpper) && !designPlan$directionUpper) { theta <- -theta } if (designPlan$normalApproximation) { powerAndAverageSampleNumber <- getPowerAndAverageSampleNumber( design, theta, maxNumberOfSubjects ) } else { thetaAdj <- (sign(theta) * .getOneMinusQNorm(design$alpha / design$sided) - .getQNorm(stats::pt( sign(theta) * stats::qt(1 - design$alpha / design$sided, maxNumberOfSubjects - 1), maxNumberOfSubjects - 1, theta * sqrt(maxNumberOfSubjects) ))) / sqrt(maxNumberOfSubjects) powerAndAverageSampleNumber <- getPowerAndAverageSampleNumber( design, thetaAdj, maxNumberOfSubjects ) } } else { if (!designPlan$meanRatio) { theta <- sqrt(designPlan$allocationRatioPlanned) / (1 + designPlan$allocationRatioPlanned) * (designPlan$alternative - designPlan$thetaH0) / designPlan$stDev } else { theta <- sqrt(designPlan$allocationRatioPlanned) / sqrt((1 + designPlan$allocationRatioPlanned * designPlan$thetaH0^2) * (1 + designPlan$allocationRatioPlanned)) * (designPlan$alternative - designPlan$thetaH0) / designPlan$stDev } if (!is.na(designPlan$directionUpper) && !designPlan$directionUpper) { theta <- -theta } if (designPlan$normalApproximation) { powerAndAverageSampleNumber <- getPowerAndAverageSampleNumber( design, theta, maxNumberOfSubjects ) } else { thetaAdj <- (sign(theta) * .getOneMinusQNorm(design$alpha / design$sided) - .getQNorm(stats::pt( sign(theta) * stats::qt(1 - design$alpha / design$sided, maxNumberOfSubjects - 2), maxNumberOfSubjects - 2, theta * sqrt(maxNumberOfSubjects) ))) / sqrt(maxNumberOfSubjects) powerAndAverageSampleNumber <- getPowerAndAverageSampleNumber( design, thetaAdj, maxNumberOfSubjects ) } } designPlan$effect <- designPlan$alternative - designPlan$thetaH0 designPlan$expectedNumberOfSubjects <- powerAndAverageSampleNumber$averageSampleNumber designPlan$overallReject <- powerAndAverageSampleNumber$overallReject designPlan$rejectPerStage <- powerAndAverageSampleNumber$rejectPerStage designPlan$futilityStop <- powerAndAverageSampleNumber$overallFutility designPlan$futilityPerStage <- powerAndAverageSampleNumber$futilityPerStage designPlan$earlyStop <- powerAndAverageSampleNumber$overallEarlyStop parameterNames <- c("overallReject") if (design$kMax > 1) { parameterNames <- c( parameterNames, "expectedNumberOfSubjects", "rejectPerStage", "futilityStop", "futilityPerStage", "earlyStop" ) } for (parameterName in parameterNames) { designPlan$.setParameterType(parameterName, C_PARAM_GENERATED) } .addNumberOfSubjectsToPowerResult(designPlan) .addEffectScaleBoundaryDataToDesignPlan(designPlan) .hideFutilityStopsIfNotApplicable(designPlan) return(designPlan) } #' @title #' Get Power Rates #' #' @description #' Returns the power, stopping probabilities, and expected sample size for testing rates in one or two samples at given sample sizes. #' #' @inheritParams param_design_with_default #' @inheritParams param_groups #' @param riskRatio If \code{TRUE}, the power for one-sided #' testing of H0: \code{pi1 / pi2 = thetaH0} is calculated, default is \code{FALSE}. #' @inheritParams param_thetaH0 #' @inheritParams param_pi1_rates #' @inheritParams param_pi2_rates #' @inheritParams param_directionUpper #' @inheritParams param_maxNumberOfSubjects #' @inheritParams param_allocationRatioPlanned #' @inheritParams param_three_dots #' #' @details #' At given design the function calculates the power, stopping probabilities, and expected sample size, #' for testing rates for given maximum sample size. #' The sample sizes over the stages are calculated according to the specified information rate in the design. #' In a two treatment groups design, additionally, an allocation ratio = n1/n2 can be specified. #' If a null hypothesis value thetaH0 != 0 for testing the difference of two rates #' or \code{thetaH0 != 1} for testing the risk ratio is specified, the #' formulas according to Farrington & Manning (Statistics in Medicine, 1990) are used (only one-sided testing). #' Critical bounds and stopping for futility bounds are provided at the effect scale (rate, rate difference, or rate ratio, respectively). #' For the two-sample case, the calculation here is performed at fixed pi2 as given as argument in the function. #' Note that the power calculation for rates is always based on the normal approximation. #' #' @template return_object_trial_design_plan #' @template how_to_get_help_for_generics #' #' @family power functions #' #' @template examples_get_power_rates #' #' @export #' getPowerRates <- function(design = NULL, ..., groups = 2L, riskRatio = FALSE, thetaH0 = ifelse(riskRatio, 1, 0), pi1 = seq(0.2, 0.5, 0.1), # C_PI_1_DEFAULT pi2 = 0.2, # C_PI_2_DEFAULT directionUpper = NA, maxNumberOfSubjects = NA_real_, allocationRatioPlanned = NA_real_ # C_ALLOCATION_RATIO_DEFAULT ) { if (is.null(design)) { design <- .getDefaultDesign(..., type = "power") .warnInCaseOfUnknownArguments( functionName = "getPowerRates", ignore = .getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), ... ) } else { .warnInCaseOfUnknownArguments(functionName = "getPowerRates", ...) .assertIsTrialDesign(design) .warnInCaseOfTwoSidedPowerArgument(...) .warnInCaseOfTwoSidedPowerIsDisabled(design) } designPlan <- .createDesignPlanRates( objectType = "power", design = design, riskRatio = riskRatio, thetaH0 = thetaH0, pi1 = pi1, pi2 = pi2, directionUpper = directionUpper, maxNumberOfSubjects = maxNumberOfSubjects, groups = groups, allocationRatioPlanned = allocationRatioPlanned, ... ) if (!is.na(allocationRatioPlanned) && allocationRatioPlanned <= 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "allocation ratio must be > 0") } allocationRatioPlanned <- designPlan$allocationRatioPlanned theta <- rep(NA_real_, length(pi1)) if (groups == 1) { designPlan$effect <- pi1 - thetaH0 theta <- (pi1 - thetaH0) / sqrt(pi1 * (1 - pi1)) + sign(pi1 - thetaH0) * .getOneMinusQNorm(design$alpha / design$sided) * (1 - sqrt(thetaH0 * (1 - thetaH0) / (pi1 * (1 - pi1)))) / sqrt(maxNumberOfSubjects) } else { if (!riskRatio) { designPlan$effect <- pi1 - pi2 - thetaH0 for (i in (1:length(pi1))) { fm <- .getFarringtonManningValues( rate1 = pi1[i], rate2 = pi2, theta = thetaH0, allocation = allocationRatioPlanned, method = "diff" ) theta[i] <- sqrt(allocationRatioPlanned) / (1 + allocationRatioPlanned) * ( (pi1[i] - pi2 - thetaH0) * sqrt(1 + allocationRatioPlanned) / sqrt(pi1[i] * (1 - pi1[i]) + allocationRatioPlanned * pi2 * (1 - pi2)) + sign(pi1[i] - pi2 - thetaH0) * .getOneMinusQNorm(design$alpha / design$sided) * (1 - sqrt(fm$ml1 * (1 - fm$ml1) + allocationRatioPlanned * fm$ml2 * (1 - fm$ml2)) / sqrt(pi1[i] * (1 - pi1[i]) + allocationRatioPlanned * pi2 * (1 - pi2))) * (1 + allocationRatioPlanned) / sqrt(allocationRatioPlanned * maxNumberOfSubjects)) } } else { designPlan$effect <- pi1 / pi2 - thetaH0 for (i in (1:length(pi1))) { fm <- .getFarringtonManningValues( rate1 = pi1[i], rate2 = pi2, theta = thetaH0, allocation = allocationRatioPlanned, method = "ratio" ) theta[i] <- sqrt(allocationRatioPlanned) / (1 + allocationRatioPlanned) * ( (pi1[i] - thetaH0 * pi2) * sqrt(1 + allocationRatioPlanned) / sqrt(pi1[i] * (1 - pi1[i]) + allocationRatioPlanned * thetaH0^2 * pi2 * (1 - pi2)) + sign(pi1[i] - thetaH0 * pi2) * .getOneMinusQNorm(design$alpha / design$sided) * (1 - sqrt(fm$ml1 * (1 - fm$ml1) + allocationRatioPlanned * thetaH0^2 * fm$ml2 * (1 - fm$ml2)) / sqrt(pi1[i] * (1 - pi1[i]) + allocationRatioPlanned * thetaH0^2 * pi2 * (1 - pi2))) * (1 + allocationRatioPlanned) / sqrt(allocationRatioPlanned * maxNumberOfSubjects)) } } } if (!is.na(designPlan$directionUpper) && !designPlan$directionUpper) { theta <- -theta } powerAndAverageSampleNumber <- getPowerAndAverageSampleNumber(design, theta, maxNumberOfSubjects) designPlan$expectedNumberOfSubjects <- powerAndAverageSampleNumber$averageSampleNumber designPlan$overallReject <- powerAndAverageSampleNumber$overallReject designPlan$rejectPerStage <- powerAndAverageSampleNumber$rejectPerStage designPlan$futilityStop <- powerAndAverageSampleNumber$overallFutility designPlan$futilityPerStage <- powerAndAverageSampleNumber$futilityPerStage designPlan$earlyStop <- powerAndAverageSampleNumber$overallEarlyStop parameterNames <- c("overallReject") if (design$kMax > 1) { parameterNames <- c( parameterNames, "expectedNumberOfSubjects", "rejectPerStage", "futilityStop", "futilityPerStage", "earlyStop" ) } for (parameterName in parameterNames) { designPlan$.setParameterType(parameterName, C_PARAM_GENERATED) } .addNumberOfSubjectsToPowerResult(designPlan) .addEffectScaleBoundaryDataToDesignPlan(designPlan) .hideFutilityStopsIfNotApplicable(designPlan) return(designPlan) } .getNumberOfSubjectsInner <- function(..., timeValue, accrualTime, accrualIntensity, maxNumberOfSubjects) { .assertIsSingleNumber(timeValue, "timeValue") if (length(accrualTime) != length(accrualIntensity)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'accrualTime' (", length(accrualIntensity), ") ", "must be equel to length of 'accrualIntensity' (", length(accrualIntensity), ")" ) } densityIntervals <- accrualTime if (length(accrualTime) > 1) { densityIntervals[2:length(accrualTime)] <- accrualTime[2:length(accrualTime)] - accrualTime[1:(length(accrualTime) - 1)] } densityVector <- accrualIntensity / sum(densityIntervals * accrualIntensity) for (l in 1:length(densityVector)) { if (timeValue <= accrualTime[l]) { if (l == 1) { return(timeValue * densityVector[l] * maxNumberOfSubjects) } else { return((sum(densityVector[1:(l - 1)] * densityIntervals[1:(l - 1)]) + (timeValue - accrualTime[l - 1]) * densityVector[l]) * maxNumberOfSubjects) } } } return(maxNumberOfSubjects) } .getNumberOfSubjects <- function(..., time, accrualTime, accrualIntensity, maxNumberOfSubjects) { subjectNumbers <- c() for (timeValue in time) { if (is.na(timeValue)) { return(NA_real_) } subjectNumbers <- c( subjectNumbers, .getNumberOfSubjectsInner( timeValue = timeValue, accrualTime = accrualTime, accrualIntensity = accrualIntensity, maxNumberOfSubjects = maxNumberOfSubjects ) ) } return(subjectNumbers) } #' @title #' Get Power Survival #' #' @description #' Returns the power, stopping probabilities, and expected sample size for testing #' the hazard ratio in a two treatment groups survival design. #' #' @inheritParams param_design_with_default #' @inheritParams param_typeOfComputation #' @inheritParams param_allocationRatioPlanned #' @inheritParams param_thetaH0 #' @inheritParams param_lambda1 #' @inheritParams param_lambda2 #' @inheritParams param_pi1_survival #' @inheritParams param_pi2_survival #' @inheritParams param_median1 #' @inheritParams param_median2 #' @inheritParams param_piecewiseSurvivalTime #' @inheritParams param_directionUpper #' @inheritParams param_accrualTime #' @inheritParams param_accrualIntensity #' @inheritParams param_accrualIntensityType #' @inheritParams param_eventTime #' @inheritParams param_hazardRatio #' @inheritParams param_kappa #' @inheritParams param_dropoutRate1 #' @inheritParams param_dropoutRate2 #' @inheritParams param_dropoutTime #' @param maxNumberOfEvents \code{maxNumberOfEvents > 0} is the maximum number of events, it determines #' the power of the test and needs to be specified. #' @inheritParams param_maxNumberOfSubjects_survival #' @inheritParams param_three_dots #' #' @details #' At given design the function calculates the power, stopping probabilities, and expected #' sample size at given number of events and number of subjects. #' It also calculates the time when the required events are expected under the given #' assumptions (exponentially, piecewise exponentially, or Weibull distributed survival times #' and constant or non-constant piecewise accrual). #' Additionally, an allocation ratio = n1/n2 can be specified where n1 and n2 are the number #' of subjects in the two treatment groups. #' #' The formula of Kim & Tsiatis (Biometrics, 1990) #' is used to calculate the expected number of events under the alternative #' (see also Lakatos & Lan, Statistics in Medicine, 1992). These formulas are generalized to piecewise survival times and #' non-constant piecewise accrual over time.\cr #' #' @template details_piecewise_survival #' #' @template details_piecewise_accrual #' #' @template return_object_trial_design_plan #' @template how_to_get_help_for_generics #' #' @family power functions #' #' @template examples_get_power_survival #' #' @export #' getPowerSurvival <- function(design = NULL, ..., typeOfComputation = c("Schoenfeld", "Freedman", "HsiehFreedman"), thetaH0 = 1, # C_THETA_H0_SURVIVAL_DEFAULT directionUpper = NA, pi1 = NA_real_, pi2 = NA_real_, lambda1 = NA_real_, lambda2 = NA_real_, median1 = NA_real_, median2 = NA_real_, kappa = 1, hazardRatio = NA_real_, piecewiseSurvivalTime = NA_real_, allocationRatioPlanned = 1, # C_ALLOCATION_RATIO_DEFAULT eventTime = 12L, # C_EVENT_TIME_DEFAULT accrualTime = c(0L, 12L), # C_ACCRUAL_TIME_DEFAULT accrualIntensity = 0.1, # C_ACCRUAL_INTENSITY_DEFAULT accrualIntensityType = c("auto", "absolute", "relative"), maxNumberOfSubjects = NA_real_, maxNumberOfEvents = NA_real_, dropoutRate1 = 0, # C_DROP_OUT_RATE_1_DEFAULT dropoutRate2 = 0, # C_DROP_OUT_RATE_2_DEFAULT dropoutTime = 12L # C_DROP_OUT_TIME_DEFAULT ) { if (is.null(design)) { design <- .getDefaultDesign(..., type = "power") .warnInCaseOfUnknownArguments( functionName = "getPowerSurvival", ignore = .getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), ... ) } else { .assertIsTrialDesign(design) .warnInCaseOfUnknownArguments(functionName = "getPowerSurvival", ...) .warnInCaseOfTwoSidedPowerArgument(...) .warnInCaseOfTwoSidedPowerIsDisabled(design) } designPlan <- .createDesignPlanSurvival( objectType = "power", design = design, typeOfComputation = typeOfComputation, thetaH0 = thetaH0, pi2 = pi2, pi1 = pi1, allocationRatioPlanned = allocationRatioPlanned, accountForObservationTimes = TRUE, eventTime = eventTime, accrualTime = accrualTime, accrualIntensity = accrualIntensity, accrualIntensityType = accrualIntensityType, kappa = kappa, piecewiseSurvivalTime = piecewiseSurvivalTime, lambda2 = lambda2, lambda1 = lambda1, median1 = median1, median2 = median2, directionUpper = directionUpper, maxNumberOfEvents = maxNumberOfEvents, maxNumberOfSubjects = maxNumberOfSubjects, dropoutRate1 = dropoutRate1, dropoutRate2 = dropoutRate2, dropoutTime = dropoutTime, hazardRatio = hazardRatio ) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) if (designPlan$typeOfComputation == "Schoenfeld") { theta <- sqrt(allocationRatioPlanned) / (1 + allocationRatioPlanned) * (log(designPlan$hazardRatio / thetaH0)) } else if (designPlan$typeOfComputation == "Freedman") { theta <- sqrt(allocationRatioPlanned) * (designPlan$hazardRatio - 1) / (allocationRatioPlanned * designPlan$hazardRatio + 1) } else if (designPlan$typeOfComputation == "HsiehFreedman") { theta <- sqrt(4 * allocationRatioPlanned) / (1 + allocationRatioPlanned) * (designPlan$hazardRatio - 1) / (designPlan$hazardRatio + 1) } if (!is.na(designPlan$directionUpper) && !designPlan$directionUpper) { theta <- -theta } powerAndAverageSampleNumber <- getPowerAndAverageSampleNumber( design = design, theta = theta, nMax = maxNumberOfEvents ) kMax <- design$kMax sided <- design$sided if (designPlan$.piecewiseSurvivalTime$.isLambdaBased()) { numberOfResults <- length(designPlan$hazardRatio) } else { numberOfResults <- length(designPlan$pi1) } stoppingProbs <- matrix(NA_real_, kMax, numberOfResults) designPlan$analysisTime <- matrix(NA_real_, kMax, numberOfResults) designPlan$numberOfSubjects <- matrix(NA_real_, kMax, numberOfResults) designPlan$studyDuration <- rep(NA_real_, numberOfResults) designPlan$expectedNumberOfSubjects <- rep(NA_real_, numberOfResults) eventsPerStage <- maxNumberOfEvents * design$informationRates parameterNames <- c( "analysisTime", "numberOfSubjects", "studyDuration", "expectedNumberOfSubjects", "eventsPerStage" ) phi <- -c(log(1 - dropoutRate1), log(1 - dropoutRate2)) / dropoutTime lambda1 <- designPlan$lambda1 if (designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { lambda1 <- rep(NA_real_, numberOfResults) } for (i in 1:numberOfResults) { # Analysis times up <- 2 iterate <- 1 while (eventsPerStage[kMax] / designPlan$maxNumberOfSubjects > .getEventProbabilities( time = up, accrualTimeVector = designPlan$accrualTime, accrualIntensity = designPlan$accrualIntensity, lambda2 = designPlan$lambda2, lambda1 = lambda1[i], phi = phi, piecewiseSurvivalTime = designPlan$piecewiseSurvivalTime, kappa = kappa, allocationRatioPlanned = allocationRatioPlanned, hazardRatio = designPlan$hazardRatio[i] )) { up <- 2 * up iterate <- iterate + 1 if (iterate > 50) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjects' (", designPlan$maxNumberOfSubjects, ") ", "is too small to reach maximum number of events ", "(presumably due to drop-out rates)" ) } } for (j in 1:kMax) { designPlan$analysisTime[j, i] <- .getOneDimensionalRoot( function(x) { eventsPerStage[j] / designPlan$maxNumberOfSubjects - .getEventProbabilities( time = x, accrualTimeVector = designPlan$accrualTime, accrualIntensity = designPlan$accrualIntensity, lambda2 = designPlan$lambda2, lambda1 = lambda1[i], phi = phi, piecewiseSurvivalTime = designPlan$piecewiseSurvivalTime, kappa = kappa, allocationRatioPlanned = allocationRatioPlanned, hazardRatio = designPlan$hazardRatio[i] ) }, lower = 0, upper = up, tolerance = 1e-06, callingFunctionInformation = "getPowerSurvival" ) if (is.na(designPlan$analysisTime[j, i])) { warning("Cannot calculate analysis time at stage ", j, ": ", "'maxNumberOfSubjects' (", designPlan$maxNumberOfSubjects, ") is too ", "small to reach maximum number of events", call. = FALSE ) } } if (kMax > 1) { designPlan$numberOfSubjects[, i] <- .getNumberOfSubjects( time = designPlan$analysisTime[, i], accrualTime = designPlan$accrualTime, accrualIntensity = designPlan$accrualIntensity, maxNumberOfSubjects = designPlan$maxNumberOfSubjects ) powerAndAverageSampleNumber$futilityPerStage[is.na( powerAndAverageSampleNumber$futilityPerStage[, i] ), i] <- 0 stoppingProbs[, i] <- powerAndAverageSampleNumber$rejectPerStage[, i] + c(powerAndAverageSampleNumber$futilityPerStage[, i], 0) stoppingProbs[kMax, i] <- 1 - sum(stoppingProbs[1:(kMax - 1), i]) designPlan$studyDuration[i] <- designPlan$analysisTime[, i] %*% stoppingProbs[, i] designPlan$.setParameterType("studyDuration", C_PARAM_GENERATED) designPlan$expectedNumberOfSubjects[i] <- designPlan$numberOfSubjects[, i] %*% stoppingProbs[, i] } } if (kMax == 1) { designPlan$expectedNumberOfSubjects <- .getNumberOfSubjects( time = designPlan$analysisTime[1, ], accrualTime = designPlan$accrualTime, accrualIntensity = designPlan$accrualIntensity, maxNumberOfSubjects = designPlan$maxNumberOfSubjects ) designPlan$numberOfSubjects <- matrix(designPlan$expectedNumberOfSubjects, nrow = 1) } designPlan$eventsPerStage <- matrix(eventsPerStage, ncol = 1) designPlan$.setParameterType("eventsPerStage", C_PARAM_GENERATED) designPlan$expectedNumberOfEvents <- powerAndAverageSampleNumber$averageSampleNumber designPlan$overallReject <- powerAndAverageSampleNumber$overallReject designPlan$rejectPerStage <- powerAndAverageSampleNumber$rejectPerStage designPlan$futilityStop <- powerAndAverageSampleNumber$overallFutility designPlan$futilityPerStage <- powerAndAverageSampleNumber$futilityPerStage designPlan$earlyStop <- powerAndAverageSampleNumber$overallEarlyStop parameterNames <- c( parameterNames, "expectedNumberOfEvents", "overallReject", "rejectPerStage", "futilityStop", "futilityPerStage", "earlyStop" ) for (parameterName in parameterNames) { designPlan$.setParameterType(parameterName, C_PARAM_GENERATED) } if (kMax == 1L) { designPlan$.setParameterType("numberOfSubjects", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("eventsPerStage", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("futilityStop", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("earlyStop", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("rejectPerStage", C_PARAM_NOT_APPLICABLE) } if (!any(is.na(designPlan$analysisTime)) && !any(is.na(designPlan$accrualTime))) { designPlan$followUpTime <- designPlan$analysisTime[kMax, ] - designPlan$accrualTime[length(designPlan$accrualTime)] designPlan$.setParameterType("followUpTime", C_PARAM_GENERATED) } .addEffectScaleBoundaryDataToDesignPlan(designPlan) .addStudyDurationToDesignPlan(designPlan) .hideFutilityStopsIfNotApplicable(designPlan) return(designPlan) } .hideFutilityStopsIfNotApplicable <- function(designPlan) { if (all(designPlan$.design$futilityBounds == C_FUTILITY_BOUNDS_DEFAULT)) { designPlan$.setParameterType("futilityStop", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("futilityPerStage", C_PARAM_NOT_APPLICABLE) } } .addStudyDurationToDesignPlan <- function(designPlan) { if (!designPlan$accountForObservationTimes) { return(invisible()) } kMax <- designPlan$.design$kMax if (kMax == 1) { designPlan$studyDuration <- designPlan$analysisTime[1, ] designPlan$.setParameterType("studyDuration", C_PARAM_GENERATED) designPlan$maxStudyDuration <- designPlan$studyDuration } else { designPlan$maxStudyDuration <- designPlan$analysisTime[kMax, ] designPlan$.setParameterType("maxStudyDuration", C_PARAM_GENERATED) } } .addNumberOfSubjectsToPowerResult <- function(designPlan) { design <- designPlan$.design designPlan$numberOfSubjects <- matrix(rep(NA_real_, design$kMax), ncol = 1) designPlan$numberOfSubjects[1, 1] <- design$informationRates[1] * designPlan$maxNumberOfSubjects if (design$kMax > 1) { designPlan$numberOfSubjects[2:design$kMax, 1] <- (design$informationRates[2:design$kMax] - design$informationRates[1:(design$kMax - 1)]) * designPlan$maxNumberOfSubjects } designPlan$numberOfSubjects <- .getColumnCumSum(designPlan$numberOfSubjects) designPlan$numberOfSubjects1 <- .getNumberOfSubjects1( designPlan$numberOfSubjects, designPlan$allocationRatioPlanned ) designPlan$numberOfSubjects2 <- .getNumberOfSubjects2( designPlan$numberOfSubjects, designPlan$allocationRatioPlanned ) if (designPlan$.design$kMax == 1) { designPlan$nFixed <- as.numeric(designPlan$numberOfSubjects) designPlan$.setParameterType("nFixed", C_PARAM_GENERATED) if (designPlan$groups == 2) { designPlan$nFixed1 <- as.numeric(designPlan$numberOfSubjects1) designPlan$nFixed2 <- as.numeric(designPlan$numberOfSubjects2) designPlan$.setParameterType("nFixed1", C_PARAM_GENERATED) designPlan$.setParameterType("nFixed2", C_PARAM_GENERATED) } } else { designPlan$.setParameterType("numberOfSubjects", C_PARAM_GENERATED) if ((designPlan$groups == 1) || designPlan$allocationRatioPlanned == 1) { designPlan$.setParameterType("numberOfSubjects1", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("numberOfSubjects2", C_PARAM_NOT_APPLICABLE) } else { designPlan$.setParameterType("numberOfSubjects1", C_PARAM_GENERATED) designPlan$.setParameterType("numberOfSubjects2", C_PARAM_GENERATED) } } } rpact/R/f_analysis_enrichment_means.R0000644000175000017500000017563214165522371017614 0ustar nileshnilesh## | ## | *Analysis of means in enrichment designs with adaptive test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5684 $ ## | Last changed: $Date: 2022-01-05 12:27:24 +0100 (Mi, 05 Jan 2022) $ ## | Last changed by: $Author: wassmer $ ## | .calcMeansVariancesTestStatistics <- function(dataInput, subset, stage, thetaH0, stratifiedAnalysis, varianceOption) { .assertIsSingleInteger(stage, "stage") .assertIsSingleNumber(thetaH0, "thetaH0") .assertIsSingleLogical(stratifiedAnalysis, "stratifiedAnalysis") .assertIsSingleCharacter(varianceOption, "varianceOption") n <- rep(NA_real_, 2) on <- rep(NA_real_, 2) m <- rep(NA_real_, 2) om <- rep(NA_real_, 2) v <- rep(NA_real_, 2) ov <- rep(NA_real_, 2) for (i in 1:2) { m[i] <- sum(dataInput$getSampleSizes(stage = stage, subset = subset, group = i) * dataInput$getMeans(stage = stage, subset = subset, group = i), na.rm = TRUE) / sum(dataInput$getSampleSizes(stage = stage, subset = subset, group = i), na.rm = TRUE) # calculate residual variance from full population (only if gMax = 2) if (length(subset) == 1 && subset == "S1" && varianceOption == "pooledFromFull") { if (dataInput$isStratified()) { v[i] <- sum((dataInput$getSampleSizes(stage = stage, subset = c("S1", "R"), group = i) - 1) * dataInput$getStDev(stage = stage, subset = c("S1", "R"), group = i)^2, na.rm = TRUE) / (sum(dataInput$getSampleSizes(stage = stage, subset = c("S1", "R"), group = i) - 1, na.rm = TRUE)) n[i] <- sum(dataInput$getSampleSizes(stage = stage, subset = c("S1", "R"), group = i), na.rm = TRUE) } else { if (is.na(dataInput$getSampleSizes(stage = stage, subset = c("F"), group = i))) { v[i] <- dataInput$getStDev(stage = stage, subset = c("S1"), group = i)^2 n[i] <- dataInput$getSampleSizes(stage = stage, subset = c("S1"), group = i) } else { v[i] <- dataInput$getStDev(stage = stage, subset = c("F"), group = i)^2 n[i] <- dataInput$getSampleSizes(stage = stage, subset = c("F"), group = i) } } } else if (varianceOption == "pooledFromFull") { v[i] <- sum((dataInput$getSampleSizes(stage = stage, subset = subset, group = i) - 1) * dataInput$getStDev(stage = stage, subset = subset, group = i)^2 / sum(dataInput$getSampleSizes(stage = stage, subset = subset, group = i) - 1, na.rm = TRUE)) n[i] <- sum(dataInput$getSampleSizes(stage = stage, subset = subset, group = i), na.rm = TRUE) } else { v[i] <- sum((dataInput$getSampleSizes(stage = stage, subset = subset, group = i) - 1) * dataInput$getStDev(stage = stage, subset = subset, group = i)^2 + dataInput$getSampleSizes(stage = stage, subset = subset, group = i) * (dataInput$getMeans(stage = stage, subset = subset, group = i) - m[i])^2, na.rm = TRUE) / (sum(dataInput$getSampleSizes(stage = stage, subset = subset, group = i), na.rm = TRUE) - 1) n[i] <- sum(dataInput$getSampleSizes(stage = stage, subset = subset, group = i), na.rm = TRUE) } # calculation for overall data on[i] <- sum(dataInput$getOverallSampleSizes(stage = stage, subset = subset, group = i), na.rm = TRUE) om[i] <- sum(dataInput$getOverallSampleSizes(stage = stage, subset = subset, group = i) * dataInput$getOverallMeans(stage = stage, subset = subset, group = i), na.rm = TRUE) / on[i] ov[i] <- sum((dataInput$getOverallSampleSizes(stage = stage, subset = subset, group = i) - 1) * dataInput$getOverallStDev(stage = stage, subset = subset, group = i)^2 + dataInput$getOverallSampleSizes(stage = stage, subset = subset, group = i) * (dataInput$getOverallMeans(stage = stage, subset = subset, group = i) - om[i])^2, na.rm = TRUE) / (sum(dataInput$getOverallSampleSizes(stage = stage, subset = subset, group = i), na.rm = TRUE) - 1) } df <- NA_real_ if (stratifiedAnalysis) { weights <- dataInput$getSampleSizes(stage = stage, subset = subset, group = 1) * dataInput$getSampleSizes(stage = stage, subset = subset, group = 2) / (dataInput$getSampleSizes(stage = stage, subset = subset, group = 1) + dataInput$getSampleSizes(stage = stage, subset = subset, group = 2)) if (varianceOption == "pooledFromFull") { pv <- ((n[1] - 1) * v[1] + (n[2] - 1) * v[2]) / (n[1] + n[2] - 2) testStatistics <- sum((dataInput$getMeans(stage = stage, subset = subset, group = 1) - dataInput$getMeans(stage = stage, subset = subset, group = 2) - thetaH0) * weights, na.rm = TRUE ) / sqrt(sum(pv * weights, na.rm = TRUE)) } else if (varianceOption == "pooled") { pv <- ((dataInput$getSampleSizes(stage = stage, subset = subset, group = 1) - 1) * dataInput$getStDevs(stage = stage, subset = subset, group = 1)^2 + (dataInput$getSampleSizes(stage = stage, subset = subset, group = 2) - 1) * dataInput$getStDevs(stage = stage, subset = subset, group = 2)^2) / (dataInput$getSampleSizes(stage = stage, subset = subset, group = 1) + dataInput$getSampleSizes(stage = stage, subset = subset, group = 2) - 2) testStatistics <- sum((dataInput$getMeans(stage = stage, subset = subset, group = 1) - dataInput$getMeans(stage = stage, subset = subset, group = 2) - thetaH0) * weights, na.rm = TRUE ) / sqrt(sum(pv * weights, na.rm = TRUE)) } else { pv <- dataInput$getStDevs(stage = stage, subset = subset, group = 1)^2 / dataInput$getSampleSizes(stage = stage, subset = subset, group = 1) + dataInput$getStDevs(stage = stage, subset = subset, group = 2)^2 / dataInput$getSampleSizes(stage = stage, subset = subset, group = 2) testStatistics <- sum((dataInput$getMeans(stage = stage, subset = subset, group = 1) - dataInput$getMeans(stage = stage, subset = subset, group = 2) - thetaH0) * weights, na.rm = TRUE ) / sqrt(sum(pv * weights^2, na.rm = TRUE)) } df <- sum(dataInput$getSampleSizes(stage = stage, subset = subset, group = 1), na.rm = TRUE) + sum(dataInput$getSampleSizes(stage = stage, subset = subset, group = 2), na.rm = TRUE) - length(dataInput$getSampleSizes(stage = stage, subset = subset, group = 1)) - length(dataInput$getSampleSizes(stage = stage, subset = subset, group = 2)) } # non-stratified analysis else { if (varianceOption == "pooledFromFull") { pv <- ((n[1] - 1) * v[1] + (n[2] - 1) * v[2]) / (n[1] + n[2] - 2) testStatistics <- (m[1] - m[2] - thetaH0) / sqrt(pv * (1 / sum(dataInput$getSampleSizes(stage = stage, subset = subset, group = 1), na.rm = TRUE) + 1 / sum(dataInput$getSampleSizes(stage = stage, subset = subset, group = 2), na.rm = TRUE))) df <- n[1] + n[2] - length(dataInput$getSampleSizes(stage = stage, subset = subset, group = 1)) - length(dataInput$getSampleSizes(stage = stage, subset = subset, group = 2)) } else if (varianceOption == "pooled") { pv <- ((n[1] - 1) * v[1] + (n[2] - 1) * v[2]) / (n[1] + n[2] - 2) testStatistics <- (m[1] - m[2] - thetaH0) / sqrt(pv * (1 / n[1] + 1 / n[2])) df <- n[1] + n[2] - 2 } else { testStatistics <- (m[1] - m[2] - thetaH0) / sqrt(v[1] / n[1] + v[2] / n[2]) u <- v[1] / n[1] / (v[1] / n[1] + v[2] / n[2]) df <- 1 / (u^2 / (n[1] - 1) + (1 - u)^2 / (n[2] - 1)) } } testStatistics[is.nan(testStatistics)] <- NA_real_ if (any(is.nan(om))) { om <- rep(NA_real_, 2) ov <- rep(NA_real_, 2) } # consider the case n[1] = n[2] = 0 df[!is.na(df) & df <= 0] <- NA_real_ ov[!is.na(ov) & ov <= 0] <- NA_real_ if ("R" %in% subset && is.na(dataInput$getSampleSizes(stage = stage, subset = "R", group = 1)) || ("S1" %in% subset) && is.na(dataInput$getSampleSizes(stage = stage, subset = "S1", group = 1)) || ("S2" %in% subset) && is.na(dataInput$getSampleSizes(stage = stage, subset = "S2", group = 1)) || ("S3" %in% subset) && is.na(dataInput$getSampleSizes(stage = stage, subset = "S3", group = 1)) || ("S4" %in% subset) && is.na(dataInput$getSampleSizes(stage = stage, subset = "S4", group = 1)) ) { n <- rep(NA_real_, 2) m <- rep(NA_real_, 2) v <- rep(NA_real_, 2) on <- rep(NA_real_, 2) om <- rep(NA_real_, 2) ov <- rep(NA_real_, 2) df <- NA_real_ testStatistics <- NA_real_ } return(list( populationNs = n, populationMeans = m, overallMeans = om, overallStDevs = sqrt(((on[1] - 1) * ov[1] + (on[2] - 1) * ov[2]) / (on[1] + on[2] - 2)), overallSampleSizes1 = on[1], overallSampleSizes2 = on[2], df = df, testStatistics = testStatistics )) } .getStageResultsMeansEnrichment <- function(..., design, dataInput, thetaH0 = C_THETA_H0_MEANS_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, varianceOption = C_VARIANCE_OPTION_ENRICHMENT_DEFAULT, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, calculateSingleStepAdjusted = FALSE, userFunctionCallEnabled = FALSE) { .assertIsTrialDesign(design) .assertIsDatasetMeans(dataInput) .assertIsValidThetaH0DataInput(thetaH0, dataInput) .assertIsValidDirectionUpper(directionUpper, design$sided) .assertIsSingleLogical(normalApproximation, "normalApproximation") .assertIsValidVarianceOptionEnrichment(design, varianceOption) .assertIsValidIntersectionTestEnrichment(design, intersectionTest) .warnInCaseOfUnknownArguments( functionName = ".getStageResultsMeansEnrichment", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) kMax <- design$kMax if (dataInput$isStratified()) { gMax <- log(length(levels(factor(dataInput$subsets))), 2) + 1 } else { gMax <- length(levels(factor(dataInput$subsets))) } .assertIsValidIntersectionTestEnrichment(design, intersectionTest) if ((gMax > 2) && intersectionTest == "SpiessensDebois") { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "gMax (", gMax, ") > 2: Spiessens & Debois intersection test test can only be used for one subset" ) } if (varianceOption == "pooledFromFull") { if (gMax > 2) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "gMax (", gMax, ") > 2: varianceOption 'pooledFromFull' can only be used for one subset" ) } } if (intersectionTest == "SpiessensDebois" && varianceOption != "pooledFromFull" && !normalApproximation) { stop("Spiessens & Depois t test can only be performed with pooled ", "residual (stratified) variance from full population, select 'varianceOption' = \"pooledFromFull\"", call. = FALSE ) } if (intersectionTest == "SpiessensDebois" && !stratifiedAnalysis && !normalApproximation) { stop("Spiessens & Depois t test can only be performed with pooled ", "residual (stratified) variance from full population, select 'stratifiedAnalysis' = TRUE", call. = FALSE ) } if (dataInput$isStratified() && (gMax > 4)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "gMax (", gMax, ") > 4: Stratified analysis not implemented" ) } stageResults <- StageResultsEnrichmentMeans( design = design, dataInput = dataInput, thetaH0 = thetaH0, direction = ifelse(directionUpper, C_DIRECTION_UPPER, C_DIRECTION_LOWER), normalApproximation = normalApproximation, directionUpper = directionUpper, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, stage = stage ) .setValueAndParameterType( stageResults, "intersectionTest", intersectionTest, C_INTERSECTION_TEST_ENRICHMENT_DEFAULT ) .setValueAndParameterType( stageResults, "stratifiedAnalysis", stratifiedAnalysis, C_STRATIFIED_ANALYSIS_DEFAULT ) effectSizes <- matrix(NA_real_, nrow = gMax, ncol = kMax) means1 <- matrix(NA_real_, nrow = gMax, ncol = kMax) means2 <- matrix(NA_real_, nrow = gMax, ncol = kMax) stDevs1 <- matrix(NA_real_, nrow = gMax, ncol = kMax) stDevs2 <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallSampleSizes1 <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallSampleSizes2 <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallStDevs <- matrix(NA_real_, nrow = gMax, ncol = kMax) testStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallTestStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) separatePValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) dimnames(testStatistics) <- list( paste("population ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "") ) dimnames(separatePValues) <- list( paste("population ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "") ) subsets <- .createSubsetsByGMax(gMax = gMax, stratifiedInput = dataInput$isStratified(), subsetIdPrefix = "S") for (k in 1:stage) { for (population in 1:gMax) { subset <- subsets[[population]] results <- .calcMeansVariancesTestStatistics(dataInput, subset, k, thetaH0, stratifiedAnalysis, varianceOption) effectSizes[population, k] <- results$overallMeans[1] - results$overallMeans[2] testStatistics[population, k] <- results$testStatistics if (normalApproximation) { separatePValues[population, k] <- 1 - stats::pnorm(testStatistics[population, k]) } else { separatePValues[population, k] <- 1 - stats::pt(testStatistics[population, k], results$df) } overallSampleSizes1[population, k] <- results$overallSampleSizes1 overallSampleSizes2[population, k] <- results$overallSampleSizes2 overallStDevs[population, k] <- results$overallStDevs if (!directionUpper) { separatePValues[population, k] <- 1 - separatePValues[population, k] } } } .setWeightsToStageResults(design, stageResults) # Calculation of single stage adjusted p-Values and overall test statistics # for determination of RCIs if (calculateSingleStepAdjusted) { singleStepAdjustedPValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) combInverseNormal <- matrix(NA_real_, nrow = gMax, ncol = kMax) combFisher <- matrix(NA_real_, nrow = gMax, ncol = kMax) if (.isTrialDesignInverseNormal(design)) { weightsInverseNormal <- stageResults$weightsInverseNormal } else if (.isTrialDesignFisher(design)) { weightsFisher <- stageResults$weightsFisher } for (k in 1:stage) { selected <- sum(!is.na(separatePValues[, k])) for (population in 1:gMax) { if ((intersectionTest == "Bonferroni") || (intersectionTest == "Simes")) { singleStepAdjustedPValues[population, k] <- min(1, separatePValues[population, k] * selected) } else if (intersectionTest == "Sidak") { singleStepAdjustedPValues[population, k] <- 1 - (1 - separatePValues[population, k])^selected } else if (intersectionTest == "SpiessensDebois") { if (!is.na(testStatistics[population, k])) { df <- NA_real_ if (!normalApproximation) { if (dataInput$isStratified()) { df <- sum(dataInput$getSampleSizes(stage = k) - 1, na.rm = TRUE) } else { if (selected == 2) { df <- sum(dataInput$getSampleSizes(stage = k, subset = "F") - 2, na.rm = TRUE) } else { df <- sum(dataInput$getSampleSizes(stage = k, subset = "S1") - 2, na.rm = TRUE) } } } sigma <- 1 if (selected == 2) { if (dataInput$isStratified()) { sigma <- matrix(rep(sqrt(sum(dataInput$getSampleSizes(stage = k, subset = "S1")) / sum(dataInput$getSampleSizes(stage = k))), 4), nrow = 2) } else { sigma <- matrix(rep(sqrt(sum(dataInput$getSampleSizes(stage = k, subset = "S1")) / sum(dataInput$getSampleSizes(stage = k, subset = "F"))), 4), nrow = 2) } diag(sigma) <- 1 } singleStepAdjustedPValues[population, k] <- 1 - .getMultivariateDistribution( type = ifelse(normalApproximation, "normal", "t"), upper = ifelse(directionUpper, testStatistics[population, k], -testStatistics[population, k] ), sigma = sigma, df = df ) } } if (.isTrialDesignInverseNormal(design)) { combInverseNormal[population, k] <- (weightsInverseNormal[1:k] %*% .getOneMinusQNorm(singleStepAdjustedPValues[population, 1:k])) / sqrt(sum(weightsInverseNormal[1:k]^2)) } else if (.isTrialDesignFisher(design)) { combFisher[population, k] <- prod(singleStepAdjustedPValues[ population, 1:k ]^weightsFisher[1:k]) } } } stageResults$overallTestStatistics <- overallTestStatistics stageResults$effectSizes <- effectSizes stageResults$overallStDevs <- overallStDevs stageResults$testStatistics <- testStatistics stageResults$separatePValues <- separatePValues stageResults$singleStepAdjustedPValues <- singleStepAdjustedPValues stageResults$.setParameterType("singleStepAdjustedPValues", C_PARAM_GENERATED) if (.isTrialDesignFisher(design)) { stageResults$combFisher <- combFisher stageResults$.setParameterType("combFisher", C_PARAM_GENERATED) } else if (.isTrialDesignInverseNormal(design)) { stageResults$combInverseNormal <- combInverseNormal stageResults$.setParameterType("combInverseNormal", C_PARAM_GENERATED) } } else { stageResults$overallTestStatistics <- overallTestStatistics stageResults$effectSizes <- effectSizes stageResults$overallStDevs <- overallStDevs stageResults$.overallSampleSizes1 <- overallSampleSizes1 stageResults$.overallSampleSizes2 <- overallSampleSizes2 stageResults$testStatistics <- testStatistics stageResults$separatePValues <- separatePValues } return(stageResults) } .getAnalysisResultsMeansEnrichment <- function(..., design, dataInput) { if (.isTrialDesignInverseNormal(design)) { return(.getAnalysisResultsMeansInverseNormalEnrichment(design = design, dataInput = dataInput, ...)) } if (.isTrialDesignFisher(design)) { return(.getAnalysisResultsMeansFisherEnrichment(design = design, dataInput = dataInput, ...)) } .stopWithWrongDesignMessage(design) } .getAnalysisResultsMeansInverseNormalEnrichment <- function(..., design, dataInput, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, varianceOption = C_VARIANCE_OPTION_ENRICHMENT_DEFAULT, thetaH0 = C_THETA_H0_MEANS_DEFAULT, thetaH1 = NA_real_, assumedStDevs = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .assertIsTrialDesignInverseNormal(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsMeansInverseNormalEnrichment", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) results <- AnalysisResultsEnrichmentInverseNormal(design = design, dataInput = dataInput) results <- .getAnalysisResultsMeansEnrichmentAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, thetaH0 = thetaH0, thetaH1 = thetaH1, assumedStDevs = assumedStDevs, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance ) return(results) } .getAnalysisResultsMeansFisherEnrichment <- function(..., design, dataInput, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, varianceOption = C_VARIANCE_OPTION_ENRICHMENT_DEFAULT, thetaH0 = C_THETA_H0_MEANS_DEFAULT, thetaH1 = NA_real_, assumedStDevs = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsMeansFisherEnrichment", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsEnrichmentFisher(design = design, dataInput = dataInput) results <- .getAnalysisResultsMeansEnrichmentAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, thetaH0 = thetaH0, thetaH1 = thetaH1, assumedStDevs = assumedStDevs, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance, iterations = iterations, seed = seed ) return(results) } .getAnalysisResultsMeansEnrichmentAll <- function(..., results, design, dataInput, intersectionTest, stage, directionUpper, normalApproximation, stratifiedAnalysis, varianceOption, thetaH0, thetaH1, assumedStDevs, nPlanned, allocationRatioPlanned, tolerance, iterations, seed) { startTime <- Sys.time() stageResults <- .getStageResultsMeansEnrichment( design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, userFunctionCallEnabled = TRUE ) .logProgress("Stage results calculated", startTime = startTime) normalApproximation <- stageResults$normalApproximation intersectionTest <- stageResults$intersectionTest results$.setStageResults(stageResults) thetaH1 <- .assertIsValidThetaH1ForEnrichment(thetaH1, stageResults, stage, results = results) assumedStDevs <- .assertIsValidAssumedStDevForMultiHypotheses( assumedStDevs, stageResults, stage, results = results ) .setValueAndParameterType( results, "intersectionTest", intersectionTest, C_INTERSECTION_TEST_ENRICHMENT_DEFAULT ) .setValueAndParameterType(results, "directionUpper", directionUpper, C_DIRECTION_UPPER_DEFAULT) .setValueAndParameterType( results, "normalApproximation", normalApproximation, C_NORMAL_APPROXIMATION_MEANS_DEFAULT ) .setValueAndParameterType(results, "stratifiedAnalysis", stratifiedAnalysis, C_STRATIFIED_ANALYSIS_DEFAULT) .setValueAndParameterType(results, "varianceOption", varianceOption, C_VARIANCE_OPTION_ENRICHMENT_DEFAULT) .setValueAndParameterType(results, "thetaH0", thetaH0, C_THETA_H0_MEANS_DEFAULT) .setConditionalPowerArguments(results, dataInput, nPlanned, allocationRatioPlanned) .setNPlannedAndThetaH1AndAssumedStDevs(results, nPlanned, thetaH1, assumedStDevs) startTime <- Sys.time() results$.closedTestResults <- getClosedCombinationTestResults(stageResults = stageResults) .logProgress("Closed test calculated", startTime = startTime) if (design$kMax > 1) { # conditional power startTime <- Sys.time() if (.isTrialDesignFisher(design)) { conditionalPowerResults <- .getConditionalPowerMeansEnrichment( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, assumedStDevs = assumedStDevs, iterations = iterations, seed = seed ) if (conditionalPowerResults$simulated) { results$conditionalPowerSimulated <- conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalPowerSimulated", C_PARAM_GENERATED) } else { results$conditionalPower <- conditionalPowerResults$conditionalPower results$conditionalPowerSimulated <- matrix(numeric(0)) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$.setParameterType("conditionalPowerSimulated", C_PARAM_NOT_APPLICABLE) } } else { conditionalPowerResults <- .getConditionalPowerMeansEnrichment( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, assumedStDevs = assumedStDevs ) results$conditionalPower <- conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_GENERATED) } results$thetaH1 <- matrix(conditionalPowerResults$thetaH1, ncol = 1) results$assumedStDevs <- matrix(conditionalPowerResults$assumedStDevs, ncol = 1) results$.conditionalPowerResults <- conditionalPowerResults .logProgress("Conditional power calculated", startTime = startTime) # CRP - conditional rejection probabilities startTime <- Sys.time() results$conditionalRejectionProbabilities <- .getConditionalRejectionProbabilitiesEnrichment( stageResults = stageResults, stage = stage ) results$.setParameterType("conditionalRejectionProbabilities", C_PARAM_GENERATED) .logProgress("Conditional rejection probabilities (CRP) calculated", startTime = startTime) } else { results$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalPowerSimulated", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalRejectionProbabilities", C_PARAM_NOT_APPLICABLE) } # RCI - repeated confidence interval repeatedConfidenceIntervals <- .getRepeatedConfidenceIntervalsMeansEnrichment( design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, tolerance = tolerance ) gMax <- stageResults$getGMax() results$repeatedConfidenceIntervalLowerBounds <- matrix(rep(NA_real_, gMax * design$kMax), nrow = gMax, ncol = design$kMax) results$repeatedConfidenceIntervalUpperBounds <- results$repeatedConfidenceIntervalLowerBounds for (k in 1:design$kMax) { for (population in 1:gMax) { results$repeatedConfidenceIntervalLowerBounds[population, k] <- repeatedConfidenceIntervals[population, 1, k] results$repeatedConfidenceIntervalUpperBounds[population, k] <- repeatedConfidenceIntervals[population, 2, k] } } results$.setParameterType("repeatedConfidenceIntervalLowerBounds", C_PARAM_GENERATED) results$.setParameterType("repeatedConfidenceIntervalUpperBounds", C_PARAM_GENERATED) # repeated p-value results$repeatedPValues <- .getRepeatedPValuesEnrichment(stageResults = stageResults, tolerance = tolerance) results$.setParameterType("repeatedPValues", C_PARAM_GENERATED) if (stratifiedAnalysis && !dataInput$isStratified()) { message("Standard deviations from full (and sub-populations) need to be stratified estimates") } return(results) } .getRootThetaMeansEnrichment <- function(..., design, dataInput, population, stage, directionUpper, normalApproximation, stratifiedAnalysis, varianceOption, intersectionTest, thetaLow, thetaUp, firstParameterName, secondValue, tolerance) { result <- .getOneDimensionalRoot( function(theta) { stageResults <- .getStageResultsMeansEnrichment( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, intersectionTest = intersectionTest, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, calculateSingleStepAdjusted = TRUE ) firstValue <- stageResults[[firstParameterName]][population, stage] if (.isTrialDesignGroupSequential(design)) { firstValue <- .getOneMinusQNorm(firstValue) } return(firstValue - secondValue) }, lower = thetaLow, upper = thetaUp, tolerance = tolerance, callingFunctionInformation = ".getRootThetaMeansEnrichment" ) return(result) } .getUpperLowerThetaMeansEnrichment <- function(..., design, dataInput, theta, population, stage, directionUpper, normalApproximation, stratifiedAnalysis, varianceOption, conditionFunction, intersectionTest, firstParameterName, secondValue) { stageResults <- .getStageResultsMeansEnrichment( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, intersectionTest = intersectionTest, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, calculateSingleStepAdjusted = TRUE ) firstValue <- stageResults[[firstParameterName]][population, stage] maxSearchIterations <- 30 while (conditionFunction(secondValue, firstValue)) { theta <- 2 * theta stageResults <- .getStageResultsMeansEnrichment( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, intersectionTest = intersectionTest, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, calculateSingleStepAdjusted = TRUE ) firstValue <- stageResults[[firstParameterName]][population, stage] maxSearchIterations <- maxSearchIterations - 1 if (maxSearchIterations < 0) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, sprintf( paste0( "failed to find theta (k = %s, firstValue = %s, ", "secondValue = %s, levels(firstValue) = %s, theta = %s)" ), stage, stageResults[[firstParameterName]][population, stage], secondValue, firstValue, theta ) ) } } return(theta) } .getRepeatedConfidenceIntervalsMeansEnrichmentAll <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, varianceOption = C_VARIANCE_OPTION_ENRICHMENT_DEFAULT, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, firstParameterName) { .assertIsValidIntersectionTestEnrichment(design, intersectionTest) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) stageResults <- .getStageResultsMeansEnrichment( design = design, dataInput = dataInput, stage = stage, thetaH0 = 0, directionUpper = directionUpper, intersectionTest = intersectionTest, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, calculateSingleStepAdjusted = FALSE ) gMax <- stageResults$getGMax() repeatedConfidenceIntervals <- array(NA_real_, dim = c(gMax, 2, design$kMax)) # Repeated confidence intervals when using combination tests if (.isTrialDesignFisher(design)) { bounds <- design$alpha0Vec border <- C_ALPHA_0_VEC_DEFAULT criticalValues <- design$criticalValues conditionFunction <- .isFirstValueSmallerThanSecondValue } else if (.isTrialDesignInverseNormal(design)) { bounds <- design$futilityBounds border <- C_FUTILITY_BOUNDS_DEFAULT criticalValues <- design$criticalValues criticalValues[is.infinite(criticalValues) & criticalValues > 0] <- C_QNORM_MAXIMUM criticalValues[is.infinite(criticalValues) & criticalValues < 0] <- C_QNORM_MINIMUM conditionFunction <- .isFirstValueGreaterThanSecondValue } # Necessary for adjustment for binding futility boundaries futilityCorr <- rep(NA_real_, design$kMax) stages <- (1:stage) for (k in stages) { startTime <- Sys.time() for (population in 1:gMax) { if (!is.na(stageResults$testStatistics[population, k])) { # finding maximum upper and minimum lower bounds for RCIs thetaLow <- .getUpperLowerThetaMeansEnrichment( design = design, dataInput = dataInput, theta = -1, population = population, stage = k, directionUpper = TRUE, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, conditionFunction = conditionFunction, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k] ) thetaUp <- .getUpperLowerThetaMeansEnrichment( design = design, dataInput = dataInput, theta = 1, population = population, stage = k, directionUpper = FALSE, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, conditionFunction = conditionFunction, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k] ) # finding upper and lower RCI limits through root function repeatedConfidenceIntervals[population, 1, k] <- .getRootThetaMeansEnrichment( design = design, dataInput = dataInput, population = population, stage = k, directionUpper = TRUE, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, thetaLow = thetaLow, thetaUp = thetaUp, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance ) repeatedConfidenceIntervals[population, 2, k] <- .getRootThetaMeansEnrichment( design = design, dataInput = dataInput, population = population, stage = k, directionUpper = FALSE, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, thetaLow = thetaLow, thetaUp = thetaUp, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance ) # adjustment for binding futility bounds if (k > 1 && conditionFunction(bounds[k - 1], border) & design$bindingFutility) { parameterName <- ifelse(.isTrialDesignFisher(design), "singleStepAdjustedPValues", firstParameterName ) # Calculate new lower and upper bounds if (directionUpper) { thetaLow <- .getUpperLowerThetaMeansEnrichment( design = design, dataInput = dataInput, theta = -1, population = population, stage = k - 1, directionUpper = TRUE, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, conditionFunction = conditionFunction, intersectionTest = intersectionTest, firstParameterName = parameterName, secondValue = bounds[k - 1] ) } else { thetaUp <- .getUpperLowerThetaMeansEnrichment( design = design, dataInput = dataInput, theta = 1, population = population, stage = k - 1, directionUpper = FALSE, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, conditionFunction = conditionFunction, intersectionTest = intersectionTest, firstParameterName = parameterName, secondValue = bounds[k - 1] ) } futilityCorr[k] <- .getRootThetaMeansEnrichment( design = design, dataInput = dataInput, population = population, stage = k - 1, directionUpper = directionUpper, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, thetaLow = thetaLow, thetaUp = thetaUp, intersectionTest = intersectionTest, firstParameterName = parameterName, secondValue = bounds[k - 1], tolerance = tolerance ) if (directionUpper) { repeatedConfidenceIntervals[population, 1, k] <- min( min(futilityCorr[2:k]), repeatedConfidenceIntervals[population, 1, k] ) } else { repeatedConfidenceIntervals[population, 2, k] <- max( max(futilityCorr[2:k]), repeatedConfidenceIntervals[population, 2, k] ) } } if (!is.na(repeatedConfidenceIntervals[population, 1, k]) && !is.na(repeatedConfidenceIntervals[population, 2, k]) && repeatedConfidenceIntervals[population, 1, k] > repeatedConfidenceIntervals[population, 2, k]) { repeatedConfidenceIntervals[population, , k] <- rep(NA_real_, 2) } } } .logProgress("Repeated confidence intervals for stage %s calculated", startTime = startTime, k) } return(repeatedConfidenceIntervals) } # # RCIs based on inverse normal combination test # .getRepeatedConfidenceIntervalsMeansEnrichmentInverseNormal <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, varianceOption = C_VARIANCE_OPTION_ENRICHMENT_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsMeansEnrichmentInverseNormal", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) return(.getRepeatedConfidenceIntervalsMeansEnrichmentAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, directionUpper = directionUpper, intersectionTest = intersectionTest, tolerance = tolerance, firstParameterName = "combInverseNormal", ... )) } # # RCIs based on Fisher's combination test # .getRepeatedConfidenceIntervalsMeansEnrichmentFisher <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, varianceOption = C_VARIANCE_OPTION_ENRICHMENT_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsMeansEnrichmentFisher", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) return(.getRepeatedConfidenceIntervalsMeansEnrichmentAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, varianceOption = varianceOption, directionUpper = directionUpper, intersectionTest = intersectionTest, tolerance = tolerance, firstParameterName = "combFisher", ... )) } # # Calculation of lower and upper limits of repeated confidence intervals (RCIs) for Means # .getRepeatedConfidenceIntervalsMeansEnrichment <- function(..., design) { if (.isTrialDesignInverseNormal(design)) { return(.getRepeatedConfidenceIntervalsMeansEnrichmentInverseNormal(design = design, ...)) } if (.isTrialDesignFisher(design)) { return(.getRepeatedConfidenceIntervalsMeansEnrichmentFisher(design = design, ...)) } .stopWithWrongDesignMessage(design) } # # Calculation of conditional power for Means # .getConditionalPowerMeansEnrichment <- function(..., stageResults, stage = stageResults$stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaH1 = NA_real_, assumedStDevs = NA_real_, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { design <- stageResults$.design gMax <- stageResults$getGMax() kMax <- design$kMax stDevsH1 <- .getOptionalArgument("stDevsH1", ...) if (!is.null(stDevsH1) && !is.na(stDevsH1)) { if (!is.na(assumedStDevs)) { warning(sQuote("assumedStDevs"), " will be ignored because ", sQuote("stDevsH1"), " is defined", call. = FALSE) } assumedStDevs <- stDevsH1 } results <- ConditionalPowerResultsEnrichmentMeans( .design = design, .stageResults = stageResults, thetaH1 = thetaH1, assumedStDevs = assumedStDevs, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned ) if (any(is.na(nPlanned))) { return(results) } .assertIsValidStage(stage, kMax) if (stage == kMax) { .logDebug( "Conditional power will be calculated only for subsequent stages ", "(stage = ", stage, ", kMax = ", kMax, ")" ) return(results) } if (!.isValidNPlanned(nPlanned = nPlanned, kMax = kMax, stage = stage)) { return(results) } .assertIsValidNPlanned(nPlanned, kMax, stage) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) .setValueAndParameterType(results, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT) assumedStDevs <- .assertIsValidAssumedStDevForMultiHypotheses( assumedStDevs, stageResults, stage, results = results ) thetaH1 <- .assertIsValidThetaH1ForEnrichment(thetaH1, stageResults, stage, results = results) if (length(thetaH1) != 1 && length(thetaH1) != gMax) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sprintf(paste0( "length of 'thetaH1' (%s) ", "must be equal to 'gMax' (%s) or 1" ), .arrayToString(thetaH1), gMax) ) } if (length(assumedStDevs) != 1 && length(assumedStDevs) != gMax) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sprintf(paste0( "length of 'assumedStDevs' (%s) ", "must be equal to 'gMax' (%s) or 1" ), .arrayToString(assumedStDevs), gMax) ) } if (length(assumedStDevs) == 1) { results$assumedStDevs <- rep(assumedStDevs, gMax) results$.setParameterType("assumedStDevs", C_PARAM_GENERATED) } else { if (any(is.na(assumedStDevs[!is.na(stageResults$testStatistics[, stage])]))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "any of 'assumedStDevs' not correctly specified" ) } } if (length(thetaH1) > 1) { if (any(is.na(thetaH1[!is.na(stageResults$testStatistics[, stage])]))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "any of 'thetaH1' not correctly specified" ) } } if (.isTrialDesignInverseNormal(design)) { return(.getConditionalPowerMeansEnrichmentInverseNormal( results = results, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, assumedStDevs = assumedStDevs, ... )) } else if (.isTrialDesignFisher(design)) { return(.getConditionalPowerMeansEnrichmentFisher( results = results, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, assumedStDevs = assumedStDevs, iterations = iterations, seed = seed, ... )) } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of TrialDesignInverseNormal or TrialDesignFisher" ) } # # Calculation of conditional power based on inverse normal method # .getConditionalPowerMeansEnrichmentInverseNormal <- function(..., results, stageResults, stage, allocationRatioPlanned, nPlanned, thetaH1, assumedStDevs) { design <- stageResults$.design .assertIsTrialDesignInverseNormal(design) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerMeansEnrichmentInverseNormal", ignore = c("stage", "design", "stDevsH1"), ... ) kMax <- design$kMax gMax <- stageResults$getGMax() weights <- .getWeightsInverseNormal(design) informationRates <- design$informationRates nPlanned <- c(rep(NA_real_, stage), nPlanned) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned .setValueAndParameterType( results, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT ) if (length(thetaH1) == 1) { thetaH1 <- rep(thetaH1, gMax) results$.setParameterType("thetaH1", C_PARAM_GENERATED) } else { results$.setParameterType("thetaH1", C_PARAM_DEFAULT_VALUE) } results$.setParameterType("assumedStDevs", C_PARAM_DEFAULT_VALUE) if (stageResults$directionUpper) { standardizedEffect <- (thetaH1 - stageResults$thetaH0) / assumedStDevs } else { standardizedEffect <- -(thetaH1 - stageResults$thetaH0) / assumedStDevs } ctr <- .performClosedCombinationTest(stageResults = stageResults) criticalValues <- design$criticalValues for (population in 1:gMax) { if (!is.na(ctr$separatePValues[population, stage])) { # shifted decision region for use in getGroupSeqProbs # Inverse Normal Method shiftedDecisionRegionUpper <- criticalValues[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, population] == 1, stage], na.rm = TRUE) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - standardizedEffect[population] * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) if (stage == kMax - 1) { shiftedFutilityBounds <- c() } else { shiftedFutilityBounds <- design$futilityBounds[(stage + 1):(kMax - 1)] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):(kMax - 1)]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, population] == 1, stage], na.rm = TRUE) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - standardizedEffect[population] * cumsum(sqrt(nPlanned[(stage + 1):(kMax - 1)]) * weights[(stage + 1):(kMax - 1)]) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) } # scaled information for use in getGroupSeqProbs scaledInformation <- (informationRates[(stage + 1):kMax] - informationRates[stage]) / (1 - informationRates[stage]) decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, shiftedDecisionRegionUpper ), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = scaledInformation ) results$conditionalPower[population, (stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ]) } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned results$nPlanned <- nPlanned results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$thetaH1 <- thetaH1 results$assumedStDevs <- assumedStDevs return(results) } # # Calculation of conditional power based on Fisher's combination test # .getConditionalPowerMeansEnrichmentFisher <- function(..., results, stageResults, stage, allocationRatioPlanned, nPlanned, thetaH1, assumedStDevs, iterations, seed) { design <- stageResults$.design .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerMeansEnrichmentFisher", ignore = c("stage", "design", "stDevsH1"), ... ) kMax <- design$kMax gMax <- stageResults$getGMax() criticalValues <- design$criticalValues weightsFisher <- .getWeightsFisher(design) # results$conditionalPower <- matrix(NA_real_, nrow = gMax, ncol = kMax) results$iterations <- as.integer(iterations) results$.setParameterType("iterations", C_PARAM_USER_DEFINED) results$.setParameterType("seed", ifelse(is.na(seed), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) results$seed <- .setSeed(seed) results$simulated <- FALSE results$.setParameterType("simulated", C_PARAM_DEFAULT_VALUE) .setValueAndParameterType( results, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT ) if (length(thetaH1) == 1) { thetaH1 <- rep(thetaH1, gMax) results$.setParameterType("thetaH1", C_PARAM_GENERATED) } else { results$.setParameterType("thetaH1", C_PARAM_DEFAULT_VALUE) } results$.setParameterType("assumedStDevs", C_PARAM_DEFAULT_VALUE) if (stageResults$directionUpper) { standardizedEffect <- (thetaH1 - stageResults$thetaH0) / assumedStDevs } else { standardizedEffect <- -(thetaH1 - stageResults$thetaH0) / assumedStDevs } nPlanned <- c(rep(NA_real_, stage), nPlanned) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned ctr <- .performClosedCombinationTest(stageResults = stageResults) for (population in 1:gMax) { if (!is.na(ctr$separatePValues[population, stage])) { if (gMax == 1) { pValues <- ctr$adjustedStageWisePValues[ctr$indices[, population] == 1, ][1:stage] } else { pValues <- ctr$adjustedStageWisePValues[ctr$indices[, population] == 1, ][which.max( ctr$overallAdjustedTestStatistics[ctr$indices[, population] == 1, stage] ), 1:stage] } if (stage < kMax - 1) { for (k in (stage + 1):kMax) { reject <- 0 for (i in 1:iterations) { reject <- reject + .getRejectValueConditionalPowerFisher( kMax = kMax, alpha0Vec = design$alpha0Vec, criticalValues = criticalValues, weightsFisher = weightsFisher, pValues = pValues, currentKMax = k, thetaH1 = standardizedEffect[population], stage = stage, nPlanned = nPlanned ) } results$conditionalPower[population, k] <- reject / iterations } results$simulated <- TRUE results$.setParameterType("simulated", C_PARAM_GENERATED) } else if (stage == kMax - 1) { divisor <- prod(pValues[1:(kMax - 1)]^weightsFisher[1:(kMax - 1)]) result <- 1 - (criticalValues[kMax] / divisor)^(1 / weightsFisher[kMax]) if (result <= 0 || result >= 1) { warning("Calculation not possible: could not calculate conditional power for stage ", kMax, call. = FALSE ) results$conditionalPower[population, kMax] <- NA_real_ } else { results$conditionalPower[population, kMax] <- 1 - stats::pnorm(.getQNorm(result) - standardizedEffect[population] * sqrt(nPlanned[kMax])) } } } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned results$nPlanned <- nPlanned results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$thetaH1 <- thetaH1 results$assumedStDevs <- assumedStDevs return(results) } # # Calculation of conditional power and likelihood values for plotting the graph # .getConditionalPowerLikelihoodMeansEnrichment <- function(..., stageResults, stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaRange, assumedStDevs = NA_real_, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .associatedArgumentsAreDefined(nPlanned = nPlanned, thetaRange = thetaRange) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) design <- stageResults$.design kMax <- design$kMax gMax <- stageResults$getGMax() intersectionTest <- stageResults$intersectionTest assumedStDevs <- .assertIsValidAssumedStDevForMultiHypotheses(assumedStDevs, stageResults, stage) if (length(assumedStDevs) == 1) { assumedStDevs <- rep(assumedStDevs, gMax) } thetaRange <- .assertIsValidThetaRange(thetaRange = thetaRange) populations <- numeric(gMax * length(thetaRange)) effectValues <- numeric(gMax * length(thetaRange)) condPowerValues <- numeric(gMax * length(thetaRange)) likelihoodValues <- numeric(gMax * length(thetaRange)) stdErr <- stageResults$overallStDevs[stage] * sqrt(1 / stageResults$.overallSampleSizes1[, stage] + 1 / stageResults$.overallSampleSizes2[, stage]) results <- ConditionalPowerResultsEnrichmentMeans( .design = design, .stageResults = stageResults, assumedStDevs = assumedStDevs, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned ) j <- 1 for (i in seq(along = thetaRange)) { for (population in 1:gMax) { populations[j] <- population effectValues[j] <- thetaRange[i] if (.isTrialDesignInverseNormal(design)) { condPowerValues[j] <- .getConditionalPowerMeansEnrichmentInverseNormal( results = results, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i], assumedStDevs = assumedStDevs )$conditionalPower[population, kMax] } else if (.isTrialDesignFisher(design)) { condPowerValues[j] <- .getConditionalPowerMeansEnrichmentFisher( results = results, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i], assumedStDevs = assumedStDevs, iterations = iterations, seed = seed )$conditionalPower[population, kMax] } likelihoodValues[j] <- stats::dnorm( thetaRange[i], stageResults$effectSizes[population, stage], stdErr[population] ) / stats::dnorm(0, 0, stdErr[population]) j <- j + 1 } } subtitle <- paste0( "Intersection test = ", intersectionTest, ", stage = ", stage, ", # of remaining subjects = ", sum(nPlanned), ", sd = ", .formatSubTitleValue(assumedStDevs, "assumedStDevs"), ", allocation ratio = ", .formatSubTitleValue(allocationRatioPlanned, "allocationRatioPlanned") ) return(list( populations = populations, xValues = effectValues, condPowerValues = condPowerValues, likelihoodValues = likelihoodValues, main = C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, xlab = "Effect size", ylab = C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, sub = subtitle )) } rpact/R/f_design_group_sequential.R0000644000175000017500000027417214151661723017310 0ustar nileshnilesh## | ## | *Group sequential design* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5604 $ ## | Last changed: $Date: 2021-12-01 08:24:25 +0100 (Wed, 01 Dec 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include f_core_constants.R NULL .getGroupSequentialProbabilities <- function(decisionMatrix, informationRates) { if (Sys.getenv("RPACT_ENGINE_CLASSIC_R") %in% c("", "FALSE")) { return(getGroupSequentialProbabilitiesCpp(decisionMatrix, informationRates)) } .assertAreValidInformationRates(informationRates) if (length(decisionMatrix) != nrow(decisionMatrix) * length(informationRates)) { stop(sprintf( paste0( C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "length of 'decisionMatrix' (%s) must be equal to 2 x length of 'informationRates' (%s)" ), length(decisionMatrix), length(informationRates) )) } decisionMatrix[decisionMatrix >= C_UPPER_BOUNDS_DEFAULT] <- C_UPPER_BOUNDS_DEFAULT M <- C_CONST_NEWTON_COTES * 6 + 1 # number of grid points with constant of Newton Cotes algorithm (n*6 + 1) kMax <- length(informationRates) # maximum number of stages probs <- matrix(NA_real_, nrow(decisionMatrix) + 1, kMax) # probability matrix output probs[, 1] <- c(stats::pnorm(decisionMatrix[, 1]), 1) if (kMax <= 1) { return(probs) } epsilonVec <- informationRates epsilonVec[2:kMax] <- informationRates[2:kMax] - informationRates[1:(kMax - 1)] informationRatesSqrt <- sqrt(informationRates) epsilonVecSqrt <- sqrt(epsilonVec) if (nrow(decisionMatrix) == 2) { decisionMatrix[decisionMatrix <= C_FUTILITY_BOUNDS_DEFAULT] <- C_FUTILITY_BOUNDS_DEFAULT dn <- rep(NA_real_, M) # density values w <- rep(NA_real_, M) # weights x <- rep(NA_real_, M) # grid points dn2 <- rep(NA_real_, M) # density values in recursion x2 <- rep(NA_real_, M) # grid points in recursion for (k in 2:kMax) { dx <- (decisionMatrix[2, k - 1] - decisionMatrix[1, k - 1]) / (M - 1) w <- c(rep(c(492, 1296, 162, 1632, 162, 1296) * dx / 840, M %/% 6), 246 * dx / 840) w[1] <- 246 * dx / 840 x <- rep(decisionMatrix[1, k - 1], M) + (0:(M - 1)) * dx dn <- w * .getDnormValues(x, k, informationRates, epsilonVec, x2, dn2) # as alternative, use crossprod (x, y) seq1 <- stats::pnorm((decisionMatrix[1, k] * informationRatesSqrt[k] - x * informationRatesSqrt[k - 1]) / epsilonVecSqrt[k]) %*% dn seq2 <- stats::pnorm((decisionMatrix[2, k] * informationRatesSqrt[k] - x * informationRatesSqrt[k - 1]) / epsilonVecSqrt[k]) %*% dn x2 <- x dn2 <- dn probs[, k] <- c(seq1, seq2, probs[2, k - 1] - probs[1, k - 1]) } } else if (nrow(decisionMatrix) == 4) { decisionMatrix[decisionMatrix <= -C_UPPER_BOUNDS_DEFAULT] <- -C_UPPER_BOUNDS_DEFAULT dn <- rep(NA_real_, 2 * M) # density values w <- rep(NA_real_, 2 * M) # weights x <- rep(NA_real_, 2 * M) # grid points dn2 <- rep(NA_real_, 2 * M) # density values in recursion x2 <- rep(NA_real_, 2 * M) # grid points in recursion for (k in 2:kMax) { dx1 <- (decisionMatrix[2, k - 1] - decisionMatrix[1, k - 1]) / (M - 1) w1 <- c(rep(c(492, 1296, 162, 1632, 162, 1296) * dx1 / 840, M %/% 6), 246 * dx1 / 840) w1[1] <- 246 * dx1 / 840 x0 <- rep(decisionMatrix[1, k - 1], M) + (0:(M - 1)) * dx1 dx2 <- (decisionMatrix[4, k - 1] - decisionMatrix[3, k - 1]) / (M - 1) w2 <- c(rep(c(492, 1296, 162, 1632, 162, 1296) * dx2 / 840, M %/% 6), 246 * dx2 / 840) w2[1] <- 246 * dx2 / 840 x1 <- rep(decisionMatrix[3, k - 1], M) + (0:(M - 1)) * dx2 x <- c(x0, x1) w <- c(w1, w2) dn <- w * .getDnormValues(x, k, informationRates, epsilonVec, x2, dn2) seq1 <- stats::pnorm((decisionMatrix[1, k] * informationRatesSqrt[k] - x * informationRatesSqrt[k - 1]) / epsilonVecSqrt[k]) %*% dn seq2 <- stats::pnorm((decisionMatrix[2, k] * informationRatesSqrt[k] - x * informationRatesSqrt[k - 1]) / epsilonVecSqrt[k]) %*% dn seq3 <- stats::pnorm((decisionMatrix[3, k] * informationRatesSqrt[k] - x * informationRatesSqrt[k - 1]) / epsilonVecSqrt[k]) %*% dn seq4 <- stats::pnorm((decisionMatrix[4, k] * informationRatesSqrt[k] - x * informationRatesSqrt[k - 1]) / epsilonVecSqrt[k]) %*% dn x2 <- x dn2 <- dn probs[, k] <- c(seq1, seq2, seq3, seq4, probs[4, k - 1] - probs[3, k - 1] + probs[2, k - 1] - probs[1, k - 1]) } } .validateGroupSequentialProbabilityResultsMulti(dn = dn, dn2 = dn2, x = x, x2 = x2, w = w) return(probs) } # slow R-based call .getDnormValues <- function(x, k, informationRates, epsilonVec, x2, dn2) { return(sapply(x, .getDnormValuesSlow, k = k, informationRates = informationRates, epsilonVec = epsilonVec, x2 = x2, dn2 = dn2 )) } .getDnormValuesSlow <- function(x, k, informationRates, epsilonVec, x2, dn2) { if (k == 2) { return(stats::dnorm(x)) } sum(sqrt(informationRates[k - 1] / epsilonVec[k - 1]) * stats::dnorm((x * sqrt(informationRates[k - 1]) - x2 * sqrt(informationRates[k - 2])) / sqrt(epsilonVec[k - 1])) * dn2) } .validateGroupSequentialProbabilityResultsMulti <- function(...) { args <- list(...) for (variableName in names(args)) { if (!.validateGroupSequentialProbabilityResults(results = args[[variableName]], variableName)) { return(invisible()) } } } .validateGroupSequentialProbabilityResults <- function(results, variableName) { numberOfNAs <- sum(is.na(results)) if (numberOfNAs == 0) { return(TRUE) } warning(sprintf( paste0( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "in .getGroupSequentialProbabilities(): ", "variable '%s' contains %s NA's (%.1f%%)" ), variableName, numberOfNAs, 100 * numberOfNAs / length(results) ), call. = FALSE) return(FALSE) } .getSpendingValue <- function(alpha, x, sided, typeOfDesign, gamma = 1) { if (typeOfDesign == C_TYPE_OF_DESIGN_AS_P || typeOfDesign == C_TYPE_OF_DESIGN_BS_P) { return(alpha * log(1 + (exp(1) - 1) * x)) } if (typeOfDesign == C_TYPE_OF_DESIGN_AS_OF || typeOfDesign == C_TYPE_OF_DESIGN_BS_OF) { return(2 * sided * (1 - stats::pnorm(.getOneMinusQNorm(alpha / (2 * sided)) / sqrt(x)))) } if (typeOfDesign == C_TYPE_OF_DESIGN_AS_KD || typeOfDesign == C_TYPE_OF_DESIGN_BS_KD) { return(alpha * x^gamma) } if (typeOfDesign == C_TYPE_OF_DESIGN_AS_HSD || typeOfDesign == C_TYPE_OF_DESIGN_BS_HSD) { if (gamma == 0) { return(alpha * x) } return(alpha * (1 - exp(-gamma * x)) / (1 - exp(-gamma))) } return(NA) } .getOptimumDesign <- function(deltaWT, design) { scale <- .getOneDimensionalRoot( function(scale) { criticalValues <- scale * design$informationRates^(deltaWT - 0.5) if (design$sided == 2) { decisionMatrix <- (matrix(c(-criticalValues, criticalValues), nrow = 2, byrow = TRUE)) probs <- .getGroupSequentialProbabilities(decisionMatrix, design$informationRates) return(sum(probs[3, ] - probs[2, ] + probs[1, ]) - design$alpha) } else { if (design$bindingFutility) { decisionMatrix <- matrix(c( design$futilityBounds, C_FUTILITY_BOUNDS_DEFAULT, criticalValues ), nrow = 2, byrow = TRUE) } else { decisionMatrix <- matrix(c( rep(C_FUTILITY_BOUNDS_DEFAULT, design$kMax), criticalValues ), nrow = 2, byrow = TRUE) } probs <- .getGroupSequentialProbabilities(decisionMatrix, design$informationRates) return(sum(probs[3, ] - probs[2, ]) - design$alpha) } }, lower = 0, upper = 5, tolerance = design$tolerance, callingFunctionInformation = ".getOptimumDesign" ) design$criticalValues <- scale * design$informationRates^(deltaWT - 0.5) designCharacteristics <- .getDesignCharacteristics(design = design) y <- NA_integer_ if (design$optimizationCriterion == C_OPTIMIZATION_CRITERION_ASNH1) { y <- designCharacteristics$averageSampleNumber1 } if (design$optimizationCriterion == C_OPTIMIZATION_CRITERION_ASNIFH1) { y <- designCharacteristics$inflationFactor + designCharacteristics$averageSampleNumber1 } if (design$optimizationCriterion == C_OPTIMIZATION_CRITERION_ASN_SUM) { y <- designCharacteristics$averageSampleNumber0 + designCharacteristics$averageSampleNumber01 + designCharacteristics$averageSampleNumber1 } return(y) } .validateTypeOfDesign <- function(design) { .assertDesignParameterExists(design, "typeOfDesign", C_DEFAULT_TYPE_OF_DESIGN) design$.setParameterType("userAlphaSpending", C_PARAM_NOT_APPLICABLE) design$.setParameterType("userBetaSpending", C_PARAM_NOT_APPLICABLE) design$.setParameterType("deltaWT", C_PARAM_NOT_APPLICABLE) design$.setParameterType("deltaPT1", C_PARAM_NOT_APPLICABLE) design$.setParameterType("deltaPT0", C_PARAM_NOT_APPLICABLE) design$.setParameterType("optimizationCriterion", C_PARAM_NOT_APPLICABLE) design$.setParameterType("gammaA", C_PARAM_NOT_APPLICABLE) design$.setParameterType("gammaB", C_PARAM_NOT_APPLICABLE) design$.setParameterType("typeBetaSpending", C_PARAM_NOT_APPLICABLE) design$.setParameterType("constantBoundsHP", C_PARAM_NOT_APPLICABLE) if (!(design$typeOfDesign %in% .getDesignTypes())) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "type of design (", design$typeOfDesign, ") must be one of the following: ", .printDesignTypes() ) } if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT) { .assertDesignParameterExists(design, "deltaWT", NA_real_) .assertIsSingleNumber(design$deltaWT, "deltaWT", naAllowed = FALSE) .assertIsInClosedInterval(design$deltaWT, "deltaWT", lower = -0.5, upper = 1) } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { .assertDesignParameterExists(design, "deltaPT1", NA_real_) .assertIsSingleNumber(design$deltaPT1, "deltaPT1", naAllowed = FALSE) .assertIsInClosedInterval(design$deltaPT1, "deltaPT1", lower = -0.5, upper = 1) .assertDesignParameterExists(design, "deltaPT0", NA_real_) .assertIsSingleNumber(design$deltaPT0, "deltaPT0", naAllowed = FALSE) .assertIsInClosedInterval(design$deltaPT0, "deltaPT0", lower = -0.5, upper = 1) } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT_OPTIMUM) { .assertDesignParameterExists(design, "optimizationCriterion", C_OPTIMIZATION_CRITERION_DEFAULT) if (!.isOptimizationCriterion(design$optimizationCriterion)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "optimization criterion must be one of the following: ", .printOptimizationCriterion() ) } } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_HP) { .assertDesignParameterExists(design, "constantBoundsHP", C_CONST_BOUND_HP_DEFAULT) .assertIsSingleNumber(design$constantBoundsHP, "constantBoundsHP") .assertIsInClosedInterval(design$constantBoundsHP, "constantBoundsHP", lower = 2, upper = NULL) } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_AS_KD) { .assertDesignParameterExists(design, "gammaA", NA_real_) .assertIsSingleNumber(design$gammaA, "gammaA", naAllowed = FALSE) if (design$gammaA < 0.4 || design$gammaA > 8) { stop( C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "parameter 'gammaA' (", design$gammaA, ") for Kim & DeMets alpha ", "spending function is out of bounds [0.4; 8]" ) } } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_AS_HSD) { .assertDesignParameterExists(design, "gammaA", NA_real_) .assertIsSingleNumber(design$gammaA, "gammaA", naAllowed = FALSE) if (design$gammaA < -10 || design$gammaA > 5) { stop( C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "Parameter 'gammaA' (", design$gammaA, ") for Hwang, Shih & DeCani ", "alpha spending function is out of bounds [-10; 5]" ) } } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_AS_USER) { .validateUserAlphaSpending(design) design$.setParameterType("userAlphaSpending", C_PARAM_USER_DEFINED) } if (.isUndefinedArgument(design$alpha)) { design$alpha <- C_ALPHA_DEFAULT design$.setParameterType("alpha", C_PARAM_DEFAULT_VALUE) } if (design$typeOfDesign == C_TYPE_OF_DESIGN_NO_EARLY_EFFICACY) { .assertIsValidAlpha(design$alpha) design$.setParameterType("userAlphaSpending", C_PARAM_DEFAULT_VALUE) } if (.isAlphaSpendingDesignType(design$typeOfDesign)) { .assertDesignParameterExists(design, "typeBetaSpending", C_TYPE_OF_DESIGN_BS_NONE) if (!.isBetaSpendingDesignType(design$typeBetaSpending, noneIncluded = TRUE)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "type of beta spending must be one of the following: ", .printBetaSpendingDesignTypes() ) } if (design$typeBetaSpending == C_TYPE_OF_DESIGN_BS_KD) { .assertDesignParameterExists(design, "gammaB", NA_real_) .assertIsSingleNumber(design$gammaB, "gammaB", naAllowed = FALSE) if (design$gammaB < 0.4 || design$gammaB > 8) { stop( C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "parameter 'gammaB' (", design$gammaB, ") for Kim & DeMets beta ", "spending function out of bounds [0.4; 8]" ) } } if (design$typeBetaSpending == C_TYPE_OF_DESIGN_BS_HSD) { .assertDesignParameterExists(design, "gammaB", NA_real_) .assertIsSingleNumber(design$gammaB, "gammaB", naAllowed = FALSE) if (design$gammaB < -10 || design$gammaB > 5) { stop( C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "parameter 'gammaB' (", design$gammaB, ") for Hwang, Shih & DeCani ", "beta spending out of bounds [-10; 5]" ) } } if (design$typeBetaSpending == C_TYPE_OF_DESIGN_BS_USER) { .validateUserBetaSpending(design) design$.setParameterType("userBetaSpending", C_PARAM_USER_DEFINED) } } else { if (.designParameterExists(design, "typeBetaSpending") && design$typeBetaSpending != C_TYPE_OF_DESIGN_BS_NONE) { warning("'typeBetaSpending' (", design$typeBetaSpending, ") will be ignored ", "because 'typeOfDesign' (", design$typeOfDesign, ") is not an alpha spending design", call. = FALSE ) design$typeBetaSpending <- C_TYPE_OF_DESIGN_BS_NONE design$.setParameterType("typeBetaSpending", C_PARAM_DEFAULT_VALUE) } if (.designParameterExists(design, "userBetaSpending")) { userBetaSpending <- NA_real_ warning("'userBetaSpending' (", .arrayToString(design$userBetaSpending), ") will be ignored ", "because 'typeOfDesign' (", design$typeOfDesign, ") is not an alpha spending design", call. = FALSE ) } } if (.isUndefinedArgument(design$beta)) { design$beta <- C_BETA_DEFAULT design$.setParameterType("beta", C_PARAM_DEFAULT_VALUE) } invisible(design) } .validateBaseParameters <- function(design, twoSidedWarningForDefaultValues = TRUE) { if (.isDefinedArgument(design$kMax)) { .assertDesignParameterExists(design, "kMax", C_KMAX_DEFAULT) .assertIsValidKMax(design$kMax) if (.isDefinedArgument(design$informationRates)) { .assertAreValidInformationRates(design$informationRates, design$kMax) } if (.isDefinedArgument(design$futilityBounds)) { .assertAreValidFutilityBounds(design$futilityBounds, design$kMax) } } .assertDesignParameterExists(design, "sided", C_SIDED_DEFAULT) .assertIsValidSidedParameter(design$sided) .setKmaxBasedOnAlphaSpendingDefintion(design) design$informationRates <- .getValidatedInformationRates(design) design$futilityBounds <- .getValidatedFutilityBounds(design, twoSidedWarningForDefaultValues = twoSidedWarningForDefaultValues ) .assertDesignParameterExists(design, "tolerance", C_DESIGN_TOLERANCE_DEFAULT) if (design$tolerance < 1e-10 || design$tolerance > 1e-03) { stop( C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'tolerance' (", tolerance, ") out of bounds [1e-10; 1e-03]" ) } invisible(design) } .createDesign <- function(..., designClass, kMax = NA_integer_, alpha = NA_real_, beta = NA_real_, sided = C_SIDED_DEFAULT, informationRates = NA_real_, futilityBounds = NA_real_, typeOfDesign = C_DEFAULT_TYPE_OF_DESIGN, deltaWT = NA_real_, deltaPT1 = NA_real_, deltaPT0 = NA_real_, optimizationCriterion = C_OPTIMIZATION_CRITERION_DEFAULT, gammaA = NA_real_, typeBetaSpending = C_TYPE_OF_DESIGN_BS_NONE, userAlphaSpending = NA_real_, userBetaSpending = NA_real_, gammaB = NA_real_, bindingFutility = C_BINDING_FUTILITY_DEFAULT, constantBoundsHP = C_CONST_BOUND_HP_DEFAULT, twoSidedPower = NA, tolerance = C_DESIGN_TOLERANCE_DEFAULT) { if (designClass == C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL) { design <- TrialDesignInverseNormal(kMax = kMax) } else if (designClass == C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL) { design <- TrialDesignGroupSequential(kMax = kMax) } else { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'designClass' ('", designClass, "') must be '", C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL, "' or ", "'", C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL, "'" ) } .assertIsSingleInteger(sided, "sided", naAllowed = FALSE, validateType = FALSE) if (!is.integer(sided) && sided %in% c(1, 2)) { sided <- as.integer(sided) } .assertIsSingleCharacter(typeOfDesign, "typeOfDesign") .assertIsSingleCharacter(optimizationCriterion, "optimizationCriterion") .assertIsSingleCharacter(typeBetaSpending, "typeBetaSpending") .assertIsSingleLogical(bindingFutility, "bindingFutility") .assertIsSingleLogical(twoSidedPower, "twoSidedPower", naAllowed = TRUE) .assertIsSingleNumber(alpha, "alpha", naAllowed = TRUE) .assertIsSingleNumber(beta, "beta", naAllowed = TRUE) .assertIsSingleNumber(deltaWT, "deltaWT", naAllowed = TRUE) .assertIsSingleNumber(deltaPT1, "deltaPT1", naAllowed = TRUE) .assertIsSingleNumber(deltaPT0, "deltaPT0", naAllowed = TRUE) .assertIsSingleNumber(gammaA, "gammaA", naAllowed = TRUE) .assertIsSingleNumber(gammaB, "gammaB", naAllowed = TRUE) .assertIsNumericVector(futilityBounds, "futilityBounds", naAllowed = TRUE) .assertIsNumericVector(informationRates, "informationRates", naAllowed = TRUE) .assertIsNumericVector(userAlphaSpending, "userAlphaSpending", naAllowed = TRUE) .assertIsNumericVector(userBetaSpending, "userBetaSpending", naAllowed = TRUE) design$alpha <- alpha design$beta <- beta design$sided <- sided design$typeOfDesign <- typeOfDesign design$deltaWT <- deltaWT design$deltaPT1 <- deltaPT1 design$deltaPT0 <- deltaPT0 design$gammaA <- gammaA design$gammaB <- gammaB design$optimizationCriterion <- optimizationCriterion design$typeBetaSpending <- typeBetaSpending design$futilityBounds <- futilityBounds design$informationRates <- informationRates design$userAlphaSpending <- userAlphaSpending design$userBetaSpending <- userBetaSpending design$bindingFutility <- bindingFutility if (design$typeOfDesign != C_TYPE_OF_DESIGN_WT_OPTIMUM && optimizationCriterion != C_OPTIMIZATION_CRITERION_DEFAULT) { warning( "'optimizationCriterion' (", optimizationCriterion, ") will be ignored because it is only applicable for 'typeOfDesign' = \"", C_TYPE_OF_DESIGN_WT_OPTIMUM, "\"" ) } if (design$typeOfDesign == C_TYPE_OF_DESIGN_HP) { .assertIsSingleNumber(constantBoundsHP, "constantBoundsHP") .assertIsInClosedInterval(constantBoundsHP, "constantBoundsHP", lower = 2, upper = NULL) design$constantBoundsHP <- constantBoundsHP } else if (constantBoundsHP != C_CONST_BOUND_HP_DEFAULT) { warning( "'constantBoundsHP' (", constantBoundsHP, ") will be ignored because it is only applicable for 'typeOfDesign' = \"", C_TYPE_OF_DESIGN_HP, "\"" ) } if (is.na(twoSidedPower)) { design$twoSidedPower <- C_TWO_SIDED_POWER_DEFAULT design$.setParameterType("twoSidedPower", C_PARAM_DEFAULT_VALUE) } else { design$twoSidedPower <- twoSidedPower design$.setParameterType("twoSidedPower", C_PARAM_USER_DEFINED) } design$tolerance <- tolerance return(design) } .getDesignGroupSequentialKMax1 <- function(design) { design$criticalValues <- .getOneMinusQNorm(design$alpha / design$sided) design$alphaSpent[1] <- design$alpha invisible(design) } # # Wang and Tsiatis design # .getDesignGroupSequentialWangAndTsiatis <- function(design) { if (design$typeOfDesign == C_TYPE_OF_DESIGN_P) { design$deltaWT <- 0.5 } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_OF) { design$deltaWT <- 0 } scale <- .getOneDimensionalRoot( function(scale) { design$criticalValues <- scale * design$informationRates^(design$deltaWT - 0.5) if (design$sided == 2) { decisionMatrix <- matrix(c(-design$criticalValues, design$criticalValues), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix, design$informationRates) return(sum(probs[3, ] - probs[2, ] + probs[1, ]) - design$alpha) } else { if (design$bindingFutility) { decisionMatrix <- matrix(c( design$futilityBounds, C_FUTILITY_BOUNDS_DEFAULT, design$criticalValues ), nrow = 2, byrow = TRUE) } else { decisionMatrix <- matrix(c( rep(C_FUTILITY_BOUNDS_DEFAULT, design$kMax), design$criticalValues ), nrow = 2, byrow = TRUE) } probs <- .getGroupSequentialProbabilities(decisionMatrix, design$informationRates) return(sum(probs[3, ] - probs[2, ]) - design$alpha) } }, lower = 0, upper = 8, tolerance = design$tolerance, callingFunctionInformation = ".getDesignGroupSequentialWangAndTsiatis" ) design$criticalValues <- scale * design$informationRates^(design$deltaWT - 0.5) .calculateAlphaSpent(design) invisible(design) } .getDesignGroupSequentialPampallonaTsiatis <- function(design) { if (!(Sys.getenv("RPACT_GS_PT_CLASSIC_R") %in% c("", "FALSE"))) { return(.getDesignGroupSequentialPampallonaTsiatisSlow(design)) } cppResultList <- getDesignGroupSequentialPampallonaTsiatisCpp( design$tolerance, design$beta, design$alpha, design$kMax, design$deltaPT0, design$deltaPT1, design$informationRates, design$sided, design$bindingFutility ) futilityBounds <- cppResultList[[1]] rejectionBounds <- cppResultList[[2]] probs <- cppResultList[[3]] if (design$sided == 1) { design$betaSpent <- cumsum(probs[1, ]) design$power <- cumsum(probs[3, ] - probs[2, ]) } else { design$betaSpent <- cumsum(probs[3, ] - probs[2, ]) if (design$twoSidedPower) { design$power <- cumsum(probs[5, ] - probs[4, ] + probs[1, ]) } else { design$power <- cumsum(probs[5, ] - probs[4, ]) } } design$.setParameterType("betaSpent", C_PARAM_GENERATED) design$.setParameterType("power", C_PARAM_GENERATED) design$futilityBounds <- futilityBounds[1:(design$kMax - 1)] design$criticalValues <- rejectionBounds design$.setParameterType("futilityBounds", C_PARAM_GENERATED) design$.setParameterType("criticalValues", C_PARAM_GENERATED) .calculateAlphaSpent(design) design$futilityBounds[design$futilityBounds == 0] <- NA_real_ return(invisible(design)) } .getDesignGroupSequentialPampallonaTsiatisSlow <- function(design) { deltaPT1 <- design$deltaPT1 deltaPT0 <- design$deltaPT0 informationRates <- design$informationRates kMax <- design$kMax if (design$sided == 1) { if (design$bindingFutility) { prec2 <- 1 cLower2 <- 0 cUpper2 <- 10 while (prec2 > design$tolerance) { c2m <- (cLower2 + cUpper2) / 2 prec1 <- 1 cUpper1 <- 10 cLower1 <- 0 while (prec1 > design$tolerance) { c1m <- (cLower1 + cUpper1) / 2 delst <- c2m * kMax^(deltaPT0 - 0.5) + c1m * kMax^(deltaPT1 - 0.5) futilityBounds <- delst * sqrt(informationRates) - c2m * (informationRates * kMax)^(deltaPT0 - 0.5) rejectionBounds <- c1m * (informationRates * kMax)^(deltaPT1 - 0.5) futilityBounds[futilityBounds > rejectionBounds] <- rejectionBounds[futilityBounds > rejectionBounds] decisionMatrix <- matrix(c(futilityBounds, rejectionBounds), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) size <- sum(probs[3, ] - probs[2, ]) ifelse(size < design$alpha, cUpper1 <- c1m, cLower1 <- c1m) prec1 <- cUpper1 - cLower1 } decisionMatrixH1 <- decisionMatrix - matrix(rep(delst * sqrt(informationRates), 2), nrow = 2, byrow = TRUE ) probs <- .getGroupSequentialProbabilities(decisionMatrixH1, informationRates) power <- sum(probs[3, ] - probs[2, ]) ifelse(power > 1 - design$beta, cUpper2 <- c2m, cLower2 <- c2m) prec2 <- cUpper2 - cLower2 } } else { prec1 <- 1 cUpper1 <- 10 cLower1 <- 0 while (prec1 > design$tolerance) { c1m <- (cLower1 + cUpper1) / 2 rejectionBounds <- c1m * (informationRates * kMax)^(deltaPT1 - 0.5) decisionMatrix <- matrix(c(rep(-6, kMax), rejectionBounds), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) size <- sum(probs[3, ] - probs[2, ]) ifelse(size < design$alpha, cUpper1 <- c1m, cLower1 <- c1m) prec1 <- cUpper1 - cLower1 } rejectionBounds <- c1m * (informationRates * kMax)^(deltaPT1 - 0.5) prec2 <- 1 cLower2 <- 0 cUpper2 <- 8 while (prec2 > design$tolerance) { c2m <- (cLower2 + cUpper2) / 2 delst <- c2m * kMax^(deltaPT0 - 0.5) + c1m * kMax^(deltaPT1 - 0.5) futilityBounds <- delst * sqrt(informationRates) - c2m * (informationRates * kMax)^(deltaPT0 - 0.5) futilityBounds[futilityBounds > rejectionBounds] <- rejectionBounds[futilityBounds > rejectionBounds] decisionMatrix <- matrix(c(futilityBounds, rejectionBounds), nrow = 2, byrow = TRUE) decisionMatrixH1 <- decisionMatrix - matrix(rep(delst * sqrt(informationRates), 2), nrow = 2, byrow = TRUE ) probs <- .getGroupSequentialProbabilities(decisionMatrixH1, informationRates) power <- sum(probs[3, ] - probs[2, ]) ifelse(power > 1 - design$beta, cUpper2 <- c2m, cLower2 <- c2m) prec2 <- cUpper2 - cLower2 } } design$betaSpent <- cumsum(probs[1, ]) design$power <- cumsum(probs[3, ] - probs[2, ]) design$.setParameterType("betaSpent", C_PARAM_GENERATED) design$.setParameterType("power", C_PARAM_GENERATED) } else { if (design$bindingFutility) { prec2 <- 1 cLower2 <- 0 cUpper2 <- 8 while (prec2 > design$tolerance) { c2m <- (cLower2 + cUpper2) / 2 prec1 <- 1 cUpper1 <- 8 cLower1 <- 0 while (prec1 > design$tolerance) { c1m <- (cLower1 + cUpper1) / 2 delst <- c2m * kMax^(deltaPT0 - 0.5) + c1m * kMax^(deltaPT1 - 0.5) futilityBounds <- delst * sqrt(informationRates) - c2m * (informationRates * kMax)^(deltaPT0 - 0.5) rejectionBounds <- c1m * (informationRates * kMax)^(deltaPT1 - 0.5) futilityBounds[futilityBounds > rejectionBounds] <- rejectionBounds[futilityBounds > rejectionBounds] futilityBounds[futilityBounds < 0] <- 0 decisionMatrix <- matrix(c(-rejectionBounds, -futilityBounds, futilityBounds, rejectionBounds), nrow = 4, byrow = TRUE ) probs <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) size <- sum(probs[5, ] - probs[4, ] + probs[1, ]) ifelse(size < design$alpha, cUpper1 <- c1m, cLower1 <- c1m) prec1 <- cUpper1 - cLower1 } decisionMatrixH1 <- decisionMatrix - matrix(rep(delst * sqrt(informationRates), 4), nrow = 4, byrow = TRUE ) probs <- .getGroupSequentialProbabilities(decisionMatrixH1, informationRates) power <- sum(probs[5, ] - probs[4, ] + probs[1, ]) ifelse(power > 1 - design$beta, cUpper2 <- c2m, cLower2 <- c2m) prec2 <- cUpper2 - cLower2 } } else { prec1 <- 1 cUpper1 <- 8 cLower1 <- 0 while (prec1 > design$tolerance) { c1m <- (cLower1 + cUpper1) / 2 rejectionBounds <- c1m * (informationRates * kMax)^(deltaPT1 - 0.5) decisionMatrix <- matrix(c(-rejectionBounds, rejectionBounds), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) size <- sum(probs[3, ] - probs[2, ] + probs[1, ]) ifelse(size < design$alpha, cUpper1 <- c1m, cLower1 <- c1m) prec1 <- cUpper1 - cLower1 } rejectionBounds <- c1m * (informationRates * kMax)^(deltaPT1 - 0.5) prec2 <- 1 cLower2 <- 0 cUpper2 <- 8 while (prec2 > design$tolerance) { c2m <- (cLower2 + cUpper2) / 2 delst <- c2m * kMax^(deltaPT0 - 0.5) + c1m * kMax^(deltaPT1 - 0.5) futilityBounds <- delst * sqrt(informationRates) - c2m * (informationRates * kMax)^(deltaPT0 - 0.5) futilityBounds[futilityBounds > rejectionBounds] <- rejectionBounds[futilityBounds > rejectionBounds] futilityBounds[futilityBounds < 0] <- 0 decisionMatrix <- matrix(c(-rejectionBounds, -futilityBounds, futilityBounds, rejectionBounds), nrow = 4, byrow = TRUE ) decisionMatrixH1 <- decisionMatrix - matrix(rep(delst * sqrt(informationRates), 4), nrow = 4, byrow = TRUE ) probs <- .getGroupSequentialProbabilities(decisionMatrixH1, informationRates) power <- sum(probs[5, ] - probs[4, ] + probs[1, ]) ifelse(power > 1 - design$beta, cUpper2 <- c2m, cLower2 <- c2m) prec2 <- cUpper2 - cLower2 } } design$betaSpent <- cumsum(probs[3, ] - probs[2, ]) if (design$twoSidedPower) { design$power <- cumsum(probs[5, ] - probs[4, ] + probs[1, ]) } else { design$power <- cumsum(probs[5, ] - probs[4, ]) } design$.setParameterType("betaSpent", C_PARAM_GENERATED) design$.setParameterType("power", C_PARAM_GENERATED) } design$futilityBounds <- futilityBounds[1:(design$kMax - 1)] design$criticalValues <- rejectionBounds design$.setParameterType("futilityBounds", C_PARAM_GENERATED) design$.setParameterType("criticalValues", C_PARAM_GENERATED) .calculateAlphaSpent(design) design$futilityBounds[design$futilityBounds == 0] <- NA_real_ return(invisible(design)) } .calculateAlphaSpent <- function(design) { if (design$sided == 2) { if (design$bindingFutility) { decisionMatrix <- matrix(c( -design$criticalValues, -design$futilityBounds, -C_FUTILITY_BOUNDS_DEFAULT, design$futilityBounds, C_FUTILITY_BOUNDS_DEFAULT, design$criticalValues ), nrow = 4, byrow = TRUE) } else { decisionMatrix <- matrix(c(-design$criticalValues, design$criticalValues), nrow = 2, byrow = TRUE) } } else { if (design$bindingFutility) { decisionMatrix <- matrix(c( design$futilityBounds, C_FUTILITY_BOUNDS_DEFAULT, design$criticalValues ), nrow = 2, byrow = TRUE) } else { decisionMatrix <- matrix(c( rep(C_FUTILITY_BOUNDS_DEFAULT, design$kMax), design$criticalValues ), nrow = 2, byrow = TRUE) } } tryCatch( { probs <- .getGroupSequentialProbabilities(decisionMatrix, design$informationRates) if (design$sided == 1) { design$alphaSpent <- cumsum(probs[3, ] - probs[2, ]) } else if (nrow(decisionMatrix) == 2) { design$alphaSpent <- cumsum(probs[3, ] - probs[2, ] + probs[1, ]) } else { design$alphaSpent <- cumsum(probs[5, ] - probs[4, ] + probs[1, ]) } if (!is.na(design$alphaSpent[design$kMax])) { design$alphaSpent[design$kMax] <- floor(design$alphaSpent[design$kMax] * 1e8) / 1e8 } design$.setParameterType("alphaSpent", C_PARAM_GENERATED) }, error = function(e) { warning("Failed to calculate 'alphaSpent': ", e, call. = FALSE) } ) } # # Haybittle & Peto design # .getDesignGroupSequentialHaybittleAndPeto <- function(design) { scale <- .getOneDimensionalRoot( function(scale) { design$criticalValues <- c(rep(design$constantBoundsHP, design$kMax - 1), scale) if (design$sided == 2) { decisionMatrix <- matrix(c(-design$criticalValues, design$criticalValues), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix, design$informationRates) return(sum(probs[3, ] - probs[2, ] + probs[1, ]) - design$alpha) } else { if (design$bindingFutility) { decisionMatrix <- matrix(c( design$futilityBounds, C_FUTILITY_BOUNDS_DEFAULT, design$criticalValues ), nrow = 2, byrow = TRUE) } else { decisionMatrix <- matrix(c( rep(C_FUTILITY_BOUNDS_DEFAULT, design$kMax), design$criticalValues ), nrow = 2, byrow = TRUE) } probs <- .getGroupSequentialProbabilities(decisionMatrix, design$informationRates) return(sum(probs[3, ] - probs[2, ]) - design$alpha) } }, lower = 0, upper = 8, tolerance = design$tolerance, callingFunctionInformation = ".getDesignGroupSequentialHaybittleAndPeto" ) design$criticalValues <- c(rep(design$constantBoundsHP, design$kMax - 1), scale) .calculateAlphaSpent(design) if (!is.na(design$criticalValues[design$kMax]) && !is.na(design$alphaSpent[design$kMax]) && (design$criticalValues[design$kMax] > 6 || abs(design$alphaSpent[design$kMax] - design$alpha) > 0.001)) { stop(sprintf( paste0( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "critical values according to the Haybittle & Peto design cannot be calculated ", "(criticalValues[%s] = %s, alpha = %s)" ), design$kMax, design$criticalValues[design$kMax], design$alpha )) } invisible(design) } # # Optimum design within Wang and Tsiatis class # .getDesignGroupSequentialWangAndTsiatisOptimum <- function(design) { .assertDesignParameterExists(design, "optimizationCriterion", C_OPTIMIZATION_CRITERION_DEFAULT) .assertIsOptimizationCriterion(design$optimizationCriterion) optimumDesign <- stats::optimize(.getOptimumDesign, design = design, interval = c(0, 1), tol = 0.001 ) design$deltaWT <- round(optimumDesign$minimum, 2) design$.setParameterType("deltaWT", C_PARAM_GENERATED) # Recalculation of design characteristics with rounded design$deltaWT scale <- .getOneDimensionalRoot( function(scale) { design$criticalValues <- scale * design$informationRates^(design$deltaWT - 0.5) if (design$sided == 2) { decisionMatrix <- matrix(c(-design$criticalValues, design$criticalValues), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix, design$informationRates) return(sum(probs[3, ] - probs[2, ] + probs[1, ]) - design$alpha) } else { if (design$bindingFutility) { decisionMatrix <- matrix(c( design$futilityBounds, C_FUTILITY_BOUNDS_DEFAULT, design$criticalValues ), nrow = 2, byrow = TRUE) } else { decisionMatrix <- matrix(c( rep(C_FUTILITY_BOUNDS_DEFAULT, design$kMax), design$criticalValues ), nrow = 2, byrow = TRUE) } probs <- .getGroupSequentialProbabilities(decisionMatrix, design$informationRates) return(sum(probs[3, ] - probs[2, ]) - design$alpha) } }, lower = 0, upper = 5, tolerance = design$tolerance, callingFunctionInformation = ".getDesignGroupSequentialWangAndTsiatisOptimum" ) design$criticalValues <- scale * design$informationRates^(design$deltaWT - 0.5) designCharacteristics <- .getDesignCharacteristics(design = design) design$power <- designCharacteristics$power design$.setParameterType("power", C_PARAM_GENERATED) .calculateAlphaSpent(design) invisible(design) } # # alpha spending approaches # .getDesignGroupSequentialAlphaSpending <- function(design) { design$criticalValues <- rep(NA_real_, design$kMax) spendingValue <- .getSpendingValue( design$alpha, design$informationRates[1], design$sided, design$typeOfDesign, design$gammaA ) if (spendingValue < 0) { .logWarn("Cannot calculate alpha spent: 'spendingValue' (%s) is < 0", spendingValue) design$alphaSpent <- NA_real_ design$.setParameterType("alphaSpent", C_PARAM_GENERATED) return(.getDesignGroupSequentialBetaSpendingApproaches(design)) } design$criticalValues[1] <- .getOneMinusQNorm(spendingValue / design$sided) for (k in 2:design$kMax) { design$criticalValues[k] <- .getOneDimensionalRoot( function(scale) { design$criticalValues[k] <- scale if (design$sided == 2) { decisionMatrix <- matrix(c(-design$criticalValues, design$criticalValues), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix[, 1:k], design$informationRates[1:k]) return(sum(probs[3, ] - probs[2, ] + probs[1, ]) - .getSpendingValue( design$alpha, design$informationRates[k], design$sided, design$typeOfDesign, design$gammaA )) } else { if (design$bindingFutility) { decisionMatrix <- matrix(c( design$futilityBounds, C_FUTILITY_BOUNDS_DEFAULT, design$criticalValues ), nrow = 2, byrow = TRUE) } else { decisionMatrix <- matrix(c( rep(C_FUTILITY_BOUNDS_DEFAULT, design$kMax), design$criticalValues ), nrow = 2, byrow = TRUE) } probs <- .getGroupSequentialProbabilities(decisionMatrix[, 1:k], design$informationRates[1:k]) return(sum(probs[3, ] - probs[2, ]) - .getSpendingValue( design$alpha, design$informationRates[k], design$sided, design$typeOfDesign, design$gammaA )) } }, lower = 0, upper = 8, tolerance = design$tolerance, callingFunctionInformation = ".getDesignGroupSequentialAlphaSpending" ) } .calculateAlphaSpent(design) .getDesignGroupSequentialBetaSpendingApproaches(design) } # # User defined alpha spending approach # .getDesignGroupSequentialUserDefinedAlphaSpending <- function(design) { if (design$typeOfDesign == C_TYPE_OF_DESIGN_NO_EARLY_EFFICACY) { design$userAlphaSpending <- rep(0, design$kMax) design$userAlphaSpending[design$kMax] <- design$alpha } design$criticalValues <- rep(NA_real_, design$kMax) design$criticalValues[1] <- .getOneMinusQNorm(design$userAlphaSpending[1] / design$sided) for (k in (2:design$kMax)) { design$criticalValues[k] <- .getOneDimensionalRoot( function(scale) { design$criticalValues[k] <- scale if (design$sided == 2) { decisionMatrix <- matrix(c(-design$criticalValues, design$criticalValues), nrow = 2, byrow = TRUE ) probs <- .getGroupSequentialProbabilities(decisionMatrix[, 1:k], design$informationRates[1:k]) return(sum(probs[3, ] - probs[2, ] + probs[1, ]) - design$userAlphaSpending[k]) } else { if (design$bindingFutility) { decisionMatrix <- matrix(c( design$futilityBounds, C_FUTILITY_BOUNDS_DEFAULT, design$criticalValues ), nrow = 2, byrow = TRUE) } else { decisionMatrix <- matrix(c( rep(C_FUTILITY_BOUNDS_DEFAULT, design$kMax), design$criticalValues ), nrow = 2, byrow = TRUE) } probs <- .getGroupSequentialProbabilities(decisionMatrix[, 1:k], design$informationRates[1:k]) return(sum(probs[3, ] - probs[2, ]) - design$userAlphaSpending[k]) } }, lower = 0, upper = 8, tolerance = design$tolerance, callingFunctionInformation = ".getDesignGroupSequentialUserDefinedAlphaSpending" ) } design$criticalValues[!is.na(design$criticalValues) & design$criticalValues >= 8] <- Inf .calculateAlphaSpent(design) invisible(.getDesignGroupSequentialBetaSpendingApproaches(design)) } # # Only for alpha spending approaches # .getDesignGroupSequentialBetaSpendingApproaches <- function(design) { # beta spending approaches (additional to alpha spending)! if (.isBetaSpendingDesignType(design$typeBetaSpending, userDefinedBetaSpendingIncluded = FALSE, noneIncluded = FALSE )) { .getDesignGroupSequentialBetaSpending(design) } # User defined beta spending if (design$typeBetaSpending == C_TYPE_OF_DESIGN_BS_USER) { .getDesignGroupSequentialUserDefinedBetaSpending(design) } invisible(design) } # # Beta spending approaches (additional to alpha spending) # Find shift with beta spending such that last critical values coincide # .getDesignGroupSequentialBetaSpending <- function(design) { # Note: calculated without .getOneDimensionalRoot because results may not achieved in inner search # Direct bisection produced reliable results (although sometimes slowly) if (design$sided == 2) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'sided' = 2 not allowed; for beta-spending approach, only one-sided testing is possible" ) } iteration <- design$kMax * 1000 cLower1 <- -4 cUpper1 <- 10 prec1 <- 1 futilityBounds <- rep(NA_real_, design$kMax) if (!design$bindingFutility) { while (prec1 > design$tolerance) { shift <- (cLower1 + cUpper1) / 2 futilityBounds[1] <- .getQNorm(.getSpendingValue( design$beta, design$informationRates[1], design$sided, design$typeBetaSpending, design$gammaB )) + sqrt(design$informationRates[1]) * shift for (k in 2:design$kMax) { prec2 <- 1 cLower2 <- -6 cUpper2 <- 5 while (prec2 > design$tolerance) { scale <- (cLower2 + cUpper2) / 2 futilityBounds[k] <- scale decisionMatrix <- matrix(c( futilityBounds - sqrt(design$informationRates) * shift, design$criticalValues - sqrt(design$informationRates) * shift ), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix[, 1:k], design$informationRates[1:k]) ifelse(sum(probs[1, ]) < .getSpendingValue( design$beta, design$informationRates[k], design$sided, design$typeBetaSpending, design$gammaB ), cLower2 <- scale, cUpper2 <- scale) ifelse(iteration > 0, prec2 <- cUpper2 - cLower2, prec2 <- 0) iteration <- iteration - 1 } } ifelse(futilityBounds[design$kMax] < design$criticalValues[design$kMax], cLower1 <- shift, cUpper1 <- shift) ifelse(iteration > 0, prec1 <- cUpper1 - cLower1, prec1 <- 0) } } else { while (prec1 > design$tolerance) { shift <- (cLower1 + cUpper1) / 2 if (design$typeOfDesign %in% c(C_TYPE_OF_DESIGN_AS_USER, C_TYPE_OF_DESIGN_NO_EARLY_EFFICACY)) { alphaSpendingValue <- design$userAlphaSpending[1] } else { alphaSpendingValue <- .getSpendingValue(design$alpha, design$informationRates[1], design$sided, design$typeOfDesign, design$gammaA) } design$criticalValues[1] <- .getOneMinusQNorm(alphaSpendingValue / design$sided) futilityBounds[1] <- .getQNorm(.getSpendingValue( design$beta, design$informationRates[1], design$sided, design$typeBetaSpending, design$gammaB )) + sqrt(design$informationRates[1]) * shift for (k in 2:design$kMax) { cLower2 <- 0 cUpper2 <- 8 prec2 <- 1 while (prec2 > design$tolerance) { scale <- (cLower2 + cUpper2) / 2 design$criticalValues[k] <- scale decisionMatrix <- matrix(c(futilityBounds, design$criticalValues), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix[, 1:k], design$informationRates[1:k]) if (design$typeOfDesign %in% c(C_TYPE_OF_DESIGN_AS_USER, C_TYPE_OF_DESIGN_NO_EARLY_EFFICACY)) { ifelse(sum(probs[3, ] - probs[2, ]) > design$userAlphaSpending[k], cLower2 <- scale, cUpper2 <- scale) } else { ifelse(sum(probs[3, ] - probs[2, ]) > .getSpendingValue( design$alpha, design$informationRates[k], design$sided, design$typeOfDesign, design$gammaA ), cLower2 <- scale, cUpper2 <- scale) } ifelse(iteration > 0, prec2 <- cUpper2 - cLower2, prec2 <- 0) } cLower2 <- -6 cUpper2 <- 5 prec2 <- 1 while (prec2 > design$tolerance) { scale <- (cLower2 + cUpper2) / 2 futilityBounds[k] <- scale decisionMatrix <- matrix(c(futilityBounds - sqrt(design$informationRates) * shift, design$criticalValues - sqrt(design$informationRates) * shift), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix[, 1:k], design$informationRates[1:k]) ifelse(sum(probs[1, ]) < .getSpendingValue(design$beta, design$informationRates[k], design$sided, design$typeBetaSpending, design$gammaB), cLower2 <- scale, cUpper2 <- scale) ifelse(iteration > 0, prec2 <- cUpper2 - cLower2, prec2 <- 0) iteration <- iteration - 1 } } ifelse(futilityBounds[design$kMax] < design$criticalValues[design$kMax], cLower1 <- shift, cUpper1 <- shift) ifelse(iteration > 0, prec1 <- cUpper1 - cLower1, prec1 <- 0) } } if ((abs(futilityBounds[design$kMax] - design$criticalValues[design$kMax]) > 1e-05) || (iteration < 0)) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "calculation of 'betaSpent' and 'power' ", "not possible due to numerical overflow" ) } decisionMatrix <- matrix(c( futilityBounds - sqrt(design$informationRates) * shift, design$criticalValues - sqrt(design$informationRates) * shift ), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix, design$informationRates) design$betaSpent <- cumsum(probs[1, ]) design$power <- cumsum(probs[3, ] - probs[2, ]) design$.setParameterType("betaSpent", C_PARAM_GENERATED) design$.setParameterType("power", C_PARAM_GENERATED) design$futilityBounds <- futilityBounds[1:(design$kMax - 1)] design$.setParameterType("futilityBounds", C_PARAM_GENERATED) invisible(design) } # # User defined beta spending. # # Find shift with beta spending such that last critical values coincide # .getDesignGroupSequentialUserDefinedBetaSpending <- function(design) { # Note: calculated without .getOneDimensionalRoot because results may not achieved in inner search # Direct bisection produced reliable results (although sometimes slowly) if (design$typeBetaSpending != C_TYPE_OF_DESIGN_BS_USER) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'typeBetaSpending' ('", design$typeBetaSpending, "') must be '", C_TYPE_OF_DESIGN_BS_USER, "'" ) } if (design$sided == 2) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'sided' = 2 not allowed; for beta-spending approach, only one-sided testing is possible" ) } iteration <- design$kMax * 1000 cLower1 <- -4 cUpper1 <- 10 prec1 <- 1 futilityBounds <- rep(NA_real_, design$kMax) if (!design$bindingFutility) { while (prec1 > design$tolerance) { shift <- (cLower1 + cUpper1) / 2 futilityBounds[1] <- .getQNorm(design$userBetaSpending[1]) + sqrt(design$informationRates[1]) * shift for (k in 2:design$kMax) { prec2 <- 1 cLower2 <- -6 cUpper2 <- 5 while (prec2 > design$tolerance) { scale <- (cLower2 + cUpper2) / 2 futilityBounds[k] <- scale decisionMatrix <- matrix(c( futilityBounds - sqrt(design$informationRates) * shift, design$criticalValues - sqrt(design$informationRates) * shift ), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix[, 1:k], design$informationRates[1:k]) ifelse(sum(probs[1, ]) < design$userBetaSpending[k], cLower2 <- scale, cUpper2 <- scale) ifelse(iteration > 0, prec2 <- cUpper2 - cLower2, prec2 <- 0) iteration <- iteration - 1 } } ifelse(futilityBounds[design$kMax] < design$criticalValues[design$kMax], cLower1 <- shift, cUpper1 <- shift) ifelse(iteration > 0, prec1 <- cUpper1 - cLower1, prec1 <- 0) } } else { while (prec1 > design$tolerance) { shift <- (cLower1 + cUpper1) / 2 if (design$typeOfDesign %in% c(C_TYPE_OF_DESIGN_AS_USER, C_TYPE_OF_DESIGN_NO_EARLY_EFFICACY)) { alphaSpendingValue <- design$userAlphaSpending[1] } else { alphaSpendingValue <- .getSpendingValue( design$alpha, design$informationRates[1], design$sided, design$typeOfDesign, design$gammaA ) } design$criticalValues[1] <- .getOneMinusQNorm(alphaSpendingValue / design$sided) futilityBounds[1] <- .getQNorm(design$userBetaSpending[1]) + sqrt(design$informationRates[1]) * shift for (k in 2:design$kMax) { cLower2 <- 0 cUpper2 <- 8 prec2 <- 1 while (prec2 > design$tolerance) { scale <- (cLower2 + cUpper2) / 2 design$criticalValues[k] <- scale decisionMatrix <- matrix(c(futilityBounds, design$criticalValues), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix[, 1:k], design$informationRates[1:k]) if (design$typeOfDesign %in% c(C_TYPE_OF_DESIGN_AS_USER, C_TYPE_OF_DESIGN_NO_EARLY_EFFICACY)) { ifelse(sum(probs[3, ] - probs[2, ]) > design$userAlphaSpending[k], cLower2 <- scale, cUpper2 <- scale) } else { ifelse(sum(probs[3, ] - probs[2, ]) > .getSpendingValue( design$alpha, design$informationRates[k], design$sided, design$typeOfDesign, design$gammaA ), cLower2 <- scale, cUpper2 <- scale) } ifelse(iteration > 0, prec2 <- cUpper2 - cLower2, prec2 <- 0) } cLower2 <- -6 cUpper2 <- 5 prec2 <- 1 while (prec2 > design$tolerance) { scale <- (cLower2 + cUpper2) / 2 futilityBounds[k] <- scale decisionMatrix <- matrix(c( futilityBounds - sqrt(design$informationRates) * shift, design$criticalValues - sqrt(design$informationRates) * shift ), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix[, 1:k], design$informationRates[1:k]) ifelse(sum(probs[1, ]) < design$userBetaSpending[k], cLower2 <- scale, cUpper2 <- scale) ifelse(iteration > 0, prec2 <- cUpper2 - cLower2, prec2 <- 0) iteration <- iteration - 1 } } ifelse(futilityBounds[design$kMax] < design$criticalValues[design$kMax], cLower1 <- shift, cUpper1 <- shift) ifelse(iteration > 0, prec1 <- cUpper1 - cLower1, prec1 <- 0) } } if ((abs(futilityBounds[design$kMax] - design$criticalValues[design$kMax]) > 1e-05) || (iteration < 0)) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "calculation of 'betaSpent' and 'power' ", "not possible due to numerical overflow" ) } decisionMatrix <- matrix(c( futilityBounds - sqrt(design$informationRates) * shift, design$criticalValues - sqrt(design$informationRates) * shift ), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix, design$informationRates) design$betaSpent <- cumsum(probs[1, ]) design$power <- cumsum(probs[3, ] - probs[2, ]) design$.setParameterType("betaSpent", C_PARAM_GENERATED) design$.setParameterType("power", C_PARAM_GENERATED) design$futilityBounds <- futilityBounds[1:(design$kMax - 1)] design$.setParameterType("futilityBounds", C_PARAM_GENERATED) invisible(design) } #' #' @title #' Get Design Inverse Normal #' #' @description #' Provides adjusted boundaries and defines a group sequential design for its use in #' the inverse normal combination test. #' #' @inheritParams getDesignGroupSequential #' #' @template details_group_sequential_design #' #' @template return_object_trial_design #' @template how_to_get_help_for_generics #' #' @family design functions #' #' @template examples_get_design_inverse_normal #' #' @export #' getDesignInverseNormal <- function(..., kMax = NA_integer_, alpha = NA_real_, beta = NA_real_, sided = 1, # C_SIDED_DEFAULT informationRates = NA_real_, futilityBounds = NA_real_, typeOfDesign = c("OF", "P", "WT", "PT", "HP", "WToptimum", "asP", "asOF", "asKD", "asHSD", "asUser", "noEarlyEfficacy"), # C_DEFAULT_TYPE_OF_DESIGN, deltaWT = NA_real_, deltaPT1 = NA_real_, deltaPT0 = NA_real_, optimizationCriterion = c("ASNH1", "ASNIFH1", "ASNsum"), # C_OPTIMIZATION_CRITERION_DEFAULT gammaA = NA_real_, typeBetaSpending = c("none", "bsP", "bsOF", "bsKD", "bsHSD", "bsUser"), # C_TYPE_OF_DESIGN_BS_NONE userAlphaSpending = NA_real_, userBetaSpending = NA_real_, gammaB = NA_real_, bindingFutility = NA, constantBoundsHP = 3, # C_CONST_BOUND_HP_DEFAULT, twoSidedPower = NA, tolerance = 1e-08 # C_DESIGN_TOLERANCE_DEFAULT ) { .warnInCaseOfUnknownArguments(functionName = "getDesignInverseNormal", ...) return(.getDesignGroupSequential( designClass = C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL, kMax = kMax, alpha = alpha, beta = beta, sided = sided, informationRates = informationRates, futilityBounds = futilityBounds, typeOfDesign = typeOfDesign, deltaWT = deltaWT, deltaPT1 = deltaPT1, deltaPT0 = deltaPT0, optimizationCriterion = optimizationCriterion, gammaA = gammaA, typeBetaSpending = typeBetaSpending, userAlphaSpending = userAlphaSpending, userBetaSpending = userBetaSpending, gammaB = gammaB, bindingFutility = bindingFutility, constantBoundsHP = constantBoundsHP, twoSidedPower = twoSidedPower, tolerance = tolerance, userFunctionCallEnabled = TRUE )) } .getDesignInverseNormal <- function(..., kMax = NA_integer_, alpha = NA_real_, beta = NA_real_, sided = C_SIDED_DEFAULT, informationRates = NA_real_, futilityBounds = NA_real_, typeOfDesign = C_DEFAULT_TYPE_OF_DESIGN, deltaWT = NA_real_, deltaPT1 = NA_real_, deltaPT0 = NA_real_, optimizationCriterion = C_OPTIMIZATION_CRITERION_DEFAULT, gammaA = NA_real_, typeBetaSpending = C_TYPE_OF_DESIGN_BS_NONE, userAlphaSpending = NA_real_, userBetaSpending = NA_real_, gammaB = NA_real_, bindingFutility = NA, constantBoundsHP = C_CONST_BOUND_HP_DEFAULT, twoSidedPower = NA, tolerance = C_DESIGN_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments(functionName = "getDesignInverseNormal", ...) return(.getDesignGroupSequential( designClass = C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL, kMax = kMax, alpha = alpha, beta = beta, sided = sided, informationRates = informationRates, futilityBounds = futilityBounds, typeOfDesign = typeOfDesign, deltaWT = deltaWT, deltaPT1 = deltaPT1, deltaPT0 = deltaPT0, optimizationCriterion = optimizationCriterion, gammaA = gammaA, typeBetaSpending = typeBetaSpending, userAlphaSpending = userAlphaSpending, userBetaSpending = userBetaSpending, gammaB = gammaB, bindingFutility = bindingFutility, constantBoundsHP = constantBoundsHP, twoSidedPower = twoSidedPower, tolerance = tolerance, userFunctionCallEnabled = FALSE )) } .getDesignGroupSequentialDefaultValues <- function() { return(list( kMax = NA_integer_, alpha = NA_real_, beta = NA_real_, sided = C_SIDED_DEFAULT, informationRates = NA_real_, futilityBounds = NA_real_, typeOfDesign = C_DEFAULT_TYPE_OF_DESIGN, deltaWT = NA_real_, deltaPT1 = NA_real_, deltaPT0 = NA_real_, optimizationCriterion = C_OPTIMIZATION_CRITERION_DEFAULT, gammaA = NA_real_, typeBetaSpending = C_TYPE_OF_DESIGN_BS_NONE, userAlphaSpending = NA_real_, userBetaSpending = NA_real_, gammaB = NA_real_, twoSidedPower = C_TWO_SIDED_POWER_DEFAULT, tolerance = C_DESIGN_TOLERANCE_DEFAULT )) } .getDesignInverseNormalDefaultValues <- function() { return(.getDesignGroupSequentialDefaultValues()) } # # Param: userFunctionCallEnabled if \code{TRUE}, additional parameter validation methods will be called. # .getDesignGroupSequential <- function(..., designClass = C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL, kMax = NA_integer_, alpha = NA_real_, beta = NA_real_, sided = C_SIDED_DEFAULT, informationRates = NA_real_, futilityBounds = NA_real_, typeOfDesign = C_DEFAULT_TYPE_OF_DESIGN, deltaWT = NA_real_, deltaPT1 = NA_real_, deltaPT0 = NA_real_, optimizationCriterion = C_OPTIMIZATION_CRITERION_DEFAULT, gammaA = NA_real_, typeBetaSpending = C_TYPE_OF_DESIGN_BS_NONE, userAlphaSpending = NA_real_, userBetaSpending = NA_real_, gammaB = NA_real_, bindingFutility = C_BINDING_FUTILITY_DEFAULT, constantBoundsHP = C_CONST_BOUND_HP_DEFAULT, twoSidedPower = NA, tolerance = C_DESIGN_TOLERANCE_DEFAULT, userFunctionCallEnabled = FALSE) { typeOfDesign <- .matchArgument(typeOfDesign, C_DEFAULT_TYPE_OF_DESIGN) optimizationCriterion <- .matchArgument(optimizationCriterion, C_OPTIMIZATION_CRITERION_DEFAULT) typeBetaSpending <- .matchArgument(typeBetaSpending, C_TYPE_OF_DESIGN_BS_NONE) if (.isDefinedArgument(kMax, argumentExistsValidationEnabled = userFunctionCallEnabled)) { .assertIsValidKMax(kMax, showWarnings = TRUE) if (!is.integer(kMax)) { kMax <- as.integer(kMax) } } if (is.na(bindingFutility)) { bindingFutility <- C_BINDING_FUTILITY_DEFAULT } else if (userFunctionCallEnabled && typeOfDesign != C_TYPE_OF_DESIGN_PT && !(typeBetaSpending == "bsP" || typeBetaSpending == "bsOF" || typeBetaSpending == "bsKD" || typeBetaSpending == "bsHSD" || typeBetaSpending == "bsUser") && ((!is.na(kMax) && kMax == 1) || any(is.na(futilityBounds)) || (!any(is.na(futilityBounds)) && all(futilityBounds == C_FUTILITY_BOUNDS_DEFAULT)))) { warning("'bindingFutility' (", bindingFutility, ") will be ignored", call. = FALSE) } design <- .createDesign( designClass = designClass, kMax = kMax, alpha = alpha, beta = beta, sided = sided, informationRates = informationRates, futilityBounds = futilityBounds, typeOfDesign = typeOfDesign, deltaWT = deltaWT, deltaPT1 = deltaPT1, deltaPT0 = deltaPT0, optimizationCriterion = optimizationCriterion, gammaA = gammaA, typeBetaSpending = typeBetaSpending, userAlphaSpending = userAlphaSpending, userBetaSpending = userBetaSpending, gammaB = gammaB, bindingFutility = bindingFutility, constantBoundsHP = constantBoundsHP, twoSidedPower = twoSidedPower, tolerance = tolerance ) if (userFunctionCallEnabled) { .validateBaseParameters(design, twoSidedWarningForDefaultValues = FALSE) .validateTypeOfDesign(design) .assertIsValidTolerance(tolerance) .assertDesignParameterExists(design, "alpha", C_ALPHA_DEFAULT) .assertDesignParameterExists(design, "beta", C_BETA_DEFAULT) .assertDesignParameterExists(design, "sided", C_SIDED_DEFAULT) .assertDesignParameterExists(design, "typeOfDesign", C_DEFAULT_TYPE_OF_DESIGN) .assertDesignParameterExists(design, "bindingFutility", C_BINDING_FUTILITY_DEFAULT) .assertDesignParameterExists(design, "tolerance", C_DESIGN_TOLERANCE_DEFAULT) if (typeOfDesign != C_TYPE_OF_DESIGN_PT) { if (!is.na(deltaPT1)) { warning("'deltaPT1' (", deltaPT1, ") will be ignored", call. = FALSE) } if (!is.na(deltaPT0)) { warning("'deltaPT0' (", deltaPT0, ") will be ignored", call. = FALSE) } } if (typeOfDesign != C_TYPE_OF_DESIGN_WT && !is.na(deltaWT)) { warning("'deltaWT' (", deltaWT, ") will be ignored", call. = FALSE) } if (typeOfDesign != C_TYPE_OF_DESIGN_AS_KD && typeOfDesign != C_TYPE_OF_DESIGN_AS_HSD && !is.na(gammaA)) { warning("'gammaA' (", gammaA, ") will be ignored", call. = FALSE) } if (typeBetaSpending != C_TYPE_OF_DESIGN_BS_KD && typeBetaSpending != C_TYPE_OF_DESIGN_BS_HSD && !is.na(gammaB)) { warning("'gammaB' (", gammaB, ") will be ignored", call. = FALSE) } if (typeBetaSpending != C_TYPE_OF_DESIGN_BS_USER && !is.na(userBetaSpending)) { warning("'userBetaSpending' (", .arrayToString(userBetaSpending), ") will be ignored", call. = FALSE) } if (!(typeOfDesign %in% c(C_TYPE_OF_DESIGN_AS_USER, C_TYPE_OF_DESIGN_NO_EARLY_EFFICACY)) && !all(is.na(userAlphaSpending))) { warning("'userAlphaSpending' (", .arrayToString(userAlphaSpending), ") will be ignored", call. = FALSE) } } if (design$sided == 2 && design$bindingFutility && !design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { warning("'bindingFutility' will be ignored because the test is defined as two-sided", call. = FALSE) design$bindingFutility <- FALSE } if (design$sided == 1 && design$twoSidedPower) { warning("'twoSidedPower' will be ignored because the test is defined as one-sided", call. = FALSE) design$twoSidedPower <- FALSE } if (userFunctionCallEnabled) { .validateAlphaAndBeta(design) } design$alphaSpent <- rep(NA_real_, design$kMax) design$betaSpent <- rep(NA_real_, design$kMax) design$power <- rep(NA_real_, design$kMax) if (userFunctionCallEnabled) { design$.setParameterType("betaSpent", C_PARAM_NOT_APPLICABLE) design$.setParameterType("power", C_PARAM_NOT_APPLICABLE) design$.setParameterType("alphaSpent", C_PARAM_NOT_APPLICABLE) design$.setParameterType("criticalValues", C_PARAM_GENERATED) } if (design$kMax == 1) { .getDesignGroupSequentialKMax1(design) } else { # Wang and Tsiatis design if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT || design$typeOfDesign == C_TYPE_OF_DESIGN_P || design$typeOfDesign == C_TYPE_OF_DESIGN_OF) { .getDesignGroupSequentialWangAndTsiatis(design) } # Pampallona & Tsiatis design else if (design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { .getDesignGroupSequentialPampallonaTsiatis(design) } # Haybittle & Peto design else if (design$typeOfDesign == C_TYPE_OF_DESIGN_HP) { .getDesignGroupSequentialHaybittleAndPeto(design) } # Optimum design within Wang and Tsiatis class else if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT_OPTIMUM) { .getDesignGroupSequentialWangAndTsiatisOptimum(design) } # alpha spending approaches else if (.isAlphaSpendingDesignType(design$typeOfDesign, userDefinedAlphaSpendingIncluded = FALSE)) { .getDesignGroupSequentialAlphaSpending(design) } # user defined alpha spending approach else if (design$typeOfDesign %in% c(C_TYPE_OF_DESIGN_AS_USER, C_TYPE_OF_DESIGN_NO_EARLY_EFFICACY)) { .getDesignGroupSequentialUserDefinedAlphaSpending(design) } } design$stageLevels <- 1 - stats::pnorm(design$criticalValues) design$.setParameterType("stageLevels", C_PARAM_GENERATED) if (design$kMax == 1) { design$.setParameterType("futilityBounds", C_PARAM_NOT_APPLICABLE) } if (!all(is.na(design$futilityBounds))) { if (length(design$futilityBounds) == 0 || all(design$futilityBounds == C_FUTILITY_BOUNDS_DEFAULT)) { design$.setParameterType("bindingFutility", C_PARAM_NOT_APPLICABLE) design$.setParameterType("futilityBounds", C_PARAM_NOT_APPLICABLE) } else if (userFunctionCallEnabled && any(design$futilityBounds > design$criticalValues[1:(design$kMax - 1)] - 0.01, na.rm = TRUE)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'futilityBounds' (", .arrayToString(design$futilityBounds), ") too extreme for this situation" ) } } design$.initStages() design$criticalValues[!is.na(design$criticalValues) & design$criticalValues < -C_QNORM_THRESHOLD] <- -Inf design$criticalValues[!is.na(design$criticalValues) & design$criticalValues > C_QNORM_THRESHOLD] <- Inf return(design) } #' #' @title #' Get Design Group Sequential #' #' @description #' Provides adjusted boundaries and defines a group sequential design. #' #' @inheritParams param_kMax #' @inheritParams param_alpha #' @inheritParams param_beta #' @inheritParams param_sided #' @inheritParams param_typeOfDesign #' @inheritParams param_informationRates #' @param futilityBounds The futility bounds, defined on the test statistic z scale #' (numeric vector of length \code{kMax - 1}). #' @inheritParams param_bindingFutility #' @param deltaWT Delta for Wang & Tsiatis Delta class. #' @param deltaPT1 Delta1 for Pampallona & Tsiatis class rejecting H0 boundaries. #' @param deltaPT0 Delta0 for Pampallona & Tsiatis class rejecting H1 boundaries. #' @param constantBoundsHP The constant bounds up to stage \code{kMax - 1} for the #' Haybittle & Peto design (default is \code{3}). #' @param optimizationCriterion Optimization criterion for optimum design within #' Wang & Tsiatis class (\code{"ASNH1"}, \code{"ASNIFH1"}, #' \code{"ASNsum"}), default is \code{"ASNH1"}, see details. #' @param typeBetaSpending Type of beta spending. Type of of beta spending is one of the following: #' O'Brien & Fleming type beta spending, Pocock type beta spending, #' Kim & DeMets beta spending, Hwang, Shi & DeCani beta spending, user defined #' beta spending (\code{"bsOF"}, \code{"bsP"}, \code{"bsKD"}, #' \code{"bsHSD"}, \code{"bsUser"}, default is \code{"none"}). #' @param gammaA Parameter for alpha spending function. #' @param gammaB Parameter for beta spending function. #' @inheritParams param_userAlphaSpending #' @param userBetaSpending The user defined beta spending. Vector of length \code{kMax} containing the cumulative #' beta-spending up to each interim stage. #' @param twoSidedPower For two-sided testing, if \code{twoSidedPower = TRUE} is specified #' the sample size calculation is performed by considering both tails of the distribution. #' Default is \code{FALSE}, i.e., it is assumed that one tail probability is equal to 0 or the power #' should be directed to one part. #' @param tolerance The numerical tolerance, default is \code{1e-08}. #' @inheritParams param_three_dots #' #' @template details_group_sequential_design #' #' @template return_object_trial_design #' @template how_to_get_help_for_generics #' #' @family design functions #' #' @template examples_get_design_group_sequential #' #' @export #' getDesignGroupSequential <- function(..., kMax = NA_integer_, alpha = NA_real_, beta = NA_real_, sided = 1, # C_SIDED_DEFAULT informationRates = NA_real_, futilityBounds = NA_real_, typeOfDesign = c("OF", "P", "WT", "PT", "HP", "WToptimum", "asP", "asOF", "asKD", "asHSD", "asUser", "noEarlyEfficacy"), # C_DEFAULT_TYPE_OF_DESIGN, deltaWT = NA_real_, deltaPT1 = NA_real_, deltaPT0 = NA_real_, optimizationCriterion = c("ASNH1", "ASNIFH1", "ASNsum"), # C_OPTIMIZATION_CRITERION_DEFAULT gammaA = NA_real_, typeBetaSpending = c("none", "bsP", "bsOF", "bsKD", "bsHSD", "bsUser"), # C_TYPE_OF_DESIGN_BS_NONE userAlphaSpending = NA_real_, userBetaSpending = NA_real_, gammaB = NA_real_, bindingFutility = NA, constantBoundsHP = 3, # C_CONST_BOUND_HP_DEFAULT, twoSidedPower = NA, tolerance = 1e-08 # C_DESIGN_TOLERANCE_DEFAULT ) { .warnInCaseOfUnknownArguments(functionName = "getDesignGroupSequential", ...) return(.getDesignGroupSequential( designClass = C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL, kMax = kMax, alpha = alpha, beta = beta, sided = sided, informationRates = informationRates, futilityBounds = futilityBounds, typeOfDesign = typeOfDesign, deltaWT = deltaWT, deltaPT1 = deltaPT1, deltaPT0 = deltaPT0, optimizationCriterion = optimizationCriterion, gammaA = gammaA, typeBetaSpending = typeBetaSpending, userAlphaSpending = userAlphaSpending, userBetaSpending = userBetaSpending, gammaB = gammaB, bindingFutility = bindingFutility, constantBoundsHP = constantBoundsHP, twoSidedPower = twoSidedPower, tolerance = tolerance, userFunctionCallEnabled = TRUE )) } .getFixedSampleSize <- function(alpha, beta, sided, twoSidedPower = C_TWO_SIDED_POWER_DEFAULT) { .assertIsValidAlphaAndBeta(alpha = alpha, beta = beta) .assertIsValidSidedParameter(sided) if (sided == 1) { return((.getOneMinusQNorm(alpha) + .getOneMinusQNorm(beta))^2) } if (twoSidedPower) { n <- .getOneDimensionalRoot( function(n) { stats::pnorm(-.getOneMinusQNorm(alpha / 2) - sqrt(n)) - stats::pnorm(.getOneMinusQNorm(alpha / 2) - sqrt(n)) + beta }, lower = 0, upper = 2 * (.getOneMinusQNorm(alpha / 2) + .getOneMinusQNorm(beta))^2, tolerance = 1e-08, callingFunctionInformation = ".getFixedSampleSize" ) } else { n <- (.getOneMinusQNorm(alpha / 2) + .getOneMinusQNorm(beta))^2 } return(n) } #' @title #' Get Design Characteristics #' #' @description #' Calculates the characteristics of a design and returns it. #' #' @inheritParams param_design #' #' @details #' Calculates the inflation factor (IF), #' the expected reduction in sample size under H1, under H0, and under a value in between H0 and H1. #' Furthermore, absolute information values are calculated #' under the prototype case testing H0: mu = 0 against H1: mu = 1. #' #' @return Returns a \code{\link{TrialDesignCharacteristics}} object. #' The following generics (R generic functions) are available for this result object: #' \itemize{ #' \item \code{\link[=names.FieldSet]{names}} to obtain the field names, #' \item \code{\link[=print.FieldSet]{print}} to print the object, #' \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, #' \item \code{\link[=plot.ParameterSet]{plot}} to plot the object, #' \item \code{\link[=as.data.frame.TrialDesignCharacteristics]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, #' \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. #' } #' @template how_to_get_help_for_generics #' #' @family design functions #' #' @template examples_get_design_characteristics #' #' @export #' getDesignCharacteristics <- function(design) { return(.getDesignCharacteristics(design = design, userFunctionCallEnabled = TRUE)) } .getDesignCharacteristics <- function(..., design, userFunctionCallEnabled = FALSE) { .assertIsTrialDesignInverseNormalOrGroupSequential(design) .assertDesignParameterExists(design, "sided", C_SIDED_DEFAULT) .assertIsValidSidedParameter(design$sided) if (userFunctionCallEnabled) { .validateAlphaAndBeta(design = design) } design$informationRates <- .getValidatedInformationRates(design, writeToDesign = FALSE) if (design$typeOfDesign == C_TYPE_OF_DESIGN_PT && design$sided == 2 && design$kMax == 2) { design$futilityBounds[is.na(design$futilityBounds)] <- 0 ## otherwise .getValidatedFutilityBounds returns -6 ! } design$futilityBounds <- .getValidatedFutilityBounds(design, writeToDesign = FALSE, twoSidedWarningForDefaultValues = FALSE ) designCharacteristics <- TrialDesignCharacteristics(design = design) designCharacteristics$rejectionProbabilities <- rep(NA_real_, design$kMax) designCharacteristics$.setParameterType("rejectionProbabilities", C_PARAM_NOT_APPLICABLE) designCharacteristics$futilityProbabilities <- rep(NA_real_, design$kMax - 1) designCharacteristics$.setParameterType("futilityProbabilities", C_PARAM_NOT_APPLICABLE) nFixed <- .getFixedSampleSize( alpha = design$alpha, beta = design$beta, sided = design$sided, twoSidedPower = design$twoSidedPower ) designCharacteristics$nFixed <- nFixed designCharacteristics$.setParameterType("nFixed", C_PARAM_GENERATED) if (design$kMax == 1) { designCharacteristics$shift <- nFixed designCharacteristics$.setParameterType("shift", C_PARAM_GENERATED) designCharacteristics$inflationFactor <- designCharacteristics$shift / nFixed designCharacteristics$.setParameterType("inflationFactor", C_PARAM_GENERATED) designCharacteristics$power <- 1 - design$beta designCharacteristics$.setParameterType("power", design$.getParameterType("power")) designCharacteristics$.setParameterType("information", C_PARAM_NOT_APPLICABLE) designCharacteristics$.setParameterType("averageSampleNumber1", C_PARAM_NOT_APPLICABLE) designCharacteristics$.setParameterType("averageSampleNumber01", C_PARAM_NOT_APPLICABLE) designCharacteristics$.setParameterType("averageSampleNumber0", C_PARAM_NOT_APPLICABLE) designCharacteristics$.setParameterType(".probs", C_PARAM_NOT_APPLICABLE) return(designCharacteristics) } informationRates <- design$informationRates if (design$typeOfDesign == C_TYPE_OF_DESIGN_PT && design$sided == 2) { design$futilityBounds[is.na(design$futilityBounds)] <- 0 shift <- .getOneDimensionalRoot( function(shift) { decisionMatrix <- matrix(c( -design$criticalValues - sqrt(shift * informationRates), c(-design$futilityBounds - sqrt(shift * informationRates[1:(design$kMax - 1)]), 0), c(design$futilityBounds - sqrt(shift * informationRates[1:(design$kMax - 1)]), 0), design$criticalValues - sqrt(shift * informationRates) ), nrow = 4, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) if (design$twoSidedPower) { return(sum(probs[5, ] - probs[4, ] + probs[1, ]) - 1 + design$beta) } else { return(sum(probs[5, ] - probs[4, ]) - 1 + design$beta) } }, lower = 0, upper = 4 * (.getOneMinusQNorm(design$alpha / design$sided) + .getOneMinusQNorm(design$beta))^2, tolerance = design$tolerance, callingFunctionInformation = ".getDesignCharacteristics" ) decisionMatrix <- matrix(c( -design$criticalValues - sqrt(shift * informationRates), c(-design$futilityBounds - sqrt(shift * informationRates[1:(design$kMax - 1)]), 0), c(design$futilityBounds - sqrt(shift * informationRates[1:(design$kMax - 1)]), 0), design$criticalValues - sqrt(shift * informationRates) ), nrow = 4, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) designCharacteristics$shift <- shift designCharacteristics$.probs <- probs if (design$twoSidedPower) { designCharacteristics$power <- cumsum(probs[5, ] - probs[4, ] + probs[1, ]) designCharacteristics$rejectionProbabilities <- probs[5, ] - probs[4, ] + probs[1, ] } else { designCharacteristics$power <- cumsum(probs[5, ] - probs[4, ]) designCharacteristics$rejectionProbabilities <- probs[5, ] - probs[4, ] } if (design$kMax > 1) { designCharacteristics$futilityProbabilities <- probs[3, 1:(design$kMax - 1)] - probs[2, 1:(design$kMax - 1)] } designCharacteristics$information <- informationRates * shift designCharacteristics$averageSampleNumber1 <- .getAverageSampleNumber( design$kMax, design$informationRates, probs, shift, nFixed ) decisionMatrix <- matrix(c( -design$criticalValues, c(-design$futilityBounds, 0), c(design$futilityBounds, 0), design$criticalValues ), nrow = 4, byrow = TRUE) probs0 <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) designCharacteristics$averageSampleNumber0 <- .getAverageSampleNumber( design$kMax, design$informationRates, probs0, shift, nFixed ) decisionMatrix <- matrix(c( -design$criticalValues - sqrt(shift * informationRates) / 2, c(-design$futilityBounds - sqrt(shift * informationRates[1:(design$kMax - 1)]) / 2, 0), c(design$futilityBounds - sqrt(shift * informationRates[1:(design$kMax - 1)]) / 2, 0), design$criticalValues - sqrt(shift * informationRates) / 2 ), nrow = 4, byrow = TRUE) probs01 <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) designCharacteristics$averageSampleNumber01 <- .getAverageSampleNumber( design$kMax, design$informationRates, probs01, shift, nFixed ) design$futilityBounds[design$futilityBounds == 0] <- NA_real_ } else { shift <- .getOneDimensionalRoot( function(shift) { if (design$sided == 2) { decisionMatrix <- matrix(c( -design$criticalValues - sqrt(shift * informationRates), design$criticalValues - sqrt(shift * informationRates) ), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) if (design$twoSidedPower) { return(sum(probs[3, ] - probs[2, ] + probs[1, ]) - 1 + design$beta) } else { return(sum(probs[3, ] - probs[2, ]) - 1 + design$beta) } } else { shiftedFutilityBounds <- design$futilityBounds - sqrt(shift * informationRates[1:(design$kMax - 1)]) shiftedFutilityBounds[design$futilityBounds <= C_FUTILITY_BOUNDS_DEFAULT] <- C_FUTILITY_BOUNDS_DEFAULT decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, design$criticalValues - sqrt(shift * informationRates) ), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) return(sum(probs[3, ] - probs[2, ]) - 1 + design$beta) } }, lower = 0, upper = 4 * (.getOneMinusQNorm(design$alpha / design$sided) + .getOneMinusQNorm(design$beta))^2, tolerance = design$tolerance, callingFunctionInformation = ".getDesignCharacteristics" ) if (design$sided == 2) { decisionMatrix <- matrix(c( -design$criticalValues - sqrt(shift * informationRates), design$criticalValues - sqrt(shift * informationRates) ), nrow = 2, byrow = TRUE) } else { shiftedFutilityBounds <- design$futilityBounds - sqrt(shift * informationRates[1:(design$kMax - 1)]) shiftedFutilityBounds[design$futilityBounds <= C_FUTILITY_BOUNDS_DEFAULT] <- C_FUTILITY_BOUNDS_DEFAULT decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, design$criticalValues - sqrt(shift * informationRates) ), nrow = 2, byrow = TRUE) } probs <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) designCharacteristics$shift <- shift designCharacteristics$.probs <- probs if (design$twoSidedPower) { designCharacteristics$power <- cumsum(probs[3, ] - probs[2, ] + probs[1, ]) designCharacteristics$rejectionProbabilities <- probs[3, ] - probs[2, ] + probs[1, ] } else { designCharacteristics$power <- cumsum(probs[3, ] - probs[2, ]) designCharacteristics$rejectionProbabilities <- probs[3, ] - probs[2, ] } if (design$kMax > 1) { if (design$sided == 2) { designCharacteristics$futilityProbabilities <- rep(0, design$kMax - 1) } else { designCharacteristics$futilityProbabilities <- probs[1, 1:(design$kMax - 1)] } } designCharacteristics$information <- informationRates * shift designCharacteristics$averageSampleNumber1 <- .getAverageSampleNumber( design$kMax, design$informationRates, probs, shift, nFixed ) if (design$sided == 2) { decisionMatrix <- matrix(c(-design$criticalValues, design$criticalValues), nrow = 2, byrow = TRUE) } else { decisionMatrix <- matrix(c( design$futilityBounds, C_FUTILITY_BOUNDS_DEFAULT, design$criticalValues ), nrow = 2, byrow = TRUE) } probs0 <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) designCharacteristics$averageSampleNumber0 <- .getAverageSampleNumber( design$kMax, design$informationRates, probs0, shift, nFixed ) if (design$sided == 2) { decisionMatrix <- matrix(c( -design$criticalValues - sqrt(shift * informationRates) / 2, design$criticalValues - sqrt(shift * informationRates) / 2 ), nrow = 2, byrow = TRUE) } else { shiftedFutilityBounds <- design$futilityBounds - sqrt(shift * informationRates[1:(design$kMax - 1)]) / 2 shiftedFutilityBounds[design$futilityBounds <= C_FUTILITY_BOUNDS_DEFAULT] <- C_FUTILITY_BOUNDS_DEFAULT decisionMatrix <- matrix(c(shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, design$criticalValues - sqrt(shift * informationRates) / 2), nrow = 2, byrow = TRUE) } probs01 <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) designCharacteristics$averageSampleNumber01 <- .getAverageSampleNumber(design$kMax, design$informationRates, probs01, shift, nFixed) } designCharacteristics$.setParameterType("shift", C_PARAM_GENERATED) designCharacteristics$.setParameterType("power", C_PARAM_GENERATED) designCharacteristics$.setParameterType(".probs", C_PARAM_GENERATED) designCharacteristics$.setParameterType("rejectionProbabilities", C_PARAM_GENERATED) designCharacteristics$.setParameterType("information", C_PARAM_GENERATED) designCharacteristics$.setParameterType("futilityProbabilities", C_PARAM_GENERATED) designCharacteristics$.setParameterType("averageSampleNumber1", C_PARAM_GENERATED) designCharacteristics$.setParameterType("averageSampleNumber0", C_PARAM_GENERATED) designCharacteristics$.setParameterType("averageSampleNumber01", C_PARAM_GENERATED) designCharacteristics$inflationFactor <- shift / nFixed designCharacteristics$.setParameterType("inflationFactor", C_PARAM_GENERATED) if (is.na(designCharacteristics$inflationFactor) || (designCharacteristics$inflationFactor > 4) || (designCharacteristics$inflationFactor < 1 - 1e-08)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "Inflation factor cannot be calculated") } return(designCharacteristics) } .getAverageSampleNumber <- function(kMax, informationRates, probs, shift, nFixed) { if (nrow(probs) == 3) { return((shift - sum((probs[3, 1:(kMax - 1)] - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)]) * (informationRates[kMax] - informationRates[1:(kMax - 1)]) * shift)) / nFixed) } else { return((shift - sum((probs[5, 1:(kMax - 1)] - probs[4, 1:(kMax - 1)] + probs[3, 1:(kMax - 1)] - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)]) * (informationRates[kMax] - informationRates[1:(kMax - 1)]) * shift)) / nFixed) } } #' #' @title #' Get Power And Average Sample Number #' #' @description #' Returns the power and average sample number of the specified design. #' #' @inheritParams param_design #' @inheritParams param_theta #' @inheritParams param_nMax #' #' @details #' This function returns the power and average sample number (ASN) of the specified #' design for the prototype case which is testing H0: mu = mu0 in a one-sample design. #' \code{theta} represents the standardized effect \code{(mu - mu0) / sigma} and power and ASN #' is calculated for maximum sample size \code{nMax}. #' For other designs than the one-sample test of a mean the standardized effect needs to be adjusted accordingly. #' #' @return Returns a \code{\link{PowerAndAverageSampleNumberResult}} object. #' The following generics (R generic functions) are available for this result object: #' \itemize{ #' \item \code{\link[=names.FieldSet]{names}} to obtain the field names, #' \item \code{\link[=print.FieldSet]{print}} to print the object, #' \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, #' \item \code{\link[=plot.ParameterSet]{plot}} to plot the object, #' \item \code{\link[=as.data.frame.PowerAndAverageSampleNumberResult]{as.data.frame}} #' to coerce the object to a \code{\link[base]{data.frame}}, #' \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. #' } #' @template how_to_get_help_for_generics #' #' @family design functions #' #' @template examples_get_power_and_average_sample_number #' #' @export #' getPowerAndAverageSampleNumber <- function(design, theta = seq(-1, 1, 0.02), nMax = 100) { .assertIsTrialDesign(design) .assertIsSingleNumber(nMax, "nMax") .assertIsInClosedInterval(nMax, "nMax", lower = 1, upper = NULL) return(PowerAndAverageSampleNumberResult(design = design, theta = theta, nMax = nMax)) } rpact/R/f_simulation_multiarm_survival.R0000644000175000017500000010332614150167045020407 0ustar nileshnilesh## | ## | *Simulation of multi-arm design with time to event data* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5594 $ ## | Last changed: $Date: 2021-11-26 15:24:35 +0100 (Fr, 26 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include f_simulation_multiarm.R NULL .getSimulationSurvivalMultiArmStageEvents <- function(..., stage, directionUpper, conditionalPower, conditionalCriticalValue, plannedEvents, allocationRatioPlanned, selectedArms, thetaH1, overallEffects, minNumberOfEventsPerStage, maxNumberOfEventsPerStage) { stage <- stage - 1 # to be consistent with non-multiarm situation gMax <- nrow(overallEffects) if (!is.na(conditionalPower)) { if (any(selectedArms[1:gMax, stage + 1], na.rm = TRUE)) { if (is.na(thetaH1)) { if (directionUpper) { thetaStandardized <- log(max(min( overallEffects[selectedArms[1:gMax, stage + 1], stage], na.rm = TRUE ), 1 + 1e-07)) } else { thetaStandardized <- log(min(max( overallEffects[selectedArms[1:gMax, stage + 1], stage], na.rm = TRUE ), 1 - 1e-07)) } } else { if (directionUpper) { thetaStandardized <- log(max(thetaH1, 1 + 1e-07)) } else { thetaStandardized <- log(min(thetaH1, 1 - 1e-07)) } } if (conditionalCriticalValue[stage] > 8) { newEvents <- maxNumberOfEventsPerStage[stage + 1] } else { newEvents <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * (max(0, conditionalCriticalValue[stage] + .getQNorm(conditionalPower), na.rm = TRUE))^2 / thetaStandardized^2 newEvents <- min( max(minNumberOfEventsPerStage[stage + 1], newEvents), maxNumberOfEventsPerStage[stage + 1] ) } } else { newEvents <- 0 } } else { newEvents <- plannedEvents[stage + 1] - plannedEvents[stage] } return(newEvents) } # Correlation matrix according to Deng et al. (2019) accounting for alternative: .getCholeskyDecomposition <- function(allocationRatioPlanned, selectedArms, k, omegaVector) { selectedArmsVec <- selectedArms[, k] probabilityVector <- allocationRatioPlanned * omegaVector[selectedArmsVec] / (1 + allocationRatioPlanned * sum(omegaVector[selectedArmsVec])) armsSelected <- sum(selectedArmsVec) p0 <- 1 / (1 + allocationRatioPlanned * sum(omegaVector[selectedArmsVec])) covMatrix <- matrix(rep(1 / p0, armsSelected^2), ncol = armsSelected, nrow = armsSelected) diag(covMatrix) <- 1 / p0 + 1 / probabilityVector corrMatrix <- cov2cor(covMatrix) choleskyDecomposition <- chol(corrMatrix) return(choleskyDecomposition) } .getSimulatedStageSurvivalMultiArm <- function(..., design, directionUpper, omegaVector, plannedEvents, typeOfSelection, effectMeasure, adaptations, epsilonValue, rValue, threshold, allocationRatioPlanned, minNumberOfEventsPerStage, maxNumberOfEventsPerStage, conditionalPower, thetaH1, calcEventsFunction, calcEventsFunctionIsUserDefined, selectArmsFunction, choleskyDecompositionList, choleskyDecomposition = NULL) { kMax <- length(plannedEvents) gMax <- length(omegaVector) simSurvival <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallEffects <- matrix(NA_real_, nrow = gMax, ncol = kMax) eventsPerStage <- matrix(NA_real_, nrow = gMax, ncol = kMax) singleEventsPerStage <- matrix(NA_real_, nrow = gMax + 1, ncol = kMax) testStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallTestStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) separatePValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) conditionalCriticalValue <- rep(NA_real_, kMax - 1) conditionalPowerPerStage <- rep(NA_real_, kMax) selectedArms <- matrix(FALSE, nrow = gMax, ncol = kMax) selectedArms[, 1] <- TRUE adjustedPValues <- rep(NA_real_, kMax) if (.isTrialDesignFisher(design)) { weights <- .getWeightsFisher(design) } else if (.isTrialDesignInverseNormal(design)) { weights <- .getWeightsInverseNormal(design) } for (k in 1:kMax) { for (treatmentArm in 1:gMax) { if (selectedArms[treatmentArm, k]) { if (k == 1) { eventsPerStage[treatmentArm, k] <- plannedEvents[k] * (allocationRatioPlanned * omegaVector[treatmentArm] + 1) / (allocationRatioPlanned * sum(omegaVector) + 1) } else { eventsPerStage[treatmentArm, k] <- (plannedEvents[k] - plannedEvents[k - 1]) * (allocationRatioPlanned * omegaVector[treatmentArm] + 1) / (allocationRatioPlanned * sum(omegaVector[selectedArms[, k]]) + 1) } if (eventsPerStage[treatmentArm, k] > 0) { testStatistics[treatmentArm, k] <- stats::rnorm(1, 0, 1) } } } if (is.null(choleskyDecomposition)) { key <- paste0(selectedArms[, k], collapse = "") choleskyDecomposition <- choleskyDecompositionList[[key]] if (is.null(choleskyDecomposition)) { choleskyDecomposition <- .getCholeskyDecomposition(allocationRatioPlanned, selectedArms, k, omegaVector) choleskyDecompositionList[[key]] <- choleskyDecomposition } testStatistics[!is.na(testStatistics[, k]), k] <- t(choleskyDecomposition) %*% testStatistics[!is.na(testStatistics[, k]), k] } else { testStatistics[!is.na(testStatistics[, k]), k] <- t(choleskyDecomposition[1:sum(selectedArms[, k]), 1:sum(selectedArms[, k])]) %*% testStatistics[!is.na(testStatistics[, k]), k] } for (treatmentArm in 1:gMax) { if (selectedArms[treatmentArm, k]) { testStatistics[treatmentArm, k] <- testStatistics[treatmentArm, k] + (2 * directionUpper - 1) * log(omegaVector[treatmentArm]) * sqrt(eventsPerStage[treatmentArm, k]) * sqrt(allocationRatioPlanned) / (1 + allocationRatioPlanned) separatePValues[treatmentArm, k] <- 1 - stats::pnorm(testStatistics[treatmentArm, k]) overallTestStatistics[treatmentArm, k] <- sqrt(eventsPerStage[treatmentArm, 1:k]) %*% testStatistics[treatmentArm, 1:k] / sqrt(sum(eventsPerStage[treatmentArm, 1:k])) overallEffects[treatmentArm, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[treatmentArm, k] * (1 + allocationRatioPlanned) / sqrt(allocationRatioPlanned) / sqrt(sum(eventsPerStage[treatmentArm, 1:k]))) } } if (k < kMax) { if (colSums(selectedArms)[k] == 0) { break } # Bonferroni adjustment adjustedPValues[k] <- min(min(separatePValues[, k], na.rm = TRUE) * (colSums(selectedArms)[k]), 1 - 1e-7) # conditional critical value to reject the null hypotheses at the next stage of the trial if (.isTrialDesignConditionalDunnett(design)) { conditionalCriticalValue[k] <- (.getOneMinusQNorm(design$alpha) - .getOneMinusQNorm(adjustedPValues[k]) * sqrt(design$informationAtInterim)) / sqrt(1 - design$informationAtInterim) } else { if (.isTrialDesignFisher(design)) { conditionalCriticalValue[k] <- .getOneMinusQNorm(min((design$criticalValues[k + 1] / prod(adjustedPValues[1:k]^weights[1:k]))^(1 / weights[k + 1]), 1 - 1e-7)) } else { conditionalCriticalValue[k] <- (design$criticalValues[k + 1] * sqrt(design$informationRates[k + 1]) - .getOneMinusQNorm(adjustedPValues[1:k]) %*% weights[1:k]) / sqrt(design$informationRates[k + 1] - design$informationRates[k]) } } if (adaptations[k]) { if (effectMeasure == "testStatistic") { selectedArms[, k + 1] <- (selectedArms[, k] & .selectTreatmentArms(k, overallTestStatistics[, k], typeOfSelection, epsilonValue, rValue, threshold, selectArmsFunction, survival = TRUE )) } else if (effectMeasure == "effectEstimate") { if (directionUpper) { selectedArms[, k + 1] <- (selectedArms[, k] & .selectTreatmentArms(k, overallEffects[, k], typeOfSelection, epsilonValue, rValue, threshold, selectArmsFunction, survival = TRUE )) } else { selectedArms[, k + 1] <- (selectedArms[, k] & .selectTreatmentArms(k, 1 / overallEffects[, k], typeOfSelection, epsilonValue, rValue, 1 / threshold, selectArmsFunction, survival = TRUE )) } } newEvents <- calcEventsFunction( stage = k + 1, # to be consistent with non-multiarm situation, cf. line 38 directionUpper = directionUpper, conditionalPower = conditionalPower, conditionalCriticalValue = conditionalCriticalValue, plannedEvents = plannedEvents, allocationRatioPlanned = allocationRatioPlanned, selectedArms = selectedArms, thetaH1 = thetaH1, overallEffects = overallEffects, minNumberOfEventsPerStage = minNumberOfEventsPerStage, maxNumberOfEventsPerStage = maxNumberOfEventsPerStage ) if (is.null(newEvents) || length(newEvents) != 1 || !is.numeric(newEvents) || is.na(newEvents)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'calcEventsFunction' returned an illegal or undefined result (", newEvents, "); ", "the output must be a single numeric value" ) } if (!is.na(conditionalPower) || calcEventsFunctionIsUserDefined) { plannedEvents[(k + 1):kMax] <- plannedEvents[k] + cumsum(rep(newEvents, kMax - k)) } } else { selectedArms[, k + 1] <- selectedArms[, k] } if (is.na(thetaH1)) { thetaStandardized <- log(min(overallEffects[selectedArms[1:gMax, k], k], na.rm = TRUE)) } else { thetaStandardized <- log(thetaH1) } thetaStandardized <- (2 * directionUpper - 1) * thetaStandardized conditionalPowerPerStage[k] <- 1 - stats::pnorm(conditionalCriticalValue[k] - thetaStandardized * sqrt(plannedEvents[k + 1] - plannedEvents[k]) * sqrt(allocationRatioPlanned) / (1 + allocationRatioPlanned)) } } return(list( eventsPerStage = eventsPerStage, plannedEvents = plannedEvents, allocationRatioPlanned = allocationRatioPlanned, overallEffects = overallEffects, testStatistics = testStatistics, overallTestStatistics = overallTestStatistics, separatePValues = separatePValues, conditionalCriticalValue = conditionalCriticalValue, conditionalPowerPerStage = conditionalPowerPerStage, selectedArms = selectedArms, choleskyDecompositionList = choleskyDecompositionList )) } #' #' @title #' Get Simulation Multi-Arm Survival #' #' @description #' Returns the simulated power, stopping and selection probabilities, conditional power, and #' expected sample size for testing hazard ratios in a multi-arm treatment groups testing situation. #' In contrast to \code{getSimulationSurvival()} (where survival times are simulated), normally #' distributed logrank test statistics are simulated. #' #' @param omegaMaxVector Range of hazard ratios with highest response for \code{"linear"} and #' \code{"sigmoidEmax"} model, default is \code{seq(1, 2.6, 0.4)}. #' @inheritParams param_intersectionTest_MultiArm #' @inheritParams param_typeOfSelection #' @inheritParams param_effectMeasure #' @inheritParams param_adaptations #' @inheritParams param_threshold #' @inheritParams param_effectMatrix #' @inheritParams param_activeArms #' @inheritParams param_successCriterion #' @param correlationComputation If \code{correlationComputation = "alternative"}, #' for simulating log-rank statistics in the many-to-one design, a correlation #' matrix according to Deng et al. (Biometrics, 2019) accounting for the #' respective alternative is used; #' if \code{correlationComputation = "null"}, a constant correlation matrix valid #' under the null, i.e., not accounting for the alternative is used, #' default is \code{"alternative"}. #' @inheritParams param_typeOfShape #' @inheritParams param_typeOfSelection #' @inheritParams param_design_with_default #' @inheritParams param_directionUpper #' @inheritParams param_allocationRatioPlanned #' @inheritParams param_minNumberOfEventsPerStage #' @inheritParams param_maxNumberOfEventsPerStage #' @inheritParams param_conditionalPowerSimulation #' @inheritParams param_thetaH1 #' @inheritParams param_plannedEvents #' @inheritParams param_maxNumberOfIterations #' @inheritParams param_calcEventsFunction #' @inheritParams param_selectArmsFunction #' @inheritParams param_rValue #' @inheritParams param_epsilonValue #' @inheritParams param_gED50 #' @inheritParams param_slope #' @inheritParams param_seed #' @inheritParams param_three_dots #' @inheritParams param_showStatistics #' #' @details #' At given design the function simulates the power, stopping probabilities, #' selection probabilities, and expected sample size at given number of subjects, #' parameter configuration, and treatment arm selection rule in the multi-arm situation. #' An allocation ratio can be specified referring to the ratio of number of subjects #' in the active treatment groups as compared to the control group. #' #' The definition of \code{thetaH1} makes only sense if \code{kMax} > 1 #' and if \code{conditionalPower}, \code{minNumberOfEventsPerStage}, and #' \code{maxNumberOfEventsPerStage} (or \code{calcEventsFunction}) are defined. #' #' \code{calcEventsFunction}\cr #' This function returns the number of events at given conditional power #' and conditional critical value for specified testing situation. #' The function might depend on the variables #' \code{stage}, #' \code{selectedArms}, #' \code{plannedEvents}, #' \code{directionUpper}, #' \code{allocationRatioPlanned}, #' \code{minNumberOfEventsPerStage}, #' \code{maxNumberOfEventsPerStage}, #' \code{conditionalPower}, #' \code{conditionalCriticalValue}, and #' \code{overallEffects}. #' The function has to contain the three-dots argument '...' (see examples). #' #' @template return_object_simulation_results #' @template how_to_get_help_for_generics #' #' @template examples_get_simulation_multiarm_survival #' #' @export #' getSimulationMultiArmSurvival <- function(design = NULL, ..., activeArms = 3L, # C_ACTIVE_ARMS_DEFAULT effectMatrix = NULL, typeOfShape = c("linear", "sigmoidEmax", "userDefined"), # C_TYPE_OF_SHAPE_DEFAULT omegaMaxVector = seq(1, 2.6, 0.4), # C_RANGE_OF_HAZARD_RATIOS_DEFAULT gED50 = NA_real_, slope = 1, intersectionTest = c("Dunnett", "Bonferroni", "Simes", "Sidak", "Hierarchical"), # C_INTERSECTION_TEST_MULTIARMED_DEFAULT directionUpper = TRUE, # C_DIRECTION_UPPER_DEFAULT adaptations = NA, typeOfSelection = c("best", "rBest", "epsilon", "all", "userDefined"), # C_TYPE_OF_SELECTION_DEFAULT effectMeasure = c("effectEstimate", "testStatistic"), # C_EFFECT_MEASURE_DEFAULT successCriterion = c("all", "atLeastOne"), # C_SUCCESS_CRITERION_DEFAULT correlationComputation = c("alternative", "null"), epsilonValue = NA_real_, rValue = NA_real_, threshold = -Inf, plannedEvents = NA_real_, allocationRatioPlanned = NA_real_, minNumberOfEventsPerStage = NA_real_, maxNumberOfEventsPerStage = NA_real_, conditionalPower = NA_real_, thetaH1 = NA_real_, maxNumberOfIterations = 1000L, # C_MAX_SIMULATION_ITERATIONS_DEFAULT seed = NA_real_, calcEventsFunction = NULL, selectArmsFunction = NULL, showStatistics = FALSE) { if (is.null(design)) { design <- .getDefaultDesign(..., type = "simulation") .warnInCaseOfUnknownArguments( functionName = "getSimulationMultiArmSurvival", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE ), "showStatistics"), ... ) } else { .assertIsTrialDesignInverseNormalOrFisherOrConditionalDunnett(design) .warnInCaseOfUnknownArguments(functionName = "getSimulationMultiArmSurvival", ignore = "showStatistics", ...) .warnInCaseOfTwoSidedPowerArgument(...) } .assertIsOneSidedDesign(design, designType = "multi-arm", engineType = "simulation") correlationComputation <- match.arg(correlationComputation) calcEventsFunctionIsUserDefined <- !is.null(calcEventsFunction) simulationResults <- .createSimulationResultsMultiArmObject( design = design, activeArms = activeArms, effectMatrix = effectMatrix, typeOfShape = typeOfShape, omegaMaxVector = omegaMaxVector, # survival only gED50 = gED50, slope = slope, intersectionTest = intersectionTest, directionUpper = directionUpper, # rates + survival only adaptations = adaptations, typeOfSelection = typeOfSelection, effectMeasure = effectMeasure, successCriterion = successCriterion, epsilonValue = epsilonValue, rValue = rValue, threshold = threshold, plannedEvents = plannedEvents, # survival only allocationRatioPlanned = allocationRatioPlanned, minNumberOfEventsPerStage = minNumberOfEventsPerStage, # survival only maxNumberOfEventsPerStage = maxNumberOfEventsPerStage, # survival only conditionalPower = conditionalPower, thetaH1 = thetaH1, # means + survival only maxNumberOfIterations = maxNumberOfIterations, seed = seed, calcEventsFunction = calcEventsFunction, # survival only selectArmsFunction = selectArmsFunction, showStatistics = showStatistics, endpoint = "survival" ) design <- simulationResults$.design successCriterion <- simulationResults$successCriterion effectMeasure <- simulationResults$effectMeasure adaptations <- simulationResults$adaptations gMax <- activeArms kMax <- simulationResults$.design$kMax intersectionTest <- simulationResults$intersectionTest typeOfSelection <- simulationResults$typeOfSelection effectMatrix <- t(simulationResults$effectMatrix) omegaMaxVector <- simulationResults$omegaMaxVector # survival only thetaH1 <- simulationResults$thetaH1 # means + survival only plannedEvents <- simulationResults$plannedEvents # survival only conditionalPower <- simulationResults$conditionalPower minNumberOfEventsPerStage <- simulationResults$minNumberOfEventsPerStage # survival only maxNumberOfEventsPerStage <- simulationResults$maxNumberOfEventsPerStage # survival only allocationRatioPlanned <- simulationResults$allocationRatioPlanned calcEventsFunction <- simulationResults$calcEventsFunction simulationResults$correlationComputation <- correlationComputation if (correlationComputation != "alternative") { simulationResults$.setParameterType("correlationComputation", C_PARAM_USER_DEFINED) } indices <- .getIndicesOfClosedHypothesesSystemForSimulation(gMax = gMax) if (.isTrialDesignConditionalDunnett(design)) { criticalValuesDunnett <- .getCriticalValuesDunnettForSimulation( alpha = design$alpha, indices = indices, allocationRatioPlanned = allocationRatioPlanned ) } cols <- length(omegaMaxVector) simulatedSelections <- array(0, dim = c(kMax, cols, gMax)) simulatedRejections <- array(0, dim = c(kMax, cols, gMax)) simulatedNumberOfActiveArms <- matrix(0, nrow = kMax, ncol = cols) simulatedSingleEventsPerStage <- array(0, dim = c(kMax, cols, gMax + 1)) simulatedOverallEventsPerStage <- matrix(0, nrow = kMax, ncol = cols) simulatedSuccessStopping <- matrix(0, nrow = kMax, ncol = cols) simulatedFutilityStopping <- matrix(0, nrow = kMax - 1, ncol = cols) simulatedConditionalPower <- matrix(0, nrow = kMax, ncol = cols) simulatedRejectAtLeastOne <- rep(0, cols) expectedNumberOfEvents <- rep(0, cols) iterations <- matrix(0, nrow = kMax, ncol = cols) probabilityVector <- rep(NA_real_, cols) len <- maxNumberOfIterations * kMax * gMax * cols dataIterationNumber <- rep(NA_real_, len) dataStageNumber <- rep(NA_real_, len) dataArmNumber <- rep(NA_real_, len) dataAlternative <- rep(NA_real_, len) dataEffect <- rep(NA_real_, len) dataNumberOfEvents <- rep(NA_real_, len) dataRejectPerStage <- rep(NA, len) dataFutilityStop <- rep(NA_real_, len) dataSuccessStop <- rep(NA, len) dataFutilityStop <- rep(NA, len) dataTestStatistics <- rep(NA_real_, len) dataConditionalCriticalValue <- rep(NA_real_, len) dataConditionalPowerAchieved <- rep(NA_real_, len) dataEffectEstimate <- rep(NA_real_, len) dataPValuesSeparate <- rep(NA_real_, len) choleskyDecomposition <- NULL if (correlationComputation == "null") { # Not accounting for alternative corrMatrix <- matrix(rep(allocationRatioPlanned / (1 + allocationRatioPlanned), gMax^2), ncol = gMax, nrow = gMax) diag(corrMatrix) <- 1 choleskyDecomposition <- chol(corrMatrix) } index <- 1 for (i in 1:cols) { choleskyDecompositionList <- list() for (j in 1:maxNumberOfIterations) { stageResults <- .getSimulatedStageSurvivalMultiArm( design = design, directionUpper = directionUpper, omegaVector = effectMatrix[i, ], plannedEvents = plannedEvents, typeOfSelection = typeOfSelection, effectMeasure = effectMeasure, adaptations = adaptations, epsilonValue = epsilonValue, rValue = rValue, threshold = threshold, allocationRatioPlanned = allocationRatioPlanned, minNumberOfEventsPerStage = minNumberOfEventsPerStage, maxNumberOfEventsPerStage = maxNumberOfEventsPerStage, conditionalPower = conditionalPower, thetaH1 = thetaH1, calcEventsFunction = calcEventsFunction, calcEventsFunctionIsUserDefined = calcEventsFunctionIsUserDefined, selectArmsFunction = selectArmsFunction, choleskyDecompositionList = choleskyDecompositionList, choleskyDecomposition = choleskyDecomposition ) choleskyDecompositionList <- stageResults$choleskyDecompositionList if (.isTrialDesignConditionalDunnett(design)) { closedTest <- .performClosedConditionalDunnettTestForSimulation( stageResults = stageResults, design = design, indices = indices, criticalValuesDunnett = criticalValuesDunnett, successCriterion = successCriterion ) } else { closedTest <- .performClosedCombinationTestForSimulationMultiArm( stageResults = stageResults, design = design, indices = indices, intersectionTest = intersectionTest, successCriterion = successCriterion ) } rejectAtSomeStage <- FALSE rejectedArmsBefore <- rep(FALSE, gMax) for (k in 1:kMax) { simulatedRejections[k, i, ] <- simulatedRejections[k, i, ] + (closedTest$rejected[, k] & closedTest$selectedArms[1:gMax, k] | rejectedArmsBefore) simulatedSelections[k, i, ] <- simulatedSelections[k, i, ] + closedTest$selectedArms[, k] simulatedNumberOfActiveArms[k, i] <- simulatedNumberOfActiveArms[k, i] + sum(closedTest$selectedArms[, k]) if (!any(is.na(closedTest$successStop))) { simulatedSuccessStopping[k, i] <- simulatedSuccessStopping[k, i] + closedTest$successStop[k] } if ((kMax > 1) && (k < kMax)) { if (!any(is.na(closedTest$futilityStop))) { simulatedFutilityStopping[k, i] <- simulatedFutilityStopping[k, i] + (closedTest$futilityStop[k] && !closedTest$successStop[k]) } if (!closedTest$successStop[k] && !closedTest$futilityStop[k]) { simulatedConditionalPower[k + 1, i] <- simulatedConditionalPower[k + 1, i] + stageResults$conditionalPowerPerStage[k] } } iterations[k, i] <- iterations[k, i] + 1 if (k == 1) { simulatedOverallEventsPerStage[k, i] <- simulatedOverallEventsPerStage[k, i] + stageResults$plannedEvents[k] } else { simulatedOverallEventsPerStage[k, i] <- simulatedOverallEventsPerStage[k, i] + stageResults$plannedEvents[k] - stageResults$plannedEvents[k - 1] } for (g in 1:gMax) { dataIterationNumber[index] <- j dataStageNumber[index] <- k dataArmNumber[index] <- g dataAlternative[index] <- omegaMaxVector[i] dataEffect[index] <- effectMatrix[i, g] dataNumberOfEvents[index] <- round(stageResults$eventsPerStage[g, k], 1) dataRejectPerStage[index] <- closedTest$rejected[g, k] dataTestStatistics[index] <- stageResults$testStatistics[g, k] dataSuccessStop[index] <- closedTest$successStop[k] if (k < kMax) { dataFutilityStop[index] <- closedTest$futilityStop[k] dataConditionalCriticalValue[index] <- stageResults$conditionalCriticalValue[k] dataConditionalPowerAchieved[index + 1] <- stageResults$conditionalPowerPerStage[k] } dataEffectEstimate[index] <- stageResults$overallEffects[g, k] dataPValuesSeparate[index] <- closedTest$separatePValues[g, k] index <- index + 1 } if (!rejectAtSomeStage && any(closedTest$rejected[, k] & closedTest$selectedArms[1:gMax, k] | rejectedArmsBefore)) { simulatedRejectAtLeastOne[i] <- simulatedRejectAtLeastOne[i] + 1 rejectAtSomeStage <- TRUE } if ((k < kMax) && (closedTest$successStop[k] || closedTest$futilityStop[k])) { # rejected hypotheses remain rejected also in case of early stopping simulatedRejections[(k + 1):kMax, i, ] <- simulatedRejections[(k + 1):kMax, i, ] + matrix((closedTest$rejected[, k] & closedTest$selectedArms[1:gMax, k] | rejectedArmsBefore), kMax - k, gMax, byrow = TRUE ) break } rejectedArmsBefore <- closedTest$rejected[, k] & closedTest$selectedArms[1:gMax, k] | rejectedArmsBefore } } simulatedOverallEventsPerStage[, i] <- simulatedOverallEventsPerStage[, i] / iterations[, i] for (g in 1:gMax) { simulatedSingleEventsPerStage[, i, g] <- simulatedOverallEventsPerStage[, i] * allocationRatioPlanned * effectMatrix[i, g] / (1 + allocationRatioPlanned * sum(effectMatrix[i, ])) } simulatedSingleEventsPerStage[, i, gMax + 1] <- simulatedOverallEventsPerStage[, i] / (1 + allocationRatioPlanned * sum(effectMatrix[i, ])) if (kMax > 1) { simulatedRejections[2:kMax, i, ] <- simulatedRejections[2:kMax, i, ] - simulatedRejections[1:(kMax - 1), i, ] stopping <- cumsum(simulatedSuccessStopping[1:(kMax - 1), i] + simulatedFutilityStopping[, i]) / maxNumberOfIterations expectedNumberOfEvents[i] <- simulatedOverallEventsPerStage[1, i] + t(1 - stopping) %*% simulatedOverallEventsPerStage[2:kMax, i] } else { expectedNumberOfEvents[i] <- simulatedOverallEventsPerStage[1, i] } } simulatedConditionalPower[1, ] <- NA_real_ if (kMax > 1) { simulatedConditionalPower[2:kMax, ] <- simulatedConditionalPower[2:kMax, ] / iterations[2:kMax, ] } simulationResults$rejectAtLeastOne <- simulatedRejectAtLeastOne / maxNumberOfIterations simulationResults$numberOfActiveArms <- simulatedNumberOfActiveArms / iterations simulationResults$selectedArms <- simulatedSelections / maxNumberOfIterations simulationResults$rejectedArmsPerStage <- simulatedRejections / maxNumberOfIterations simulationResults$successPerStage <- simulatedSuccessStopping / maxNumberOfIterations simulationResults$futilityPerStage <- simulatedFutilityStopping / maxNumberOfIterations simulationResults$futilityStop <- base::colSums(simulatedFutilityStopping / maxNumberOfIterations) if (kMax > 1) { simulationResults$earlyStop <- simulationResults$futilityPerStage + simulationResults$successPerStage[1:(kMax - 1), ] simulationResults$conditionalPowerAchieved <- simulatedConditionalPower } simulationResults$eventsPerStage <- .convertStageWiseToOverallValues(simulatedSingleEventsPerStage) for (g in (1:gMax)) { simulationResults$eventsPerStage[, , g] <- simulationResults$eventsPerStage[, , g] + simulationResults$eventsPerStage[, , gMax + 1] } simulationResults$eventsPerStage <- .removeLastEntryFromArray(simulationResults$eventsPerStage) simulationResults$singleNumberOfEventsPerStage <- simulatedSingleEventsPerStage simulationResults$.setParameterType("singleNumberOfEventsPerStage", C_PARAM_GENERATED) simulationResults$expectedNumberOfEvents <- expectedNumberOfEvents simulationResults$iterations <- iterations if (!all(is.na(simulationResults$conditionalPowerAchieved))) { simulationResults$.setParameterType("conditionalPowerAchieved", C_PARAM_GENERATED) } if (any(simulationResults$rejectedArmsPerStage < 0)) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "internal error, simulation not possible due to numerical overflow" ) } data <- data.frame( iterationNumber = dataIterationNumber, stageNumber = dataStageNumber, armNumber = dataArmNumber, omegaMax = dataAlternative, effect = dataEffect, numberOfEvents = dataNumberOfEvents, effectEstimate = dataEffectEstimate, testStatistics = dataTestStatistics, pValue = dataPValuesSeparate, conditionalCriticalValue = round(dataConditionalCriticalValue, 6), conditionalPowerAchieved = round(dataConditionalPowerAchieved, 6), rejectPerStage = dataRejectPerStage, successStop = dataSuccessStop, futilityPerStage = dataFutilityStop ) data <- data[!is.na(data$effectEstimate), ] simulationResults$.data <- data return(simulationResults) } rpact/R/class_design_power_and_asn.R0000644000175000017500000002573714145656364017432 0ustar nileshnilesh## | ## | *Power and average sample number result classes* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' #' @name PowerAndAverageSampleNumberResult #' #' @title #' Power and Average Sample Number Result #' #' @description #' Class for power and average sample number (ASN) results. #' #' @details #' This object cannot be created directly; use \code{getPowerAndAverageSampleNumber} #' with suitable arguments to create it. #' #' @include class_core_parameter_set.R #' @include class_design.R #' #' @keywords internal #' #' @importFrom methods new #' PowerAndAverageSampleNumberResult <- setRefClass("PowerAndAverageSampleNumberResult", contains = "ParameterSet", fields = list( .design = "TrialDesign", nMax = "numeric", theta = "numeric", averageSampleNumber = "numeric", calculatedPower = "numeric", overallEarlyStop = "numeric", earlyStop = "matrix", overallReject = "numeric", rejectPerStage = "matrix", overallFutility = "numeric", futilityPerStage = "matrix" ), methods = list( initialize = function(design, theta = seq(-1, 1, 0.05), nMax = 100L, ...) { callSuper(.design = design, theta = theta, nMax = nMax, ...) theta <<- .assertIsValidThetaRange(thetaRange = theta, thetaAutoSeqEnabled = FALSE) .initPowerAndAverageSampleNumber() .parameterNames <<- .getParameterNames(design = design) .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS }, clone = function() { return(PowerAndAverageSampleNumberResult(design = .self$.design, theta = .self$theta, nMax = .self$nMax)) }, show = function(showType = 1, digits = NA_integer_) { .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { 'Method for automatically printing a power and average sample size (ASN) result' .resetCat() if (showType == 2) { callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { .cat("Power and average sample size (ASN):\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getGeneratedParameters(), "Output", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) if (.design$kMax > 1) { .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) if (.design$kMax > 1) { .cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) } .cat("\n", consoleOutputEnabled = consoleOutputEnabled) } } }, .toString = function(startWithUpperCase = FALSE) { s <- "power and average sample size (ASN)" return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) }, .initPowerAndAverageSampleNumber = function() { .assertIsTrialDesignInverseNormalOrGroupSequential(.design) .assertIsValidSidedParameter(.design$sided) if (nMax <= 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'nMax' must be an integer > 0") } .setParameterType("nMax", ifelse(nMax == C_NA_MAX_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) thetaIsDefault <- length(theta) == length(C_POWER_ASN_THETA_DEFAULT) && sum(theta == C_POWER_ASN_THETA_DEFAULT) == length(theta) .setParameterType("theta", ifelse(thetaIsDefault, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) kMax <- .design$kMax # initialization numberOfThetas <- length(theta) averageSampleNumber <<- rep(NA_real_, numberOfThetas) .setParameterType("averageSampleNumber", C_PARAM_GENERATED) calculatedPower <<- rep(NA_real_, numberOfThetas) .setParameterType("calculatedPower", C_PARAM_GENERATED) earlyStop <<- matrix(NA_real_, kMax, numberOfThetas) .setParameterType("earlyStop", C_PARAM_GENERATED) rejectPerStage <<- matrix(NA_real_, kMax, numberOfThetas) .setParameterType("rejectPerStage", C_PARAM_GENERATED) futilityPerStage <<- matrix(NA_real_, kMax - 1, numberOfThetas) .setParameterType("futilityPerStage", C_PARAM_GENERATED) rowNames <- paste("stage =", c(1:kMax)) rownames(earlyStop) <<- rowNames rownames(rejectPerStage) <<- rowNames if (kMax > 1) { rownames(futilityPerStage) <<- rowNames[1:(kMax - 1)] } for (i in 1:numberOfThetas) { result <- .getPowerAndAverageSampleNumber(theta = theta[i]) averageSampleNumber[i] <<- result$averageSampleNumber calculatedPower[i] <<- result$calculatedPower earlyStop[1:(kMax - 1), i] <<- result$earlyStop[1:(kMax - 1)] rejectPerStage[, i] <<- result$rejectPerStage[1:kMax] futilityPerStage[, i] <<- result$futilityPerStage[1:(kMax - 1)] } overallEarlyStop <<- .getOverallParameter(earlyStop) .setParameterType("overallEarlyStop", C_PARAM_GENERATED) overallReject <<- .getOverallParameter(rejectPerStage) .setParameterType("overallReject", C_PARAM_GENERATED) overallFutility <<- .getOverallParameter(futilityPerStage) .setParameterType("overallFutility", C_PARAM_GENERATED) }, .getPowerAndAverageSampleNumber = function(theta) { kMax <- .design$kMax futilityBounds <- .design$futilityBounds informationRates <- .design$informationRates criticalValues <- .design$criticalValues sided <- .design$sided if (sided == 2) { if (.design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { futilityBounds[is.na(futilityBounds)] <- 0 decisionMatrix <- matrix(c(-criticalValues - theta * sqrt(nMax * informationRates), c(-futilityBounds - theta * sqrt(nMax * informationRates[1:(kMax - 1)]), 0), c(futilityBounds - theta * sqrt(nMax * informationRates[1:(kMax - 1)]), 0), criticalValues - theta * sqrt(nMax * informationRates)), nrow = 4, byrow = TRUE) } else { decisionMatrix <- matrix(c(-criticalValues - theta * sqrt(nMax * informationRates), criticalValues - theta * sqrt(nMax * informationRates)), nrow = 2, byrow = TRUE) } } else { shiftedFutilityBounds <- futilityBounds - theta * sqrt(nMax * informationRates[1:(kMax - 1)]) shiftedFutilityBounds[futilityBounds <= C_FUTILITY_BOUNDS_DEFAULT] <- C_FUTILITY_BOUNDS_DEFAULT decisionMatrix <- matrix(c(shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, criticalValues - theta * sqrt(nMax * informationRates)), nrow = 2, byrow = TRUE) } probs <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) if (nrow(probs) == 3) { .averageSampleNumber <- nMax - sum((probs[3, 1:(kMax - 1)] - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)]) * (informationRates[kMax] - informationRates[1:(kMax - 1)]) * nMax) } else { .averageSampleNumber <- nMax - sum((probs[5, 1:(kMax - 1)] - probs[4, 1:(kMax - 1)] + probs[3, 1:(kMax - 1)] - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)]) * (informationRates[kMax] - informationRates[1:(kMax - 1)]) * nMax) } .futilityPerStage <- rep(NA_real_, kMax) if (sided == 2) { if (nrow(probs) == 3) { .calculatedPower <- sum(probs[3, 1:kMax] - probs[2, 1:kMax] + probs[1, 1:kMax]) .rejectPerStage <- probs[3, 1:kMax] - probs[2, 1:kMax] + probs[1, 1:kMax] } else { .calculatedPower <- sum(probs[5, 1:kMax] - probs[4, 1:kMax] + probs[1, 1:kMax]) .rejectPerStage <- probs[5, 1:kMax] - probs[4, 1:kMax] + probs[1, 1:kMax] if (kMax > 1) { .futilityPerStage <- probs[3, 1:kMax] - probs[2, 1:kMax] } } } else { .calculatedPower <- sum(probs[3, 1:kMax] - probs[2, 1:kMax]) .rejectPerStage <- probs[3, 1:kMax] - probs[2, 1:kMax] if (kMax > 1) { .futilityPerStage <- probs[1, 1:(kMax - 1)] } } .earlyStop <- rep(NA_real_, kMax) if (kMax > 1) { if (nrow(probs) == 3) { .earlyStop <- probs[3, 1:(kMax - 1)] - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)] } else { .earlyStop <- probs[5, 1:(kMax - 1)] - probs[4, 1:(kMax - 1)] + probs[3, 1:(kMax - 1)] - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)] } } return(list( averageSampleNumber = .averageSampleNumber, calculatedPower = .calculatedPower, earlyStop = .earlyStop, rejectPerStage = .rejectPerStage, futilityPerStage = .futilityPerStage )) }, .getOverallParameter = function(parameter) { if (is.null(parameter) || length(parameter) == 0) { return(rep(NA_real_, length(theta))) } overallParameter <- parameter overallParameter[is.na(overallParameter)] <- 0 overallParameter <- colSums(overallParameter) return(overallParameter) } ) ) #' #' @name PowerAndAverageSampleNumberResult_as.data.frame #' #' @title #' Coerce Power And Average Sample Number Result to a Data Frame #' #' @description #' Returns the \code{\link{PowerAndAverageSampleNumberResult}} as data frame. #' #' @param x A \code{\link{PowerAndAverageSampleNumberResult}} object. #' @inheritParams param_niceColumnNamesEnabled #' @inheritParams param_includeAllParameters #' @inheritParams param_three_dots #' #' @details #' Coerces the \code{\link{PowerAndAverageSampleNumberResult}} object to a data frame. #' #' @template return_dataframe #' #' @examples #' data <- as.data.frame(getPowerAndAverageSampleNumber(getDesignGroupSequential())) #' head(data) #' dim(data) #' #' @export #' #' @keywords internal #' as.data.frame.PowerAndAverageSampleNumberResult <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { parameterNames <- x$.getVisibleFieldNames() parameterNames <- parameterNames[parameterNames != "nMax"] dataFrame <- x$.getAsDataFrame(parameterNames = parameterNames, niceColumnNamesEnabled = niceColumnNamesEnabled, includeAllParameters = includeAllParameters, tableColumnNames = .getTableColumnNames(design = x$.design)) return(dataFrame) } rpact/R/f_core_constants.R0000644000175000017500000014053214154651323015403 0ustar nileshnilesh## | ## | *Constants* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5644 $ ## | Last changed: $Date: 2021-12-10 14:14:55 +0100 (Fr, 10 Dez 2021) $ ## | Last changed by: $Author: pahlke $ ## | C_LOG_LEVEL_TRACE <- "TRACE" C_LOG_LEVEL_DEBUG <- "DEBUG" C_LOG_LEVEL_INFO <- "INFO" C_LOG_LEVEL_WARN <- "WARN" C_LOG_LEVEL_ERROR <- "ERROR" C_LOG_LEVEL_PROGRESS <- "PROGRESS" C_LOG_LEVEL_DISABLED <- "DISABLED" C_SUMMARY_OUTPUT_SIZE_DEFAULT <- "large" C_SUMMARY_LIST_ITEM_PREFIX_DEFAULT = " " # used in 'class_core_plot_settings.R' C_POSITION_OUTSIDE_PLOT <- 0 C_POSITION_LEFT_TOP <- 1 C_POSITION_LEFT_CENTER <- 2 C_POSITION_LEFT_BOTTOM <- 3 C_POSITION_RIGHT_TOP <- 4 C_POSITION_RIGHT_CENTER <- 5 C_POSITION_RIGHT_BOTTOM <- 6 C_DESIGN_TOLERANCE_DEFAULT <- 1e-08 C_CONST_NEWTON_COTES <- 15 C_TWO_SIDED_POWER_DEFAULT <- FALSE C_BINDING_FUTILITY_DEFAULT <- FALSE C_BINDING_FUTILITY_FISHER_DEFAULT <- TRUE C_CONST_BOUND_HP_DEFAULT <- 3 C_ALPHA_DEFAULT <- 0.025 C_BETA_DEFAULT <- 0.2 C_SIDED_DEFAULT <- 1L C_KMAX_DEFAULT <- 3L C_KMAX_UPPER_BOUND <- 20L C_KMAX_UPPER_BOUND_FISHER <- 6L C_NA_MAX_DEFAULT <- 100L C_POWER_ASN_THETA_DEFAULT <- seq(-1, 1, 0.02) C_ANALYSIS_TOLERANCE_DEFAULT <- 1e-06 C_ANALYSIS_TOLERANCE_FISHER_DEFAULT <- 1e-14 C_UPPER_BOUNDS_DEFAULT <- 8 C_FUTILITY_BOUNDS_DEFAULT <- -6 C_ALPHA_0_VEC_DEFAULT <- 1 C_THETA_H0_MEANS_DEFAULT <- 0 C_THETA_H0_RATES_DEFAULT <- 0 C_THETA_H0_SURVIVAL_DEFAULT <- 1 C_ALLOCATION_RATIO_DEFAULT <- 1 C_ALLOCATION_RATIO_MAXIMUM <- 100 C_DIRECTION_UPPER_DEFAULT <- TRUE C_NORMAL_APPROXIMATION_MEANS_DEFAULT <- FALSE C_NORMAL_APPROXIMATION_RATES_DEFAULT <- TRUE C_EQUAL_VARIANCES_DEFAULT <- TRUE C_ITERATIONS_DEFAULT <- 1000L C_ACCEPT_DEVIATION_INFORMATIONRATES <- 0.05 C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT <- 50 C_VARIED_PARAMETER_SEQUENCE_LENGTH_DEFAULT <- 30 C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL <- "TrialDesignGroupSequential" C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL <- "TrialDesignInverseNormal" C_CLASS_NAME_TRIAL_DESIGN_FISHER <- "TrialDesignFisher" C_CLASS_NAME_TRIAL_DESIGN_CONDITIONAL_DUNNETT <- "TrialDesignConditionalDunnett" .getTrialDesignClassNames <- function(inclusiveConditionalDunnett = TRUE) { trialDesignClassNames <- c(C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL, C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL, C_CLASS_NAME_TRIAL_DESIGN_FISHER) if (inclusiveConditionalDunnett) { trialDesignClassNames <- c(trialDesignClassNames, C_CLASS_NAME_TRIAL_DESIGN_CONDITIONAL_DUNNETT) } return(trialDesignClassNames) } C_EXCEPTION_TYPE_RUNTIME_ISSUE = "Runtime exception: " C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT = "Illegal argument: " C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT = "Illegal data input: " C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS = "Conflicting arguments: " C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS = "Argument out of bounds: " C_EXCEPTION_TYPE_ARGUMENT_LENGTH_OUT_OF_BOUNDS = "Argument length out of bounds: " C_EXCEPTION_TYPE_INDEX_OUT_OF_BOUNDS = "Index out of bounds: " C_EXCEPTION_TYPE_MISSING_ARGUMENT = "Missing argument: " C_EXCEPTION_TYPE_INCOMPLETE_ARGUMENTS = "Incomplete associated arguments: " C_DIRECTION_LOWER = "lower" C_DIRECTION_UPPER = "upper" C_QNORM_EPSILON <- 1e-323 # a value between 1e-323 and 1e-16 C_QNORM_MAXIMUM <- -stats::qnorm(C_QNORM_EPSILON) C_QNORM_MINIMUM <- -C_QNORM_MAXIMUM C_QNORM_THRESHOLD <- 38 # # Constants used in 'f_analysis_multiarm' and 'f_analysis_enrichment' # C_INTERSECTION_TEST_MULTIARMED_DEFAULT <- "Dunnett" C_INTERSECTION_TEST_ENRICHMENT_DEFAULT <- "Simes" C_INTERSECTION_TESTS_MULTIARMED <- c( "Bonferroni", "Simes", "Sidak", "Dunnett", "Hierarchical") C_INTERSECTION_TESTS_ENRICHMENT <- c( "Bonferroni", "Simes", "Sidak", "SpiessensDebois") C_VARIANCE_OPTION_DUNNETT <- "overallPooled" C_VARIANCE_OPTION_MULTIARMED_DEFAULT <- "overallPooled" C_VARIANCE_OPTIONS_MULTIARMED <- c("overallPooled", "pairwisePooled", "notPooled") C_VARIANCE_OPTION_ENRICHMENT_DEFAULT <- "pooled" C_VARIANCE_OPTIONS_ENRICHMENT <- c("pooled", "notPooled","pooledFromFull") C_STRATIFIED_ANALYSIS_DEFAULT <- TRUE # # Constants used in 'parameters.R' # C_PARAM_USER_DEFINED <- "u" C_PARAM_DEFAULT_VALUE <- "d" C_PARAM_GENERATED <- "g" C_PARAM_DERIVED <- ">" C_PARAM_NOT_APPLICABLE <- "." C_PARAM_TYPE_UNKNOWN <- "?" # # Constants used in 'f_simulation_survival.R' # C_PI_2_DEFAULT <- 0.2 C_PI_1_DEFAULT <- seq(0.2, 0.5, 0.1) C_PI_1_SAMPLE_SIZE_DEFAULT <- c(0.4, 0.5, 0.6) C_DROP_OUT_RATE_1_DEFAULT <- 0 C_DROP_OUT_RATE_2_DEFAULT <- 0 C_DROP_OUT_TIME_DEFAULT <- 12L C_EVENT_TIME_DEFAULT <- 12L C_ALLOCATION_1_DEFAULT <- 1 C_ALLOCATION_2_DEFAULT <- 1 C_MAX_ITERATIONS_DEFAULT <- 10L C_MAX_SIMULATION_ITERATIONS_DEFAULT <- 1000L C_ACCRUAL_TIME_DEFAULT <- c(0L, 12L) C_ACCRUAL_INTENSITY_DEFAULT <- 0.1 C_FOLLOW_UP_TIME_DEFAULT <- 6L # # Constants used in 'f_simulation_multiarm[...].R' # C_ACTIVE_ARMS_DEFAULT <- 3L C_POPULATIONS_DEFAULT <- 3L C_TYPES_OF_SELECTION <- c("best", "rBest", "epsilon", "all", "userDefined") C_TYPE_OF_SELECTION_DEFAULT <- C_TYPES_OF_SELECTION[1] C_TYPES_OF_SHAPE <- c("linear", "sigmoidEmax", "userDefined") C_TYPE_OF_SHAPE_DEFAULT <- C_TYPES_OF_SHAPE[1] C_SUCCESS_CRITERIONS <- c("all", "atLeastOne") C_SUCCESS_CRITERION_DEFAULT <- C_SUCCESS_CRITERIONS[1] C_EFFECT_MEASURES <- c("effectEstimate", "testStatistic") C_EFFECT_MEASURE_DEFAULT <- C_EFFECT_MEASURES[1] # # Additional constants used in 'f_design_sample_size_calculator.R' # C_ALTERNATIVE_DEFAULT <- seq(0.2, 1, 0.2) C_ALTERNATIVE_POWER_SIMULATION_DEFAULT <- seq(0, 1, 0.2) C_ALTERNATIVE_POWER_SIMULATION_MEAN_RATIO_DEFAULT <- seq(1, 2, 0.2) C_RANGE_OF_HAZARD_RATIOS_DEFAULT <- seq(1, 2.6, 0.4) C_STDEV_DEFAULT <- 1 # # Constants used in 'core_group_sequential_design.R' # # Type of design is one of the following: # O'Brien & Fleming, # Pocock, # Wang & Tsiatis Delta class, # Haybittle & Peto, # Optimum design within Wang & Tsiatis class, # Pocock type alpha spending, # O'Brien & Fleming type alpha spending, # Kim & DeMets alpha spending, # Hwang, Shi & DeCani alpha spending, # user defined alpha spending # C_TYPE_OF_DESIGN_OF <- "OF" # O'Brien & Fleming C_TYPE_OF_DESIGN_P <- "P" # Pocock, C_TYPE_OF_DESIGN_WT <- "WT" # Wang & Tsiatis Delta class C_TYPE_OF_DESIGN_PT <- "PT" # Pampallona & Tsiatis class C_TYPE_OF_DESIGN_HP <- "HP" # Haybittle & Peto C_TYPE_OF_DESIGN_WT_OPTIMUM <- "WToptimum" # Optimum design within Wang & Tsiatis class C_TYPE_OF_DESIGN_AS_P <- "asP" # Pocock type alpha spending C_TYPE_OF_DESIGN_AS_OF <- "asOF" # O'Brien & Fleming type alpha spending C_TYPE_OF_DESIGN_AS_KD <- "asKD" # Kim & DeMets alpha spending C_TYPE_OF_DESIGN_AS_HSD <- "asHSD" # Hwang, Shi & DeCani alpha spending C_TYPE_OF_DESIGN_AS_USER <- "asUser" # user defined alpha spending C_TYPE_OF_DESIGN_NO_EARLY_EFFICACY <- "noEarlyEfficacy" # no early efficacy stop C_DEFAULT_TYPE_OF_DESIGN <- C_TYPE_OF_DESIGN_OF # the default type of design C_TYPE_OF_DESIGN_LIST <- list( "OF" = "O'Brien & Fleming", "P" = "Pocock", "WT" = "Wang & Tsiatis Delta class", "PT" = "Pampallona & Tsiatis class", "HP" = "Haybittle & Peto", "WToptimum" = "Optimum design within Wang & Tsiatis class", "asP" = "Pocock type alpha spending", "asOF" = "O'Brien & Fleming type alpha spending", "asKD" = "Kim & DeMets alpha spending", "asHSD" = "Hwang, Shi & DeCani alpha spending", "asUser" = "User defined alpha spending", "noEarlyEfficacy" = "No early efficacy stop") C_PLOT_SHOW_SOURCE_ARGUMENTS <- c("commands", "axes", "test", "validate") C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD <- "Conditional Power with Likelihood" C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD <- "Conditional power / Likelihood" .getDesignTypes <- function() { return(c( C_TYPE_OF_DESIGN_OF, C_TYPE_OF_DESIGN_P, C_TYPE_OF_DESIGN_WT, C_TYPE_OF_DESIGN_PT, C_TYPE_OF_DESIGN_HP, C_TYPE_OF_DESIGN_WT_OPTIMUM, C_TYPE_OF_DESIGN_AS_P, C_TYPE_OF_DESIGN_AS_OF, C_TYPE_OF_DESIGN_AS_KD, C_TYPE_OF_DESIGN_AS_HSD, C_TYPE_OF_DESIGN_AS_USER, C_TYPE_OF_DESIGN_NO_EARLY_EFFICACY )) } .printDesignTypes <- function() { .arrayToString(.getDesignTypes(), encapsulate = TRUE) } .isAlphaSpendingDesignType <- function(typeOfDesign, userDefinedAlphaSpendingIncluded = TRUE) { if (userDefinedAlphaSpendingIncluded && typeOfDesign == C_TYPE_OF_DESIGN_AS_USER) { return(TRUE) } return(typeOfDesign %in% c(C_TYPE_OF_DESIGN_AS_P, C_TYPE_OF_DESIGN_AS_OF, C_TYPE_OF_DESIGN_AS_KD,C_TYPE_OF_DESIGN_AS_HSD)) } # # Type of beta spending design is one of the following: # Pocock type beta spending, # O'Brien & Fleming type beta spending, # Kim & DeMets beta spending, # Hwang, Shi & DeCani beta spending, # user defined beta spending # "none", "bsP", "bsOF", "bsKD", "bsHSD", "bsUser" C_TYPE_OF_DESIGN_BS_NONE <- "none" C_TYPE_OF_DESIGN_BS_P <- "bsP" # Pocock type beta spending C_TYPE_OF_DESIGN_BS_OF <- "bsOF" # O'Brien & Fleming type beta spending C_TYPE_OF_DESIGN_BS_KD <- "bsKD" # Kim & DeMets beta spending C_TYPE_OF_DESIGN_BS_HSD <- "bsHSD" # Hwang, Shi & DeCani beta spending C_TYPE_OF_DESIGN_BS_USER <- "bsUser" # user defined beta spending C_TYPE_OF_DESIGN_BS_LIST <- list( "none" = "none", "bsP" = "Pocock type beta spending", "bsOF" = "O'Brien & Fleming type beta spending", "bsKD" = "Kim & DeMets beta spending", "bsHSD" = "Hwang, Shi & DeCani beta spending", "bsUser" = "user defined beta spending" ) C_CIPHERS <- list(token = "310818669631424001", secret = "9318655074497250732") .getBetaSpendingDesignTypes <- function() { return(c( C_TYPE_OF_DESIGN_BS_NONE, C_TYPE_OF_DESIGN_BS_P, C_TYPE_OF_DESIGN_BS_OF, C_TYPE_OF_DESIGN_BS_KD, C_TYPE_OF_DESIGN_BS_HSD, C_TYPE_OF_DESIGN_BS_USER )) } .printBetaSpendingDesignTypes <- function() { .arrayToString(.getBetaSpendingDesignTypes(), encapsulate = TRUE) } .isBetaSpendingDesignType <- function(typeOfDesign, userDefinedBetaSpendingIncluded = TRUE, noneIncluded = FALSE) { if (userDefinedBetaSpendingIncluded && typeOfDesign == C_TYPE_OF_DESIGN_BS_USER) { return(TRUE) } if (noneIncluded && typeOfDesign == C_TYPE_OF_DESIGN_BS_NONE) { return(TRUE) } return(typeOfDesign %in% c( C_TYPE_OF_DESIGN_BS_P, C_TYPE_OF_DESIGN_BS_OF, C_TYPE_OF_DESIGN_BS_KD, C_TYPE_OF_DESIGN_BS_HSD )) } ## ## ------------------------------------------- ## C_OPTIMIZATION_CRITERION_ASNH1 <- "ASNH1" C_OPTIMIZATION_CRITERION_ASNIFH1 <- "ASNIFH1" C_OPTIMIZATION_CRITERION_ASN_SUM <- "ASNsum" C_OPTIMIZATION_CRITERION_DEFAULT <- C_OPTIMIZATION_CRITERION_ASNH1 .getOptimizationCriterions <- function() { return(c( C_OPTIMIZATION_CRITERION_ASNH1, C_OPTIMIZATION_CRITERION_ASNIFH1, C_OPTIMIZATION_CRITERION_ASN_SUM )) } .printOptimizationCriterion <- function() { .arrayToString(.getOptimizationCriterions(), encapsulate = TRUE) } .isOptimizationCriterion <- function(x) { return(x %in% .getOptimizationCriterions()) } ## ## ------------------------------------------- ## C_FISHER_METHOD_FULL_ALPHA <- "fullAlpha" C_FISHER_METHOD_EQUAL_ALPHA <- "equalAlpha" C_FISHER_METHOD_NO_INTERACTION <- "noInteraction" C_FISHER_METHOD_USER_DEFINED_ALPHA <- "userDefinedAlpha" C_FISHER_METHOD_DEFAULT <- C_FISHER_METHOD_EQUAL_ALPHA .getFisherMethods <- function() { return(c( C_FISHER_METHOD_FULL_ALPHA, C_FISHER_METHOD_EQUAL_ALPHA, C_FISHER_METHOD_NO_INTERACTION, C_FISHER_METHOD_USER_DEFINED_ALPHA )) } .printFisherMethods <- function() { .arrayToString(.getFisherMethods(), encapsulate = TRUE) } .isFisherMethod <- function(method) { return(method %in% .getFisherMethods()) } ## ## ------------------------------------------- ## C_PARAMETER_NAMES <- list( iterations = "Iterations", seed = "Seed", groups = "Treatment groups", stages = "Stages", sampleSizes = "Sample sizes", means = "Means", stDevs = "Standard deviations", overallEvents = "Cumulative events", overallAllocationRatios = "Cumulative allocation ratios", expectedEvents = "Expected events", varianceEvents = "Variance of events", overallExpectedEvents = "Cumulative expected events", overallVarianceEvents = "Cumulative variance of events", bindingFutility = "Binding futility", constantBoundsHP = "Haybittle Peto constants", kMax = "Maximum number of stages", alpha = "Significance level", finalStage = "Final stage", informationRates = "Information rates", criticalValues = "Critical values", stageLevels = "Stage levels (one-sided)", alphaSpent = "Cumulative alpha spending", tolerance = "Tolerance", method = "Method", alpha0Vec = "Alpha_0", scale = "Scale", nonStochasticCurtailment = "Non stochastic curtailment", simAlpha = "Simulated alpha", beta = "Type II error rate", betaSpent = "Cumulative beta spending", sided = "Test", futilityBounds = "Futility bounds (binding)", futilityBoundsNonBinding = "Futility bounds (non-binding)", typeOfDesign = "Type of design", deltaWT = "Delta for Wang & Tsiatis Delta class", deltaPT0 = "Delta0 for Pampallona & Tsiatis class", deltaPT1 = "Delta1 for Pampallona & Tsiatis class", optimizationCriterion = "Optimization criterion for optimum design within Wang & Tsiatis class", gammaA = "Parameter for alpha spending function", gammaB = "Parameter for beta spending function", typeBetaSpending = "Type of beta spending", userAlphaSpending = "User defined alpha spending", userBetaSpending = "User defined beta spending", probs = "Exit probabilities" , power = "Power", theta = "Effect", direction = "Direction", normalApproximation = "Normal approximation", equalVariances = "Equal variances", shift = "Shift", inflationFactor = "Inflation factor", information = "Informations", rejectionProbabilities = "Rejection probabilities under H1", futilityProbabilities = "Futility probabilities under H1", averageSampleNumber1 = "Ratio expected vs fixed sample size under H1", averageSampleNumber01 = "Ratio expected vs fixed sample size under a value between H0 and H1", averageSampleNumber0 = "Ratio expected vs fixed sample size under H0", allocationRatioPlanned = "Planned allocation ratio", thetaH0 = "Theta H0", thetaH1 = "Assumed effect under alternative", stDevH1 = "Assumed standard deviation under alternative", assumedStDev = "Assumed standard deviation", assumedStDevs = "Assumed standard deviations", pi1 = "Assumed treatment rate", pi2 = "Assumed control rate", overallPi1 = "Cumulative treatment rate", overallPi2 = "Cumulative control rate", pi1H1 = "pi(1) under H1", pi2H1 = "pi(2) under H1", nPlanned = "Planned sample size", piControl = "Assumed control rate", piControls = "Assumed control rates", piTreatment = "Assumed treatment rate", piTreatments = "Assumed treatment rates", piTreatmentH1 = "pi(treatment) under H1", piTreatmentsH1 = "pi(treatment) under H1", overallPiControl = "Cumulative control rate", overallPiTreatments = "Cumulative treatment rate", overallPisControl = "Cumulative control rate", overallPisTreatment = "Cumulative treatment rate", effectSizes = "Cumulative effect sizes", testStatistics = "Stage-wise test statistics", pValues = "Stage-wise p-values", testActions = "Actions", conditionalPower = "Conditional power", conditionalPowerAchieved = "Conditional power (achieved)", conditionalPowerSimulated = "Conditional power (simulated)", conditionalRejectionProbabilities = "Conditional rejection probability", repeatedConfidenceIntervalLowerBounds = "Repeated confidence intervals (lower)", repeatedConfidenceIntervalUpperBounds = "Repeated confidence intervals (upper)", repeatedPValues = "Repeated p-values", finalPValues = "Final p-value", finalConfidenceIntervalLowerBounds = "Final CIs (lower)", finalConfidenceIntervalUpperBounds = "Final CIs (upper)", medianUnbiasedEstimates = "Median unbiased estimate", overallSampleSizes = "Cumulative sample sizes", overallSampleSizes1 = "Cumulative sample sizes (1)", overallSampleSizes2 = "Cumulative sample sizes (2)", overallTestStatistics = "Overall test statistics", overallPValues = "Overall p-values", overallMeans = "Cumulative means", overallMeans1 = "Cumulative means (1)", overallMeans2 = "Cumulative means (2)", overallStDevs1 = "Cumulative standard deviations (1)", overallStDevs2 = "Cumulative standard deviations (2)", overallStDevs = "Cumulative (pooled) standard deviations", testStatistics = "Stage-wise test statistics", combInverseNormal = "Combination test statistics", # Inverse normal combination combFisher = "Combination test statistics", # Fisher combination weightsFisher = "Fixed weights", weightsInverseNormal = "Fixed weights", overallLogRanks = "Overall log-ranks", overallEvents = "Cumulative number of events", overallEvents1 = "Cumulative number of events (1)", overallEvents2 = "Cumulative number of events (2)", overallAllocationRatios = "Cumulative allocation ratios", events = "Number of events", allocationRatios = "Allocation ratios", logRanks = "Log-ranks", nMax = "N_max", averageSampleNumber = "Average sample sizes (ASN)", calculatedPower = "Power", earlyStop = "Early stop", rejectPerStage = "Reject per stage", futilityPerStage = "Futility stop per stage", overallEarlyStop = "Early stop", overallReject = "Overall reject", overallFutility = "Overall futility", riskRatio = "Risk ratio", meanRatio = "Mean ratio", alternative = "Alternatives", stDev = "Standard deviation", nFixed = "Number of subjects fixed", nFixed1 = "Number of subjects fixed (1)", nFixed2 = "Number of subjects fixed (2)", maxNumberOfSubjects = "Maximum number of subjects", maxNumberOfSubjects1 = "Maximum number of subjects (1)", maxNumberOfSubjects2 = "Maximum number of subjects (2)", numberOfSubjects = "Number of subjects", numberOfSubjects1 = "Number of subjects (1)", numberOfSubjects2 = "Number of subjects (2)", expectedNumberOfSubjectsH0 = "Expected number of subjects under H0", expectedNumberOfSubjectsH01 = "Expected number of subjects under H0/H1", expectedNumberOfSubjectsH1 = "Expected number of subjects under H1", expectedNumberOfSubjects = "Expected number of subjects", omega = "Probability of an event", hazardRatio = "Hazard ratio", hazardRatios = "Hazard ratios", typeOfComputation = "Type of computation", accountForObservationTimes = "Account for observation times", eventTime = "Event time", accrualTime = "Accrual time", totalAccrualTime = "Total accrual time", remainingTime = "Remaining time", followUpTime = "Follow up time", dropoutRate1 = "Drop-out rate (1)", dropoutRate2 = "Drop-out rate (2)", dropoutTime = "Drop-out time", eventsFixed = "Number of events fixed", expectedEventsH0 = "Expected number of events under H0", expectedEventsH01 = "Expected number of events under H0/H1", expectedEventsH1 = "Expected number of events under H1", analysisTime = "Analysis times", studyDurationH1 = "Expected study duration under H1", expectedNumberOfSubjectsH1 = "Expected number of subjects under H1", twoSidedPower = "Two-sided power", plannedEvents = "Planned cumulative events", plannedSubjects = "Planned cumulative subjects", # per arm (multi-arm); overall (base) minNumberOfEventsPerStage = "Minimum number of events per stage", maxNumberOfEventsPerStage = "Maximum number of events per stage", minNumberOfSubjectsPerStage = "Minimum number of subjects per stage", maxNumberOfSubjectsPerStage = "Maximum number of subjects per stage", accrualIntensity = "Accrual intensity", accrualIntensityRelative = "Accrual intensity (relative)", maxNumberOfIterations = "Maximum number of iterations", allocation1 = "Allocation 1", allocation2 = "Allocation 2", expectedNumberOfEvents = "Expected number of events", expectedNumberOfEventsPerStage = "Expected number of events by stage", eventsNotAchieved = "Events not achieved", subjects = "Subjects", overallReject = "Overall reject", futilityStop = "Overall futility stop", studyDuration = "Expected study duration", maxStudyDuration = "Maximal study duration", directionUpper = "Direction upper", piecewiseSurvivalTime = "Piecewise survival times", lambda1 = "lambda(1)", lambda2 = "lambda(2)", kappa = "kappa", earlyStopPerStage = "Early stop per stage", effect = "Effect", maxNumberOfEvents = "Maximum number of events", criticalValuesEffectScale = "Critical values (treatment effect scale)", criticalValuesEffectScaleLower = "Lower critical values (treatment effect scale)", criticalValuesEffectScaleUpper = "Upper critical values (treatment effect scale)", criticalValuesPValueScale = "Local one-sided significance levels", ".design$stageLevels" = "Local one-sided significance levels", futilityBoundsEffectScale = "Futility bounds (treatment effect scale)", futilityBoundsPValueScale = "Futility bounds (one-sided p-value scale)", analysisTime = "Analysis time", eventsPerStage1 = "Observed # events by stage (1)", eventsPerStage2 = "Observed # events by stage (2)", testStatistic = "Test statistic", logRankStatistic = "Log-rank statistic", hazardRatioEstimateLR = "Hazard ratio estimate LR", delayedResponseAllowed = "Delayed response allowed", delayedResponseEnabled = "Delayed response enabled", piecewiseSurvivalEnabled = "Piecewise exponential survival enabled", median1 = "median(1)", median2 = "median(2)", eventsPerStage = "Cumulative number of events", expectedNumberOfEvents = "Observed number of events", expectedNumberOfSubjects = "Observed number of subjects", singleNumberOfEventsPerStage = "Single number of events", endOfAccrualIsUserDefined = "End of accrual is user defined", followUpTimeMustBeUserDefined = "Follow-up time must be user defined", maxNumberOfSubjectsIsUserDefined = "Max number of subjects is user defined", maxNumberOfSubjectsCanBeCalculatedDirectly = "Max number of subjects can be calculated directly", absoluteAccrualIntensityEnabled = "Absolute accrual intensity is enabled", time = "Time", overallEventProbabilities = "Cumulative event probabilities", eventProbabilities1 = "Event probabilities (1)", eventProbabilities2 = "Event probabilities (2)", informationAtInterim = "Information at interim", secondStageConditioning = "Conditional second stage p-values", separatePValues = "Separate p-values", singleStepAdjustedPValues = "Single step adjusted p-values", intersectionTest = "Intersection test", varianceOption = "Variance option", overallPooledStDevs = "Cumulative (pooled) standard deviations", optimumAllocationRatio = "Optimum allocation ratio", rejected = "Rejected", indices = "Indices of hypothesis", adjustedStageWisePValues = "Adjusted stage-wise p-values", overallAdjustedTestStatistics = "Overall adjusted test statistics", rejectedIntersections = "Rejected intersections", conditionalErrorRate = "Conditional error rate", secondStagePValues = "Second stage p-values", effectMatrix = "Effect matrix", typeOfShape = "Type of shape", gED50 = "ED50", slope = "Slope", adaptations = "Adaptations", typeOfSelection = "Type of selection", effectMeasure = "Effect measure", successCriterion = "Success criterion", epsilonValue = "Epsilon value", rValue = "r value", threshold = "Threshold", rejectAtLeastOne = "Reject at least one", selectedArms = "Selected arms", rejectedArmsPerStage = "Rejected arms per stage", selectedPopulations = "Selected populations", rejectedPopulationsPerStage = "Rejected populations per stage", successPerStage = "Success per stage", effectEstimate = "Effect estimate", subjectsControlArm = "Subjects (control arm)", subjectsActiveArm = "Subjects (active arm)", pValue = "p-value", conditionalCriticalValue = "Conditional critical value", piControlH1 = "pi(control) under H1", piH1 = "pi under H1", piMaxVector = "pi_max", omegaMaxVector = "omega_max", muMaxVector = "mu_max", activeArms = "Active arms", populations = "Populations", numberOfEvents = "Number of events", calcSubjectsFunction = "Calculate subjects function", calcEventsFunction = "Calculate events function", selectArmsFunction = "Select arms function", numberOfActiveArms = "Number of active arms", selectPopulationsFunction = "Select populations function", numberOfPopulations = "Number of populations", correlationComputation = "Correlation computation method", subsets = "Subsets", subset = "Subset", stratifiedAnalysis = "Stratified analysis", maxInformation = "Maximum information", informationEpsilon = "Information epsilon", effectList = "Effect list", subGroups = "Sub-groups", prevalences = "Prevalences", effects = "Effects", situation = "Situation" ) .getParameterNames <- function(..., design = NULL, designPlan = NULL, stageResults = NULL, analysisResults = NULL, dataset = NULL) { parameterNames <- C_PARAMETER_NAMES if (!is.null(design) && !is.na(design$bindingFutility) && !design$bindingFutility) { parameterNames$futilityBounds <- C_PARAMETER_NAMES[["futilityBoundsNonBinding"]] } if (!is.null(designPlan) && inherits(designPlan, "TrialDesignPlanSurvival") && !is.null(designPlan$.piecewiseSurvivalTime) && designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { parameterNames$lambda2 <- "Piecewise survival lambda (2)" parameterNames$lambda1 <- "Piecewise survival lambda (1)" } if (!is.null(designPlan) && inherits(designPlan, "TrialDesignPlanSurvival") && identical(designPlan$.design$kMax, 1L)) { parameterNames$maxNumberOfEvents <- "Number of events" } if (!is.null(designPlan) && inherits(designPlan, "TrialDesignPlan") && identical(designPlan$.design$kMax, 1L)) { parameterNames$studyDuration <- "Study duration" } if (!is.null(analysisResults) && identical(analysisResults$.design$kMax, 1L)) { parameterNames$repeatedConfidenceIntervalLowerBounds <- "Confidence intervals (lower)" parameterNames$repeatedConfidenceIntervalUpperBounds <- "Confidence intervals (upper)" parameterNames$repeatedPValues = "Overall p-values" } if (!is.null(designPlan) && (inherits(designPlan, "TrialDesignPlanMeans") || inherits(designPlan, "SimulationResultsMeans")) && isTRUE(designPlan$meanRatio)) { parameterNames$stDev <- "Coefficient of variation" } if (!is.null(design) && class(design) != "TrialDesign" && design$sided == 2) { parameterNames$criticalValuesPValueScale <- "Local two-sided significance levels" } if ((!is.null(stageResults) && stageResults$isOneSampleDataset()) || (!is.null(dataset) && inherits(dataset, "DatasetMeans"))) { parameterNames$overallStDevs <- "Cumulative standard deviations" } return(parameterNames) } C_TABLE_COLUMN_NAMES <- list( iterations = "Iterations", seed = "Seed", groups = "Treatment group", stages = "Stage", sampleSizes = "Sample size", means = "Mean", stDevs = "Standard deviation", overallEvents = "Cumulative event", overallAllocationRatios = "Cumulative allocation ratio", overallMeans = "Cumulative mean", expectedEvents = "Expected event", varianceEvents = "Variance of event", overallExpectedEvents = "Cumulative expected event", overallVarianceEvents = "Cumulative variance of event", bindingFutility = "Binding futility", constantBoundsHP = "Haybittle Peto constant", kMax = "Maximum # stages", alpha = "Significance level", finalStage = "Final stage", informationRates = "Information rate", criticalValues = "Critical value", stageLevels = "Stage level", alphaSpent = "Cumulative alpha spending", tolerance = "Tolerance", method = "Method", alpha0Vec = "Alpha_0", scale = "Scale", nonStochasticCurtailment = "Non stochastic curtailment", simAlpha = "Simulated alpha", beta = "Type II error rate", betaSpent = "Cumulative beta spending", sided = "Test", futilityBounds = "Futility bound (binding)", futilityBoundsNonBinding = "Futility bound (non-binding)", typeOfDesign = "Type of design", deltaWT = "Delta (Wang & Tsiatis)", deltaPT0 = "Delta0 (Pampallona & Tsiatis)", deltaPT1 = "Delta1 (Pampallona & Tsiatis)", optimizationCriterion = "Optimization criterion (Wang & Tsiatis)", gammaA = "Parameter for alpha spending function", gammaB = "Parameter for beta spending function", typeBetaSpending = "Type of beta spending", userAlphaSpending = "User defined alpha spending", userBetaSpending = "User defined beta spending", probs = "Internal calculation probabilities" , power = "Power", theta = "Effect", direction = "Direction", normalApproximation = "Normal approximation", equalVariances = "Equal variance", assumedStDev = "Assumed standard deviation", assumedStDevs = "Assumed standard deviation", stDevH1 = "Assumed standard deviation under H1", shift = "Shift", inflationFactor = "Inflation factor", information = "Information", rejectionProbabilities = "Rejection probability under H1", futilityProbabilities = "Futility probability under H1", averageSampleNumber1 = "Ratio expected vs fixed sample size under H1", averageSampleNumber01 = "Ratio expected vs fixed sample size under a value between H0 and H1", averageSampleNumber0 = "Ratio expected vs fixed sample size under H0", allocationRatioPlanned = "Planned allocation ratio", thetaH0 = "Theta H0", # Effect thetaH1 = "Assumed effect", pi1 = "pi(1)", pi2 = "pi(2)", pi1H1 = "pi(1) under H1", pi2H1 = "pi(2) under H1", nPlanned = "Planned sample size", piControl = "Assumed control rate", piControls = "Assumed control rates", piTreatment = "Assumed treatment rate", piTreatments = "Assumed treatment rates", piTreatmentH1 = "pi(treatment) under H1", piTreatmentsH1 = "pi(treatment) under H1", overallPiControl = "Cumulative control rate", overallPiTreatments = "Cumulative treatment rate", overallPisControl = "Cumulative control rate", overallPisTreatment = "Cumulative treatment rate", stages = "Stage", effectSizes = "Overall effect size", testStatistics = "Stage-wise test statistic", pValues = "p-value", testActions = "Action", conditionalPower = "Conditional power", conditionalPowerAchieved = "Conditional power (achieved)", conditionalPowerSimulated = "Conditional power (simulated)", conditionalRejectionProbabilities = "Conditional rejection probabilities", repeatedConfidenceIntervalLowerBounds = "Repeated confidence interval (lower)", repeatedConfidenceIntervalUpperBounds = "Repeated confidence interval (upper)", repeatedPValues = "Repeated p-value", finalPValues = "Final p-value", finalConfidenceIntervalLowerBounds = "Final CI (lower)", finalConfidenceIntervalUpperBounds = "Final CI (upper)", medianUnbiasedEstimates = "Median unbiased estimate", overallSampleSizes = "Cumulative sample size", overallSampleSizes1 = "Cumulative sample size (1)", overallSampleSizes2 = "Cumulative sample size (2)", overallTestStatistics = "Overall test statistic", overallPValues = "Overall p-value", overallMeans1 = "Cumulative mean (1)", overallMeans2 = "Cumulative mean (2)", overallStDevs1 = "Cumulative standard deviation (1)", overallStDevs2 = "Cumulative standard deviation (2)", overallStDevs = "Cumulative (pooled) standard deviation", testStatistics = "Test statistic", combInverseNormal = "Inverse Normal Combination", combFisher = "Fisher Combination", weightsFisher = "Fixed weight", weightsInverseNormal = "Fixed weight", overallLogRanks = "Overall log-rank", overallEvents = "Cumulative # events", overallEvents1 = "Cumulative # events (1)", overallEvents2 = "Cumulative # events (2)", overallAllocationRatios = "Cumulative allocation ratio", events = "# events", allocationRatios = "Allocation ratio", logRanks = "Log-rank", nMax = "N_max", averageSampleNumber = "Average sample size (ASN)", calculatedPower = "Power", earlyStop = "Early stop", rejectPerStage = "Reject per stage", futilityPerStage = "Futility stop per stage", overallEarlyStop = "Early stop", overallReject = "Overall reject", overallFutility = "Overall futility", riskRatio = "Risk ratio", meanRatio = "Mean ratio", alternative = "Alternative", stDev = "Standard deviation", nFixed = "# subjects fixed", nFixed1 = "# subjects fixed (1)", nFixed2 = "# subjects fixed (2)", maxNumberOfSubjects = "Max # subjects", maxNumberOfSubjects1 = "Max # subjects (1)", maxNumberOfSubjects2 = "Max # subjects (2)", numberOfSubjects = "# subjects", numberOfSubjects1 = "# subjects (1)", numberOfSubjects2 = "# subjects (2)", expectedNumberOfSubjectsH0 = "Expected # subjects under H0", expectedNumberOfSubjectsH01 = "Expected # subjects under H0/H1", expectedNumberOfSubjectsH1 = "Expected # subjects under H1", expectedNumberOfSubjects = "Expected # subjects", omega = "Probability of an event", hazardRatio = "Hazard ratio", hazardRatios = "Hazard ratios", typeOfComputation = "Type of computation", accountForObservationTimes = "Account for observation times", eventTime = "Event time", accrualTime = "Accrual time", totalAccrualTime = "Total accrual time", remainingTime = "Remaining time", followUpTime = "Follow up time", dropoutRate1 = "Drop-out rate (1)", dropoutRate2 = "Drop-out rate (2)", dropoutTime = "Drop-out time", eventsFixed = "# events fixed", expectedEventsH0 = "Expected # events under H0", expectedEventsH01 = "Expected # events under H0/H1", expectedEventsH1 = "Expected # events under H1", analysisTime = "Analysis time", eventsPerStage1 = "Observed # events by stage (1)", eventsPerStage2 = "Observed # events by stage (2)", studyDurationH1 = "Expected study duration H1", expectedNumberOfSubjectsH1 = "Expected # subjects H1", twoSidedPower = "Two-sided power", plannedEvents = "Planned cumulative events", plannedSubjects = "Planned cumulative subjects", minNumberOfEventsPerStage = "Minimum # events per stage", maxNumberOfEventsPerStage = "Maximum # events per stage", minNumberOfSubjectsPerStage = "Minimum # of subjects per stage", maxNumberOfSubjectsPerStage = "Maximum # of subjects per stage", accrualIntensity = "Accrual intensity", accrualIntensityRelative = "Accrual intensity (relative)", maxNumberOfIterations = "Maximum # iterations", allocation1 = "Allocation 1", allocation2 = "Allocation 2", expectedNumberOfEvents = "Expected # events", expectedNumberOfEventsPerStage = "Expected # events by stage", eventsNotAchieved = "Events not achieved", subjects = "Subjects", futilityStop = "Overall futility stop", studyDuration = "Expected study duration", maxStudyDuration = "Maximal study duration", directionUpper = "Direction upper", piecewiseSurvivalTime = "Piecewise survival times", lambda1 = "lambda(1)", lambda2 = "lambda(2)", kappa = "kappa", earlyStopPerStage = "Early stop per stage", effect = "Effect", maxNumberOfEvents = "Maximum # events", criticalValuesEffectScale = "Critical value (treatment effect scale)", criticalValuesEffectScaleLower = "Lower critical value (treatment effect scale)", criticalValuesEffectScaleUpper = "Upper critical value (treatment effect scale)", criticalValuesPValueScale = "Local one-sided significance level", ".design$stageLevels" = "Local one-sided significance level", futilityBoundsEffectScale = "Futility bound (treatment effect scale)", futilityBoundsPValueScale = "Futility bound (one-sided p-value scale)", delayedResponseAllowed = "Delayed response allowed", delayedResponseEnabled = "Delayed response enabled", piecewiseSurvivalEnabled = "Piecewise exponential survival enabled", median1 = "median(1)", median2 = "median(2)", eventsPerStage = "Cumulative # events", expectedNumberOfEvents = "Observed # events", expectedNumberOfSubjects = "Observed # subjects", singleNumberOfEventsPerStage = "Single # events", endOfAccrualIsUserDefined = "End of accrual is user defined", followUpTimeMustBeUserDefined = "Follow-up time must be user defined", maxNumberOfSubjectsIsUserDefined = "Max number of subjects is user defined", maxNumberOfSubjectsCanBeCalculatedDirectly = "Max number of subjects can be calculated directly", absoluteAccrualIntensityEnabled = "Absolute accrual intensity is enabled", time = "Time", overallEventProbabilities = "Cumulative event probability", eventProbabilities1 = "Event probability (1)", eventProbabilities2 = "Event probability (2)", informationAtInterim = "Information at interim", secondStageConditioning = "Conditional second stage p-value", separatePValues = "Separate p-value", singleStepAdjustedPValues = "Single step adjusted p-value", intersectionTest = "Intersection test", varianceOption = "Variance option", overallPooledStDevs = "Cumulative (pooled) standard deviation", optimumAllocationRatio = "Optimum allocation ratio", rejected = "Rejected", indices = "Indices of hypothesis", adjustedStageWisePValues = "Adjusted stage-wise p-value", overallAdjustedTestStatistics = "Overall adjusted test statistics", rejectedIntersections = "Rejected intersection", conditionalErrorRate = "Conditional error rate", secondStagePValues = "Second stage p-value", effectMatrix = "Effect matrix", typeOfShape = "Type of shape", gED50 = "ED50", slope = "Slope", adaptations = "Adaptations", typeOfSelection = "Type of selection", effectMeasure = "Effect measure", successCriterion = "Success criterion", epsilonValue = "Epsilon value", rValue = "r value", threshold = "Threshold", rejectAtLeastOne = "Reject at least one", selectedArms = "Selected arm", rejectedArmsPerStage = "Rejected arm per stage", successPerStage = "Success per stage", effectEstimate = "Effect estimate", subjectsControlArm = "Subjects (control arm)", subjectsActiveArm = "Subjects (active arm)", pValue = "p-value", conditionalCriticalValue = "Conditional critical value", piControlH1 = "pi(control) under H1", piH1 = "pi under H1", piMaxVector = "pi_max", omegaMaxVector = "omega_max", muMaxVector = "mu_max", activeArms = "Active arm", populations = "Population", numberOfEvents = "Number of events", calcSubjectsFunction = "Calc subjects fun", calcEventsFunction = "Calc events fun", selectArmsFunction = "Select arms fun", numberOfActiveArms = "Number of active arms", correlationComputation = "Correlation computation", subsets = "Subset", subset = "Subset", stratifiedAnalysis = "Stratified analysis", maxInformation = "Maximum information", informationEpsilon = "Information epsilon", effectList = "Effect list", subGroups = "Sub-group", prevalences = "Prevalence", effects = "Effect", situation = "Situation" ) .getTableColumnNames <- function(design = NULL, designPlan = NULL) { tableColumnNames <- C_TABLE_COLUMN_NAMES if (!is.null(design) && !is.na(design$bindingFutility) && !design$bindingFutility) { tableColumnNames$futilityBounds <- C_TABLE_COLUMN_NAMES[["futilityBoundsNonBinding"]] } if (!is.null(designPlan) && inherits(designPlan, "TrialDesignPlanSurvival") && !is.null(designPlan$.piecewiseSurvivalTime) && designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { tableColumnNames$lambda2 = "Piecewise survival lambda (2)" tableColumnNames$lambda1 = "Piecewise survival lambda (1)" } if (!is.null(designPlan) && inherits(designPlan, "TrialDesignPlanSurvival") && identical(designPlan$.design$kMax, 1L)) { tableColumnNames$maxNumberOfEvents <- "Number of events" } if (!is.null(designPlan) && inherits(designPlan, "TrialDesignPlan") && identical(designPlan$.design$kMax, 1L)) { tableColumnNames$studyDuration <- "Study duration" } if (!is.null(designPlan) && (inherits(designPlan, "TrialDesignPlanMeans") || inherits(designPlan, "SimulationResultsMeans")) && isTRUE(designPlan$meanRatio)) { tableColumnNames$stDev <- "Coefficient of variation" } if (!is.null(design) && class(design) != "TrialDesign" && design$sided == 2) { tableColumnNames$criticalValuesPValueScale <- "Local two-sided significance level" } return(tableColumnNames) } C_PARAMETER_FORMAT_FUNCTIONS <- list( means = ".formatMeans", stDevs = ".formatStDevs", stDev = ".formatStDevs", assumedStDev = ".formatStDevs", assumedStDevs = ".formatStDevs", overallAllocationRatios = ".formatRatios", allocationRatioPlanned = ".formatRatios", alpha = ".formatProbabilities", beta = ".formatProbabilities", informationRates = ".formatRates", stageLevels = ".formatProbabilities", alphaSpent = ".formatProbabilities", alpha0Vec = ".formatProbabilities", simAlpha = ".formatProbabilities", criticalValues = ".formatCriticalValuesFisher", # will be set in class TrialDesignFisher criticalValues = ".formatCriticalValues", # will be set in class TrialDesignGroupSequential betaSpent = ".formatProbabilities", futilityBounds = ".formatCriticalValues", alpha0Vec = ".formatProbabilities", constantBoundsHP = ".formatCriticalValues", nMax = ".formatSampleSizes", nFixed = ".formatSampleSizes", nFixed1 = ".formatSampleSizes", nFixed2 = ".formatSampleSizes", shift = ".formatProbabilities", inflationFactor = ".formatProbabilities", information = ".formatRates", power = ".formatProbabilities", rejectionProbabilities = ".formatProbabilities", futilityProbabilities = ".formatFutilityProbabilities", probs = ".formatProbabilities", averageSampleNumber1 = ".formatProbabilities", averageSampleNumber01 = ".formatProbabilities", averageSampleNumber0 = ".formatProbabilities", effectSizes = ".formatMeans", thetaH1 = ".formatMeans", stDevH1 = ".formatStDevs", testStatistics = ".formatTestStatistics", pValues = ".formatPValues", conditionalPower = ".formatConditionalPower", conditionalPowerAchieved = ".formatConditionalPower", conditionalPowerSimulated = ".formatConditionalPower", conditionalRejectionProbabilities = ".formatProbabilities", repeatedConfidenceIntervalLowerBounds = ".formatMeans", repeatedConfidenceIntervalUpperBounds = ".formatMeans", repeatedPValues = ".formatRepeatedPValues", finalPValues = ".formatPValues", finalConfidenceIntervalLowerBounds = ".formatMeans", finalConfidenceIntervalUpperBounds = ".formatMeans", medianUnbiasedEstimates = ".formatMeans", overallTestStatistics = ".formatTestStatistics", overallPValues = ".formatPValues", overallMeans = ".formatMeans", overallMeans1 = ".formatMeans", overallMeans2 = ".formatMeans", overallStDevs1 = ".formatStDevs", overallStDevs2 = ".formatStDevs", overallStDevs = ".formatStDevs", overallPooledStDevs = ".formatStDevs", testStatistics = ".formatTestStatistics", combInverseNormal = ".formatTestStatistics", combFisher = ".formatTestStatisticsFisher", weightsFisher = ".formatRates", weightsInverseNormal = ".formatRates", overallLogRanks = ".formatTestStatistics", logRanks = ".formatTestStatistics", theta = ".formatMeans", averageSampleNumber = ".formatCriticalValues", # ".formatSampleSizes", calculatedPower = ".formatProbabilities", earlyStop = ".formatProbabilities", rejectPerStage = ".formatProbabilities", futilityPerStage = ".formatProbabilities", overallEarlyStop = ".formatProbabilities", overallReject = ".formatProbabilities", overallFutility = ".formatProbabilities", earlyStopPerStage = ".formatProbabilities", effect = ".formatMeans", maxNumberOfSubjects = ".formatSampleSizes", maxNumberOfSubjects1 = ".formatSampleSizes", maxNumberOfSubjects2 = ".formatSampleSizes", maxNumberOfEvents = ".formatEvents", numberOfSubjects = ".formatSampleSizes", numberOfSubjects1 = ".formatSampleSizes", numberOfSubjects2 = ".formatSampleSizes", expectedNumberOfSubjectsH0 = ".formatSampleSizes", expectedNumberOfSubjectsH01 = ".formatSampleSizes", expectedNumberOfSubjectsH1 = ".formatSampleSizes", expectedNumberOfSubjects = ".formatSampleSizes", omega = ".formatRates", hazardRatio = ".formatRates", hazardRatios = ".formatRates", pi1 = ".formatRates", pi2 = ".formatRates", pi1H1 = ".formatRates", pi2H1 = ".formatRates", piecewiseSurvivalTime = ".formatTime", lambda2 = ".formatRates", lambda1 = ".formatRates", eventTime = ".formatEventTime", accrualTime = ".formatTime", totalAccrualTime = ".formatTime", remainingTime = ".formatTime", followUpTime = ".formatTime", dropoutRate1 = ".formatRates", dropoutRate2 = ".formatRates", dropoutTime = ".formatTime", eventsFixed = ".formatEvents", expectedEventsH0 = ".formatEvents", expectedEventsH01 = ".formatEvents", expectedEventsH1 = ".formatEvents", analysisTime = ".formatTime", studyDurationH1 = ".formatDurations", expectedNumberOfSubjectsH1 = ".formatSampleSizes", expectedEvents = ".formatEvents", varianceEvents = ".formatEvents", overallExpectedEvents = ".formatEvents", overallVarianceEvents = ".formatEvents", events = ".formatEvents", expectedNumberOfEvents = ".formatEvents", expectedNumberOfEventsPerStage = ".formatEvents", eventsNotAchieved = ".formatRates", subjects = ".formatSampleSizes", futilityStop = ".formatProbabilities", studyDuration = ".formatDurations", maxStudyDuration = ".formatDurations", criticalValuesEffectScale = ".formatCriticalValues", criticalValuesEffectScaleLower = ".formatCriticalValues", criticalValuesEffectScaleUpper = ".formatCriticalValues", criticalValuesPValueScale = ".formatProbabilities", futilityBoundsEffectScale = ".formatCriticalValues", futilityBoundsPValueScale = ".formatProbabilities", median1 = ".formatRatesDynamic", median2 = ".formatRatesDynamic", accrualIntensity = ".formatAccrualIntensities", accrualIntensityRelative = ".formatAccrualIntensities", eventsPerStage = ".formatEvents", expectedNumberOfEvents = ".formatEvents", expectedNumberOfSubjects = ".formatEvents", singleNumberOfEventsPerStage = ".formatEvents", time = ".formatTime", overallEventProbabilities = ".formatProbabilities", eventProbabilities1 = ".formatProbabilities", eventProbabilities2 = ".formatProbabilities", informationAtInterim = ".formatRates", separatePValues = ".formatPValues", singleStepAdjustedPValues = ".formatPValues", userAlphaSpending = ".formatHowItIs", userBetaSpending = ".formatHowItIs", piControl = ".formatRates", piControls = ".formatRates", piTreatment = ".formatRates", piTreatments = ".formatRates", piTreatmentH1 = ".formatRates", piTreatmentsH1 = ".formatRates", overallPiControl = ".formatRates", overallPiTreatments = ".formatRates", overallPisControl = ".formatRates", overallPisTreatment = ".formatRates", adjustedStageWisePValues = ".formatPValues", overallAdjustedTestStatistics = ".formatTestStatisticsFisher", # will be set in class ClosedCombinationTestResults overallAdjustedTestStatistics = ".formatTestStatistics", conditionalErrorRate = ".formatProbabilities", secondStagePValues = ".formatPValues", sampleSizes = ".formatSampleSizes", effectMatrix = ".formatMeans", gED50 = ".formatHowItIs", slope = ".formatHowItIs", epsilonValue = ".formatHowItIs", threshold = ".formatHowItIs", rejectAtLeastOne = ".formatProbabilities", selectedArms = ".formatProbabilities", rejectedArmsPerStage = ".formatProbabilities", successPerStage = ".formatProbabilities", effectEstimate = ".formatMeans", subjectsControlArm = ".formatSampleSizes", subjectsActiveArm = ".formatSampleSizes", pValue = ".formatPValues", conditionalCriticalValue = ".formatCriticalValues", piControlH1 = ".formatRates", piH1 = ".formatRates", piMaxVector = ".formatRates", omegaMaxVector = ".formatRates", muMaxVector = ".formatMeans", numberOfEvents = ".formatEvents", numberOfActiveArms = ".formatRates", maxInformation = ".formatHowItIs", informationEpsilon = ".formatProbabilities" ) .getParameterFormatFunctions <- function() { return(C_PARAMETER_FORMAT_FUNCTIONS) } rpact/R/f_core_output_formats.R0000644000175000017500000010423014145656364016467 0ustar nileshnilesh## | ## | *Output formats* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | C_ROUND_FUNCTIONS <- c("ceiling", "floor", "trunc", "round", "signif") C_OUTPUT_FORMAT_ARGUMENTS <- c("digits", "nsmall", "trimSingleZeroes", "futilityProbabilityEnabled", "roundFunction") C_OUTPUT_FORMAT_DEFAULT_VALUES <- pairlist( "rpact.output.format.p.value" = "digits = 4, nsmall = 4", "rpact.output.format.repeated.p.value" = "digits = 4, nsmall = 4", "rpact.output.format.probability" = "digits = 3, nsmall = 3", "rpact.output.format.futility.probability" = "digits = 4, nsmall = 4, futilityProbabilityEnabled = TRUE", "rpact.output.format.sample.size" = "digits = 1, nsmall = 1", "rpact.output.format.event" = "digits = 1, nsmall = 1, trimSingleZeroes = TRUE", "rpact.output.format.event.time" = "digits = 3, trimSingleZeroes = TRUE", "rpact.output.format.conditional.power" = "digits = 4", "rpact.output.format.critical.value" = "digits = 3, nsmall = 3", "rpact.output.format.critical.value.fisher" = "digits = 4", "rpact.output.format.test.statistic.fisher" = "digits = 4", "rpact.output.format.test.statistic" = "digits = 3, nsmall = 3", "rpact.output.format.rate" = "digits = 3, nsmall = 3", "rpact.output.format.rate1" = "digits = 1, nsmall = 1", "rpact.output.format.accrual.intensity" = "digits = 2, nsmall = 1", "rpact.output.format.mean" = "digits = 4", "rpact.output.format.ratio" = "digits = 3", "rpact.output.format.st.dev" = "digits = 4", "rpact.output.format.duration" = "digits = 2, nsmall = 2", "rpact.output.format.time" = "digits = 2, nsmall = 2" ) .getFormattedValue <- function(value, ..., digits, nsmall = NA_integer_, futilityProbabilityEnabled = FALSE, roundFunction = NA_character_, scientific = NA) { if (missing(value)) { return("NA") } if (is.null(value) || length(value) == 0) { return(value) } if (!is.numeric(value)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'value' must be a numeric vector") } if (futilityProbabilityEnabled) { value[value >= 0 & value < 1e-09] <- 0 # only futility probilities } if (!is.na(roundFunction)) { if (roundFunction == "ceiling") { value <- ceiling(value * 10^digits) / 10^digits } else if (roundFunction == "floor") { value <- floor(value * 10^digits) / 10^digits } else if (roundFunction == "trunc") { value <- trunc(value) } else if (roundFunction == "round ") { value <- round(value, digits = digits) } else if (roundFunction == "signif ") { value <- signif(value, digits = digits) } } if (is.na(nsmall)) { nsmall <- 0L } formattedValue <- format(value, digits = digits, nsmall = nsmall, scientific = scientific, justify = "left", trim = TRUE) if ((is.na(scientific) || scientific) && any(grepl("e", formattedValue))) { formattedValueTemp <- c() for (valueTemp in value) { formattedValueTemp <- c(formattedValueTemp, format(valueTemp, digits = digits, nsmall = nsmall, scientific = scientific, justify = "left", trim = TRUE)) } formattedValue <- formattedValueTemp } if (futilityProbabilityEnabled) { formattedValue[value == 0] <- "0" } return(formattedValue) } .getZeroCorrectedValue <- function(value) { if (is.numeric(value)) { value[abs(value) < 1e-08] <- 0 } return(value) } .getPValueDecimalPlaces <- function(value) { value <- stats::na.omit(value) if (length(value) == 0) { return(4) } fv <- .getFormattedValue(value[value >= 1e-4], digits = 4, nsmall = 4) fv <- fv[!((1:length(fv)) %in% grep("e", fv))] numberOfCharacters <- ifelse(length(fv) > 0, nchar(fv[1]), 6) numberOfCharacters <- ifelse(numberOfCharacters < 6, 6, numberOfCharacters) decimalPlaces <- numberOfCharacters - 2 return(decimalPlaces) } .assertIsValitOutputFormatOptionValue <- function(optionKey, optionValue) { if (is.null(optionValue) || length(optionValue) == 0 || nchar(trimws(optionValue)) == 0) { return(invisible()) } parts <- base::strsplit(optionValue, " *, *", fixed = FALSE)[[1]] if (length(parts) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the value (", optionValue, ") of output format option '", optionKey, "' is invalid") } for (part in parts) { if (!grepl(" *= *", part)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", optionKey, "' (", part, ") must contain a valid argument-value-pair: \"argument = value\"") } keyValuePair <- base::strsplit(part, " *= *", fixed = FALSE)[[1]] if (length(keyValuePair) != 2) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", optionKey, "' contains an invalid argument-value-pair: ", part) } key <- trimws(keyValuePair[1]) if (nchar(key) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", optionKey, "' contains an invalid argument") } if (!(key %in% C_OUTPUT_FORMAT_ARGUMENTS)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", optionKey, "' contains an invalid argument: ", key) } value <- trimws(keyValuePair[2]) if (nchar(value) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", optionKey, "' contains an invalid value") } if (key %in% c("digits", "nsmall")) { if (grepl("\\D", value)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the value (", value, ") of '", optionKey, "' must be an integer value") } } else if (key %in% c("roundFunction")) { if (!(value %in% C_ROUND_FUNCTIONS)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the value (", value, ") of '", optionKey, "' must be one of these character values: ", .arrayToString(C_ROUND_FUNCTIONS, encapsulate = TRUE)) } } else if (key %in% c("trimSingleZeroes", "futilityProbabilityEnabled")) { if (!grepl("TRUE|FALSE", toupper(value))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the value (", value, ") of '", optionKey, "' must be a logical value") } } } } .assertIsValitOutputFormatOptionValue("rpact.output.format.sample.size", "roundFunction = ceiling") .getOutputFormatOptions <- function(optionKey) { str <- getOption(optionKey) if (is.null(str) || length(str) == 0 || nchar(trimws(str)) == 0) { return(NULL) } parts <- base::strsplit(str, " *, *", fixed = FALSE)[[1]] if (length(parts) == 0) { return(NULL) } result <- list() for (part in parts) { .assertIsValitOutputFormatOptionValue(optionKey, optionValue = part) keyValuePair <- base::strsplit(part, " *= *", fixed = FALSE)[[1]] key <- trimws(keyValuePair[1]) value <- trimws(keyValuePair[2]) if (key %in% c("digits", "nsmall")) { value <- as.integer(value) } else if (key %in% c("trimSingleZeroes", "futilityProbabilityEnabled")) { value <- as.logical(value) } result[[key]] <- value } return(result) } .getOptionBasedFormattedValue <- function(optionKey, value, digits, nsmall = NA_integer_, trimSingleZeroes = FALSE, futilityProbabilityEnabled = FALSE, roundFunction = NA_character_) { outputFormatOptions <- .getOutputFormatOptions(optionKey) if (is.null(outputFormatOptions) || length(outputFormatOptions) == 0) { return(NULL) } if (!is.null(outputFormatOptions[["digits"]])) { digits <- outputFormatOptions[["digits"]] } if (!is.null(outputFormatOptions[["nsmall"]])) { nsmall <- outputFormatOptions[["nsmall"]] } if (!is.null(outputFormatOptions[["trimSingleZeroes"]])) { trimSingleZeroes <- outputFormatOptions[["trimSingleZeroes"]] } if (!is.null(outputFormatOptions[["futilityProbabilityEnabled"]])) { futilityProbabilityEnabled <- outputFormatOptions[["futilityProbabilityEnabled"]] } if (!is.null(outputFormatOptions[["roundFunction"]])) { roundFunction <- outputFormatOptions[["roundFunction"]] } if (trimSingleZeroes) { value <- .getZeroCorrectedValue(value) } return(.getFormattedValue(value, digits = digits, nsmall = nsmall, futilityProbabilityEnabled = futilityProbabilityEnabled, roundFunction = roundFunction)) } # # @title # Format P Values # # @description # Formats the output of p-values. # # @details # Digits = 4, nsmall = 4. # Replaces p-values in scientific format (e.g., 1e-07) by a non-scientific format (e.g., <0.00001). # # @param value a vector of p-values. # .formatPValues <- function(value) { if (sum(is.na(value)) == length(value)) { return(value) } x <- .getOptionBasedFormattedValue("rpact.output.format.p.value", value = value, digits = 4, nsmall = 4) if (!is.null(x)) { return(x) } decimalPlaces <- .getPValueDecimalPlaces(value) if (is.na(decimalPlaces) || is.nan(decimalPlaces)) { decimalPlaces <- 4 } else if (decimalPlaces > 4) { decimalPlaces <- decimalPlaces - 1 } threshold <- 10^-decimalPlaces text <- "<0." for (i in 1:(decimalPlaces - 1)) { text <- paste0(text, "0") } text <- paste0(text, "1") indices <- (value < threshold) value[indices] <- threshold formattedValue <- .getFormattedValue(value, digits = 4, nsmall = 4) formattedValue[indices] <- text return(formattedValue) } # # @title # Format Repeated P Values # # @description # Formats the output of repeated p-values. # # @details # If p-value > 0.4999 then ">=0.5" will be returned. # # @param value a vector of p-values. # .formatRepeatedPValues <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.repeated.p.value", value = value, digits = 4, nsmall = 4) if (!is.null(x)) { return(x) } pValues <- .formatPValues(value) pValues[value > 0.4999] <- ">0.5" return(pValues) } # # @title # Format Probabilities # # @description # Formats the output of probabilities. # # @details # Digits = 4, nsmall = 4 # .formatProbabilities <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.probability", value = value, digits = 4, nsmall = 4) if (!is.null(x)) { return(x) } value[abs(value) < 1e-08] <- 0 return(.getFormattedValue(value, digits = 4, nsmall = 4)) } # # @title # Format Sample Sizes # # @description # Formats the output of sample sizes. # # @details # Digits = 1, nsmall = 1 # .formatSampleSizes <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.sample.size", value = value, digits = 1, nsmall = 1) if (!is.null(x)) { return(x) } return(.getFormattedValue(value, digits = 1, nsmall = 1)) } # # @title # Format Events # # @description # Formats the output of events. # # @details # Digits = 1, nsmall = 1, trimSingleZeroes = TRUE # .formatEvents <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.event", value = value, digits = 1, nsmall = 1, trimSingleZeroes = TRUE) if (!is.null(x)) { return(x) } return(.getFormattedValue(.getZeroCorrectedValue(value), digits = 1, nsmall = 1)) } # # @title # Format Conditional Power # # @description # Formats the output of contional power. # # @details # Digits = 4 # .formatConditionalPower <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.conditional.power", value = value, digits = 4) if (!is.null(x)) { return(x) } value <- round(value, digits = 4) conditionalPower <- .getFormattedValue(value, digits = 4) conditionalPower[value == 0] <- "0" return(conditionalPower) } # # @title # Format Futility Probabilities # # @description # Formats the output of futility probabilities. # # @details # Digits = 4, nsmall = 4 # .formatFutilityProbabilities <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.futility.probability", value = value, digits = 4, nsmall = 4, futilityProbabilityEnabled = TRUE) if (!is.null(x)) { return(x) } return(.getFormattedValue(value, digits = 4, nsmall = 4, futilityProbabilityEnabled = TRUE)) } # # @title # Format Group Sequential Critical Values # # @description # Formats the output of group sequential critical values. # # @details # Digits = 3, nsmall = 3 # .formatCriticalValues <- function(value) { value[value == C_FUTILITY_BOUNDS_DEFAULT] <- -Inf x <- .getOptionBasedFormattedValue("rpact.output.format.critical.value", value = value, digits = 3, nsmall = 3) if (!is.null(x)) { return(x) } return(.getFormattedValue(value, digits = 3, nsmall = 3)) } # # @title # Format Fisher Critical Values # # @description # Formats the output of Fisher's combination critical values. # # @details # Digits = 4 # .formatCriticalValuesFisher <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.critical.value.fisher", value = value, digits = 4) if (!is.null(x)) { return(x) } return(.getFormattedValue(value, digits = 4)) } # # @title # Format Fisher Test Statistics # # @description # Formats the output of Fisher's combination test statistics. # # @details # Digits = 4 # .formatTestStatisticsFisher <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.test.statistic.fisher", value = value, digits = 4) if (!is.null(x)) { return(x) } return(.getFormattedValue(value, digits = 4)) # , scientific = FALSE } # # @title # Format Test Statistics # # @description # Formats the output of test statistics (e.g., inverse normal). # # @details # Digits = 3, nsmall = 3 # .formatTestStatistics <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.test.statistic", value = value, digits = 3, nsmall = 3) if (!is.null(x)) { return(x) } return(.getFormattedValue(value, digits = 3, nsmall = 3)) # , scientific = FALSE } # # @title # Format Rates # # @description # Formats the output of rates. # # @details # Digits = 3, nsmall = 3 # .formatRates <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.rate", value = value, digits = 3, nsmall = 3) if (!is.null(x)) { return(x) } return(.getFormattedValue(value, digits = 3, nsmall = 3)) } # # @title # Format Rates Dynamic # # @description # Formats the output of rates. # # @details # Digits = 3, nsmall = 3 if value < 1; digits = 1, nsmall = 1 otherwise # .formatRatesDynamic <- function(value) { if (!any(is.na(value)) && all(value >= 1)) { x <- .getOptionBasedFormattedValue("rpact.output.format.rate1", value = value, digits = 1, nsmall = 1) if (!is.null(x)) { return(x) } return(.getFormattedValue(value, digits = 1, nsmall = 1)) } x <- .getOptionBasedFormattedValue("rpact.output.format.rate", value = value, digits = 3, nsmall = 3) if (!is.null(x)) { return(x) } return(.getFormattedValue(value, digits = 3, nsmall = 3)) } # # @title # Format Accrual Intensities # # @description # Formats the output of accrual intensities. # # @details # Digits = 1, nsmall = 1 # .formatAccrualIntensities <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.accrual.intensity", value = value, digits = 2, nsmall = 1) if (!is.null(x)) { return(x) } return(.getFormattedValue(value, digits = 2, nsmall = 1)) } # # @title # Format Means # # @description # Formats the output of means. # # @details # Digits = 4 # .formatMeans <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.mean", value = value, digits = 4) if (!is.null(x)) { return(x) } return(.getFormattedValue(value, digits = 4)) } # # @title # Format Ratios # # @description # Formats the output of ratios. # # @details # Digits = 3 # .formatRatios <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.ratio", value = value, digits = 3) if (!is.null(x)) { return(x) } return(.getFormattedValue(value, digits = 3)) } # # @title # Format StDevs # # @description # Formats the output of standard deviations. # # @details # Digits = 4 # .formatStDevs <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.st.dev", value = value, digits = 4) if (!is.null(x)) { return(x) } return(.getFormattedValue(value, digits = 4)) } # # @title # Format Durations # # @description # Formats the output of study durations. # # @details # Digits = 3 # .formatDurations <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.duration", value = value, digits = 2, nsmall = 2) if (!is.null(x)) { return(x) } return(.getFormattedValue(value, digits = 2, nsmall = 2)) } # # @title # Format Time # # @description # Formats the output of time values, e.g. months. # # @details # Digits = 3 # .formatTime <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.time", value = value, digits = 2, nsmall = 2) if (!is.null(x)) { return(x) } return(.getFormattedValue(value, digits = 2, nsmall = 2)) } # # @title # Format Time # # @description # Formats the output of time values, e.g. months. # # @details # Digits = 3 # .formatEventTime <- function(value) { x <- .getOptionBasedFormattedValue("rpact.output.format.event.time", value = value, digits = 3, trimSingleZeroes = TRUE) if (!is.null(x)) { return(x) } return(.getFormattedValue(.getZeroCorrectedValue(value), digits = 3)) } .formatHowItIs <- function(value) { return(format(value, scientific = FALSE)) } .getFormattedVariableName <- function(name, n, prefix = "", postfix = "") { if (!is.character(name)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'name' must be of type 'character' (is '", class(name), "')") } if (!is.numeric(n)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'n' must be of type 'numeric' (is '", class(n), "')") } if (n < 1 || n > 300) { stop(C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'n' (", n, ") is out of bounds [1; 300]") } if (nchar(prefix) > 0) { name <- paste(prefix, name) } if (nchar(postfix) > 0) { name <- paste0(name, postfix) } while (nchar(name) < n) { name <- paste0(name, " ") } name <- paste0(" ", name, " :") return(name) } #' @title #' Set Output Format #' #' @description #' With this function the format of the standard outputs of all \code{rpact} #' objects can be changed and set user defined respectively. #' #' @param parameterName The name of the parameter whose output format shall be edited. #' Leave the default \code{NA_character_} if #' the output format of all parameters shall be edited. #' @param digits How many significant digits are to be used for a numeric value. #' The default, \code{NULL}, uses getOption("digits"). #' Allowed values are \code{0 <= digits <= 20}. #' @param nsmall The minimum number of digits to the right of the decimal point in #' formatting real numbers in non-scientific formats. #' Allowed values are \code{0 <= nsmall <= 20}. #' @param trimSingleZeroes If \code{TRUE} zero values will be trimmed in the output, e.g., #' "0.00" will displayed as "0" #' @param futilityProbabilityEnabled If \code{TRUE} very small value (< 1e-09) will #' be displayed as "0", default is \code{FALSE}. #' @param file An optional file name of an existing text file that contains output format definitions #' (see Details for more information). #' @param resetToDefault If \code{TRUE} all output formats will be reset to default value. #' Note that other settings will be executed afterwards if specified, default is \code{FALSE}. #' @param roundFunction A character value that specifies the R base round function #' to use, default is \code{NA_character_}. #' Allowed values are "ceiling", "floor", "trunc", "round", "signif", and \code{NA_character_}. #' @inheritParams param_three_dots #' #' @details #' Output formats can be written to a text file (see \code{\link{getOutputFormat}}). #' To load your personal output formats read a formerly saved file at the beginning of your #' work with \code{rpact}, e.g. execute \code{setOutputFormat(file = "my_rpact_output_formats.txt")}. #' #' Note that the \code{parameterName} must not match exactly, e.g., for p-values the #' following parameter names will be recognized amongst others: #' \enumerate{ #' \item \code{p value} #' \item \code{p.values} #' \item \code{p-value} #' \item \code{pValue} #' \item \code{rpact.output.format.p.value} #' } #' #' @seealso \code{\link[base]{format}} for details on the #' function used internally to format the values. #' #' @template examples_set_output_format #' #' @family output formats #' #' @export #' setOutputFormat <- function( parameterName = NA_character_, ..., digits = NA_integer_, nsmall = NA_integer_, trimSingleZeroes = NA, futilityProbabilityEnabled = NA, file = NA_character_, resetToDefault = FALSE, roundFunction = NA_character_) { .assertIsCharacter(parameterName, "parameterName", naAllowed = TRUE) .assertIsSingleInteger(digits, "digits", naAllowed = TRUE, validateType = FALSE) .assertIsInClosedInterval(digits, "digits", lower = 0, upper = 20, naAllowed = TRUE) .assertIsSingleInteger(nsmall, "nsmall", naAllowed = TRUE, validateType = FALSE) .assertIsInClosedInterval(nsmall, "nsmall", lower = 0, upper = 20, naAllowed = TRUE) .assertIsSingleLogical(trimSingleZeroes, "trimSingleZeroes", naAllowed = TRUE) .assertIsSingleLogical(futilityProbabilityEnabled, "futilityProbabilityEnabled", naAllowed = TRUE) .assertIsSingleCharacter(file, "file", naAllowed = TRUE) .assertIsSingleLogical(resetToDefault, "resetToDefault") .assertIsSingleCharacter(roundFunction, "roundFunction", naAllowed = TRUE) .warnInCaseOfUnknownArguments(functionName = "setOutputFormat", ...) if (resetToDefault) { .resetAllOutputFormats() } if (!is.na(file)) { if (!file.exists(file)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'file' (", file, ") does not exist") } args <- list() outputFormatLines <- .readLinesFromFile(file) counter <- 0 for (line in outputFormatLines) { if (!grepl("^ *#", line)) { keyValuePair <- base::strsplit(line, " *: *", fixed = FALSE)[[1]] if (length(keyValuePair) == 2) { key <- .getOutputFormatKey(keyValuePair[1], silent = TRUE) if (!is.null(key)) { value <- trimws(keyValuePair[2]) .assertIsValitOutputFormatOptionValue(optionKey = key, optionValue = value) if (grepl("digits|nsmall|trimSingleZeroes|futilityProbabilityEnabled", value)) { args[[key]] <- value } else { warning('Line "', line, '" contains an invalid value: ', value) } } else { warning('Line "', line, '" contains an invalid key: ', keyValuePair[1]) } } else if (nchar(trimws(line)) > 0) { warning('Line "', line, '" does not contain a valid key-value-pair') } if (nchar(trimws(line)) > 0) { counter <- counter + 1 } } } if (length(args) > 0) { base::options(args) cat(length(args), ' (of ', counter, ' defined) output format', ifelse(length(args) == 1, '', 's'), ' successfully set via file\n', sep = '') } } if (!all(is.na(parameterName))) { for (param in parameterName) { key <- .getOutputFormatKeyByFieldName(param) if (is.null(key)) { key <- .getOutputFormatKey(param) } cmds <- c() if (!is.na(digits)) { cmds <- c(cmds, paste0("digits = ", digits)) } if (!is.na(nsmall)) { cmds <- c(cmds, paste0("nsmall = ", nsmall)) } if (!is.na(trimSingleZeroes)) { cmds <- c(cmds, paste0("trimSingleZeroes = ", trimSingleZeroes)) } if (!is.na(futilityProbabilityEnabled)) { cmds <- c(cmds, paste0("futilityProbabilityEnabled = ", futilityProbabilityEnabled)) } if (!is.na(roundFunction)) { cmds <- c(cmds, paste0("roundFunction = ", roundFunction)) } cmd <- NULL resetPrefix <- "" if (length(cmds) > 0) { cmd <- paste0(cmds, collapse = ", ") } else { cmd <- C_OUTPUT_FORMAT_DEFAULT_VALUES[[key]] resetPrefix <- "re" } args <- list() args[[key]] <- cmd base::options(args) cat('Output format successfully ', resetPrefix, 'set: "', key, '" = "', cmd, '"\n', sep = '') fields <- .getOutputFormatParameterNames(key) if (!is.null(fields) && length(fields) > 0) { if (length(fields) == 1) { cat('This output format affects the following parameter:', fields, '\n') } else { cat('This output format affects ', length(fields), ' parameters: ', .arrayToString(fields), '\n', sep = '') } } else { warning('The output format ', key, ' affects no parameters', call. = FALSE) } } } } .getOutputFormatKey <- function(parameterName, silent = FALSE) { .assertIsSingleCharacter(parameterName, "parameterName") if (grepl("^rpact\\.output\\.format\\.[a-z1\\.]*", parameterName)) { value <- C_OUTPUT_FORMAT_DEFAULT_VALUES[[parameterName]] if (is.null(value)) { if (silent) { return(NULL) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterName' (", parameterName, ") does not exist") } return(parameterName) } x <- tolower(parameterName) keys <- names(C_OUTPUT_FORMAT_DEFAULT_VALUES) for (key in keys) { keyRegex <- sub("^rpact\\.output\\.format\\.", "", key) keyRegex <- gsub("\\.asn$", ".(asn|average.sample.number)", keyRegex) keyRegex <- gsub("^simulation\\.result$", "simulation.(results?)?", keyRegex) keyRegex <- gsub("^st\\.", "st(andard)?.", keyRegex) keyRegex <- gsub("\\.dev$", ".dev(iation)?", keyRegex) keyRegex <- gsub("\\.", " ?(\\.|-)? ?", keyRegex) keyRegex <- gsub("1", "s? ?(\\.|-)? ?1", keyRegex) keyRegex <- sub("y$", "(y|ies)", keyRegex) if (grepl("(e|t|c|n|o)$", keyRegex)) { keyRegex <- paste0(keyRegex, "s?") } keyRegex <- paste0("^", keyRegex, "$") if (grepl(keyRegex, x)) { return(key) } } if (silent) { return(NULL) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "output format key for 'parameterName' (", parameterName, ") could not be found") } .writeOutputFormatsToFile <- function(outputFormatList, file) { outputFormatLines <- c() outputFormatLines <- c(outputFormatLines, "##") outputFormatLines <- c(outputFormatLines, "## rpact output formats") outputFormatLines <- c(outputFormatLines, "## www.rpact.com") outputFormatLines <- c(outputFormatLines, paste0("## creation date: ", format(Sys.time(), "%d %b %Y, %X"))) outputFormatLines <- c(outputFormatLines, "##") for (key in names(outputFormatList)) { outputFormatLines <- c(outputFormatLines, paste(key, ":", outputFormatList[[key]])) } .writeLinesToFile(outputFormatLines, file) cat(length(outputFormatList), ' output format', ifelse(length(args) == 1, '', 's'), ' successfully written to file\n', sep = '') } #' @title #' Get Output Format #' #' @description #' With this function the format of the standard outputs of all \code{rpact} #' objects can be shown and written to a file. #' #' @param parameterName The name of the parameter whose output format shall be returned. #' Leave the default \code{NA_character_} if #' the output format of all parameters shall be returned. #' @param file An optional file name where to write the output formats #' (see Details for more information). #' @param default If \code{TRUE} the default output format of the specified parameter(s) #' will be returned, default is \code{FALSE}. #' @param fields If \code{TRUE} the names of all affected object fields will be displayed, default is \code{TRUE}. #' @inheritParams param_three_dots #' #' @details #' Output formats can be written to a text file by specifying a \code{file}. #' See \code{\link{setOutputFormat}}() to learn how to read a formerly saved file. #' #' Note that the \code{parameterName} must not match exactly, e.g., for p-values the #' following parameter names will be recognized amongst others: #' \enumerate{ #' \item \code{p value} #' \item \code{p.values} #' \item \code{p-value} #' \item \code{pValue} #' \item \code{rpact.output.format.p.value} #' } #' #' @return A named list of output formats. #' #' @template examples_set_output_format #' #' @family output formats #' #' @export #' getOutputFormat <- function(parameterName = NA_character_, ..., file = NA_character_, default = FALSE, fields = TRUE) { if (all(is.na(parameterName)) || length(parameterName) <= 1) { return(.getOutputFormat(parameterName = parameterName, file = file, default = default, fields = fields, ...)) } .assertIsSingleCharacter(file, "file", naAllowed = TRUE) .assertIsSingleLogical(fields, "fields") results <- c() currentOutputFormats <- c() for (p in parameterName) { results <- c(results, .getOutputFormat(parameterName = p, file = NA_character_, default = default, fields = fields, ...)) if (!is.na(file)) { currentOutputFormats <- c(currentOutputFormats, .getOutputFormat(parameterName = p, file = NA_character_, default = default, fields = FALSE, ...)) } } if (!is.na(file)) { .writeOutputFormatsToFile(currentOutputFormats, file) } return(results) } .getOutputFormat <- function(parameterName = NA_character_, ..., file = NA_character_, default = FALSE, fields = TRUE) { .assertIsSingleCharacter(parameterName, "parameterName", naAllowed = TRUE) .assertIsSingleCharacter(file, "file", naAllowed = TRUE) .assertIsSingleLogical(default, "default") .assertIsSingleLogical(fields, "fields") .warnInCaseOfUnknownArguments(functionName = "getOutputFormat", ...) currentOutputFormats <- pairlist() if (is.na(parameterName)) { if (default) { currentOutputFormats <- C_OUTPUT_FORMAT_DEFAULT_VALUES } else { for (key in names(C_OUTPUT_FORMAT_DEFAULT_VALUES)) { currentOutputFormats[[key]] <- getOption(key, default = C_OUTPUT_FORMAT_DEFAULT_VALUES[[key]]) } } if (!is.na(file)) { .writeOutputFormatsToFile(currentOutputFormats, file) return(invisible(.addFieldsToOutputFormatList(currentOutputFormats, fields))) } return(.addFieldsToOutputFormatList(currentOutputFormats, fields)) } key <- .getOutputFormatKey(parameterName) if (default) { value <- C_OUTPUT_FORMAT_DEFAULT_VALUES[[key]] } else { value <- getOption(key, default = C_OUTPUT_FORMAT_DEFAULT_VALUES[[key]]) } currentOutputFormats[[key]] <- value if (!is.na(file)) { .writeOutputFormatsToFile(currentOutputFormats, file) } return(.addFieldsToOutputFormatList(currentOutputFormats, fields)) } .addFieldsToOutputFormatList <- function(outputFormatList, fields = TRUE) { if (!fields) { return(outputFormatList) } results <- list() for (key in names(outputFormatList)) { results[[key]] <- list( format = outputFormatList[[key]], fields = .getOutputFormatParameterNames(key)) } return(results) } .getOutputFormatParameterNames <- function(key) { functionName <- .getOutputFormatFunctionName(key) if (is.null(functionName)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'key' (", key, ") does not exist") } parameterNames <- c() for (parameterName in names(C_PARAMETER_FORMAT_FUNCTIONS)) { if (functionName == C_PARAMETER_FORMAT_FUNCTIONS[[parameterName]]) { parameterNames <- c(parameterNames, parameterName) } } if (key == "rpact.output.format.rate") { return(c(parameterNames, .getOutputFormatParameterNames("rpact.output.format.rate1"))) } return(parameterNames) } .getOutputFormatFunctionName <- function(key) { if (key == "rpact.output.format.p.value") { return(".formatPValues") } if (key == "rpact.output.format.repeated.p.value") { return(".formatRepeatedPValues") } if (key == "rpact.output.format.probability") { return(".formatProbabilities") } if (key == "rpact.output.format.futility.probability") { return(".formatFutilityProbabilities") } if (key == "rpact.output.format.sample.size") { return(".formatSampleSizes") } if (key == "rpact.output.format.event") { return(".formatEvents") } if (key == "rpact.output.format.event.time") { return(".formatEventTime") } if (key == "rpact.output.format.conditional.power") { return(".formatConditionalPower") } if (key == "rpact.output.format.critical.value") { return(".formatCriticalValues") } if (key == "rpact.output.format.critical.value.fisher") { return(".formatCriticalValuesFisher") } if (key == "rpact.output.format.test.statistic.fisher") { return(".formatTestStatisticsFisher") } if (key == "rpact.output.format.test.statistic") { return(".formatTestStatistics") } if (key == "rpact.output.format.rate") { return(".formatRates") } if (key == "rpact.output.format.rate1") { return(".formatRatesDynamic") } if (key == "rpact.output.format.accrual.intensity") { return(".formatAccrualIntensities") } if (key == "rpact.output.format.mean") { return(".formatMeans") } if (key == "rpact.output.format.ratio") { return(".formatRatios") } if (key == "rpact.output.format.st.dev") { return(".formatStDevs") } if (key == "rpact.output.format.duration") { return(".formatDurations") } if (key == "rpact.output.format.time") { return(".formatTime") } return(NULL) } .getOutputFormatKeyByFieldName <- function(fieldName) { functionName <- C_PARAMETER_FORMAT_FUNCTIONS[[fieldName]] if (is.null(functionName)) { return(NULL) } return(.getOutputFormatKeyByFunctionName(functionName)) } .getOutputFormatKeyByFunctionName <- function(functionName) { for (key in names(C_OUTPUT_FORMAT_DEFAULT_VALUES)) { if (.getOutputFormatFunctionName(key) == functionName) { return(key) } } return(NULL) } .resetAllOutputFormats <- function() { base::options(C_OUTPUT_FORMAT_DEFAULT_VALUES) cat(length(C_OUTPUT_FORMAT_DEFAULT_VALUES), "output formats were successfully reset\n") } rpact/R/f_simulation_multiarm.R0000644000175000017500000011371014150167045016452 0ustar nileshnilesh## | ## | *Simulation of multi-arm design with combination test and conditional error approach* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5594 $ ## | Last changed: $Date: 2021-11-26 15:24:35 +0100 (Fr, 26 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | .getIndicesOfClosedHypothesesSystemForSimulation <- function(gMax) { indices <- as.matrix(expand.grid(rep(list(1:0), gMax)))[1:(2^gMax - 1), ] if (gMax == 1) { indices <- as.matrix(indices) } return(indices) } .selectTreatmentArms <- function(stage, effectVector, typeOfSelection, epsilonValue, rValue, threshold, selectArmsFunction, survival = FALSE) { gMax <- length(effectVector) if (typeOfSelection != "userDefined") { if (typeOfSelection == "all") { selectedArms <- rep(TRUE, gMax) } else { selectedArms <- rep(FALSE, gMax) if (typeOfSelection == "best") { selectedArms[which.max(effectVector)] <- TRUE } else if (tolower(typeOfSelection) == "rbest") { selectedArms[order(effectVector, decreasing = TRUE)[1:rValue]] <- TRUE selectedArms[is.na(effectVector)] <- FALSE } else if (typeOfSelection == "epsilon") { selectedArms[max(effectVector, na.rm = TRUE) - effectVector <= epsilonValue] <- TRUE selectedArms[is.na(effectVector)] <- FALSE } } selectedArms[effectVector <= threshold] <- FALSE } else { functionArgumentNames <- .getFunctionArgumentNames(selectArmsFunction, ignoreThreeDots = TRUE) if (length(functionArgumentNames) == 1) { .assertIsValidFunction( fun = selectArmsFunction, funArgName = "selectArmsFunction", expectedArguments = c("effectVector"), validateThreeDots = FALSE ) selectedArms <- selectArmsFunction(effectVector) } else { .assertIsValidFunction( fun = selectArmsFunction, funArgName = "selectArmsFunction", expectedArguments = c("effectVector", "stage"), validateThreeDots = FALSE ) selectedArms <- selectArmsFunction(effectVector = effectVector, stage = stage) } msg <- paste0( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'selectArmsFunction' returned an illegal or undefined result (", .arrayToString(selectedArms), "); " ) if (length(selectedArms) != gMax) { stop(msg, "the output must be a logical vector of length 'gMax' (", gMax, ")") } if (!is.logical(selectedArms)) { stop(msg, "the output must be a logical vector (is ", class(selectedArms), ")") } } if (!survival) { selectedArms <- c(selectedArms, TRUE) } return(selectedArms) } .performClosedCombinationTestForSimulationMultiArm <- function(..., stageResults, design, indices, intersectionTest, successCriterion) { if (.isTrialDesignGroupSequential(design) && (design$kMax > 1)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "Group sequential design cannot be used for designs with treatment arm selection" ) } gMax <- nrow(stageResults$testStatistics) kMax <- design$kMax adjustedStageWisePValues <- matrix(NA_real_, nrow = 2^gMax - 1, ncol = kMax) overallAdjustedTestStatistics <- matrix(NA_real_, nrow = 2^gMax - 1, ncol = kMax) rejected <- matrix(FALSE, nrow = gMax, ncol = kMax) rejectedIntersections <- matrix(FALSE, nrow = nrow(indices), ncol = kMax) futility <- matrix(FALSE, nrow = gMax, ncol = kMax - 1) futilityIntersections <- matrix(FALSE, nrow = nrow(indices), ncol = kMax - 1) rejectedIntersectionsBefore <- matrix(FALSE, nrow = nrow(indices), ncol = 1) successStop <- rep(FALSE, kMax) futilityStop <- rep(FALSE, kMax - 1) if (.isTrialDesignFisher(design)) { weightsFisher <- .getWeightsFisher(design) } else { weightsInverseNormal <- .getWeightsInverseNormal(design) } if (gMax == 1) { intersectionTest <- "Bonferroni" } separatePValues <- stageResults$separatePValues if (intersectionTest == "Dunnett") { subjectsPerStage <- stageResults[[ifelse( !is.null(stageResults[["subjectsPerStage"]]), "subjectsPerStage", "eventsPerStage" )]] testStatistics <- stageResults$testStatistics } else { subjectsPerStage <- NULL testStatistics <- NULL } for (k in 1:kMax) { if (intersectionTest == "Dunnett") { allocationRatiosPerStage <- rep(stageResults$allocationRatioPlanned, gMax) allocationRatiosPerStage[is.na(subjectsPerStage[1:gMax, k])] <- NA_real_ } for (i in 1:(2^gMax - 1)) { if (!all(is.na(separatePValues[indices[i, ] == 1, k]))) { if (intersectionTest == "Dunnett") { allocationRatiosSelected <- as.numeric(na.omit(allocationRatiosPerStage[indices[i, ] == 1])) sigma <- sqrt(allocationRatiosSelected / (1 + allocationRatiosSelected)) %*% sqrt(t(allocationRatiosSelected / (1 + allocationRatiosSelected))) diag(sigma) <- 1 maxTestStatistic <- max(testStatistics[indices[i, ] == 1, k], na.rm = TRUE) adjustedStageWisePValues[i, k] <- 1 - .getMultivariateDistribution( type = "normal", upper = maxTestStatistic, sigma = sigma, df = NA_real_ ) } # Bonferroni adjusted p-values else if (intersectionTest == "Bonferroni") { adjustedStageWisePValues[i, k] <- min(c(sum(indices[ i, !is.na(separatePValues[, k]) ]) * min(separatePValues[indices[i, ] == 1, k], na.rm = TRUE), 1)) } # Simes adjusted p-values else if (intersectionTest == "Simes") { adjustedStageWisePValues[i, k] <- min(sum(indices[ i, !is.na(separatePValues[, k]) ]) / (1:sum(indices[i, !is.na(separatePValues[, k])])) * sort(separatePValues[indices[i, ] == 1, k])) } # Sidak adjusted p-values else if (intersectionTest == "Sidak") { adjustedStageWisePValues[i, k] <- 1 - (1 - min(separatePValues[indices[i, ] == 1, k], na.rm = TRUE))^ sum(indices[i, !is.na(separatePValues[, k])]) } # Hierarchically ordered hypotheses else if (intersectionTest == "Hierarchical") { separatePValues <- separatePValues separatePValues[is.na(separatePValues[, 1:kMax])] <- 1 adjustedStageWisePValues[i, k] <- separatePValues[min(which(indices[i, ] == 1)), k] } if (.isTrialDesignFisher(design)) { overallAdjustedTestStatistics[i, k] <- prod(adjustedStageWisePValues[i, 1:k]^weightsFisher[1:k]) } else { overallAdjustedTestStatistics[i, k] <- (weightsInverseNormal[1:k] %*% .getOneMinusQNorm(adjustedStageWisePValues[i, 1:k])) / sqrt(sum(weightsInverseNormal[1:k]^2)) } } if (.isTrialDesignFisher(design)) { rejectedIntersections[i, k] <- (overallAdjustedTestStatistics[i, k] <= design$criticalValues[k]) if (k < kMax) { futilityIntersections[i, k] <- (adjustedStageWisePValues[i, k] >= design$alpha0Vec[k]) } } else if (.isTrialDesignInverseNormal(design)) { rejectedIntersections[i, k] <- (overallAdjustedTestStatistics[i, k] >= design$criticalValues[k]) if (k < kMax) { futilityIntersections[i, k] <- (overallAdjustedTestStatistics[i, k] <= design$futilityBounds[k]) } } rejectedIntersections[is.na(rejectedIntersections[, k]), k] <- FALSE if ((k == kMax) && !rejectedIntersections[1, k]) { break } } rejectedIntersections[, k] <- rejectedIntersections[, k] | rejectedIntersectionsBefore rejectedIntersectionsBefore <- matrix(rejectedIntersections[, k], ncol = 1) for (j in 1:gMax) { rejected[j, k] <- all(rejectedIntersections[indices[, j] == 1, k], na.rm = TRUE) if (k < kMax) { futility[j, k] <- any(futilityIntersections[indices[, j] == 1, k], na.rm = TRUE) } } if (successCriterion == "all") { successStop[k] <- all(rejected[stageResults$selectedArms[1:gMax, k], k]) } else { successStop[k] <- any(rejected[, k]) } if (k < kMax) { futilityStop[k] <- all(futility[stageResults$selectedArms[1:gMax, k], k]) if (all(stageResults$selectedArms[1:gMax, k + 1] == FALSE)) { futilityStop[k] <- TRUE } } } return(list( separatePValues = separatePValues, adjustedStageWisePValues = adjustedStageWisePValues, overallAdjustedTestStatistics = overallAdjustedTestStatistics, rejected = rejected, rejectedIntersections = rejectedIntersections, selectedArms = stageResults$selectedArms, successStop = successStop, futilityStop = futilityStop )) } .getCriticalValuesDunnettForSimulation <- function(alpha, indices, allocationRatioPlanned) { gMax <- ncol(indices) frac <- rep(allocationRatioPlanned, gMax) / (1 + allocationRatioPlanned) criticalValuesDunnett <- rep(NA_real_, 2^gMax - 1) for (i in 1:(2^gMax - 1)) { zeta <- sqrt(frac[indices[i, ] == 1]) sigma <- zeta %*% t(zeta) diag(sigma) <- 1 criticalValuesDunnett[i] <- .getMultivariateDistribution( type = "quantile", upper = NA_real_, sigma = sigma, alpha = alpha ) } return(criticalValuesDunnett) } .performClosedConditionalDunnettTestForSimulation <- function(stageResults, design, indices, criticalValuesDunnett, successCriterion) { testStatistics <- stageResults$testStatistics separatePValues <- stageResults$separatePValues subjectsPerStage <- stageResults$subjectsPerStage overallTestStatistics <- stageResults$overallTestStatistics gMax <- nrow(testStatistics) informationAtInterim <- design$informationAtInterim secondStageConditioning <- design$secondStageConditioning kMax <- 2 frac <- rep(stageResults$allocationRatioPlanned, gMax) / (1 + stageResults$allocationRatioPlanned) conditionalErrorRate <- matrix(NA_real_, nrow = 2^gMax - 1, ncol = 2) secondStagePValues <- matrix(NA_real_, nrow = 2^gMax - 1, ncol = 2) rejected <- matrix(FALSE, nrow = gMax, ncol = 2) rejectedIntersections <- matrix(FALSE, nrow = nrow(indices), ncol = kMax) futilityStop <- FALSE successStop <- rep(FALSE, kMax) signedTestStatistics <- testStatistics signedOverallTestStatistics <- overallTestStatistics signedOverallTestStatistics[, 2] <- sqrt(informationAtInterim) * testStatistics[, 1] + sqrt(1 - informationAtInterim) * testStatistics[, 2] if (all(stageResults$selectedArms[1:gMax, 2] == FALSE)) { futilityStop <- TRUE } for (i in 1:(2^gMax - 1)) { integrand <- function(x) { innerProduct <- 1 for (g in (1:gMax)) { if (indices[i, g] == 1) { innerProduct <- innerProduct * stats::pnorm(((criticalValuesDunnett[i] - sqrt(informationAtInterim) * signedTestStatistics[g, 1] + sqrt(1 - informationAtInterim) * sqrt(frac[g]) * x)) / sqrt((1 - informationAtInterim) * (1 - frac[g]))) } } return(innerProduct * dnorm(x)) } conditionalErrorRate[i, 1] <- 1 - integrate(integrand, lower = -Inf, upper = Inf)$value if (!all(is.na(separatePValues[indices[i, ] == 1, 2]))) { if (secondStageConditioning) { maxOverallTestStatistic <- max( signedOverallTestStatistics[indices[i, ] == 1, 2], na.rm = TRUE ) integrand <- function(x) { innerProduct <- 1 for (g in (1:gMax)) { if ((indices[i, g] == 1) && !is.na(overallTestStatistics[g, 2])) { innerProduct <- innerProduct * stats::pnorm(((maxOverallTestStatistic - sqrt(informationAtInterim) * signedTestStatistics[g, 1] + sqrt(1 - informationAtInterim) * sqrt(frac[g]) * x)) / sqrt((1 - informationAtInterim) * (1 - frac[g]))) } } return(innerProduct * dnorm(x)) } secondStagePValues[i, 2] <- 1 - integrate(integrand, lower = -Inf, upper = Inf)$value } else { maxTestStatistic <- max(signedTestStatistics[indices[i, ] == 1, 2], na.rm = TRUE) integrand <- function(x) { innerProduct <- 1 for (g in (1:gMax)) { if ((indices[i, g] == 1) && !is.na(separatePValues[g, 2])) { innerProduct <- innerProduct * stats::pnorm(((maxTestStatistic + sqrt(frac[g]) * x)) / sqrt(1 - frac[g])) } } return(innerProduct * dnorm(x)) } secondStagePValues[i, 2] <- 1 - integrate(integrand, lower = -Inf, upper = Inf)$value } } rejectedIntersections[i, 2] <- (secondStagePValues[i, 2] <= conditionalErrorRate[i, 1]) rejectedIntersections[is.na(rejectedIntersections[, 2]), 2] <- FALSE if (!rejectedIntersections[1, 2]) { break } } for (j in 1:gMax) { rejected[j, 2] <- all(rejectedIntersections[indices[, j] == 1, 2], na.rm = TRUE) } if (successCriterion == "all") { successStop[2] <- all(rejected[stageResults$selectedArms[1:gMax, 2], 2]) } else { successStop[2] <- any(rejected[, 2]) } return(list( separatePValues = separatePValues, conditionalErrorRate = conditionalErrorRate, secondStagePValues = secondStagePValues, rejected = rejected, rejectedIntersections = rejectedIntersections, selectedArms = stageResults$selectedArms, successStop = successStop, futilityStop = futilityStop )) } .createSimulationResultsMultiArmObject <- function(..., design, activeArms, effectMatrix, typeOfShape, muMaxVector = NA_real_, # means only piMaxVector = NA_real_, # rates only piControl = NA_real_, # rates only omegaMaxVector = NA_real_, # survival only gED50, slope, intersectionTest, stDev = NA_real_, # means only directionUpper = NA, # rates + survival only adaptations, typeOfSelection, effectMeasure, successCriterion, epsilonValue, rValue, threshold, plannedSubjects = NA_real_, # means + rates only plannedEvents = NA_real_, # survival only allocationRatioPlanned, minNumberOfSubjectsPerStage = NA_real_, # means + rates only maxNumberOfSubjectsPerStage = NA_real_, # means + rates only minNumberOfEventsPerStage = NA_real_, # survival only maxNumberOfEventsPerStage = NA_real_, # survival only conditionalPower, thetaH1 = NA_real_, # means + survival only stDevH1 = NA_real_, # means only piH1 = NA_real_, # rates only piControlH1 = NA_real_, # rates only maxNumberOfIterations, seed, calcSubjectsFunction = NULL, # means + rates only calcEventsFunction = NULL, # survival only selectArmsFunction, showStatistics, endpoint = c("means", "rates", "survival")) { endpoint <- match.arg(endpoint) .assertIsSinglePositiveInteger(activeArms, "activeArms", naAllowed = FALSE, validateType = FALSE) if (activeArms > 8) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'activeArms' (", activeArms, ") max not exceed 8") } .assertIsSingleNumber(threshold, "threshold", naAllowed = FALSE) .assertIsSingleNumber(gED50, "gED50", naAllowed = TRUE) .assertIsInOpenInterval(gED50, "gED50", 0, NULL, naAllowed = TRUE) .assertIsSingleNumber(slope, "slope", naAllowed = TRUE) .assertIsInOpenInterval(slope, "slope", 0, NULL, naAllowed = TRUE) .assertIsSinglePositiveInteger(rValue, "rValue", naAllowed = TRUE, validateType = FALSE) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned", naAllowed = TRUE) .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM, naAllowed = TRUE) .assertIsSingleNumber(conditionalPower, "conditionalPower", naAllowed = TRUE) .assertIsInOpenInterval(conditionalPower, "conditionalPower", 0, 1, naAllowed = TRUE) .assertIsLogicalVector(adaptations, "adaptations", naAllowed = TRUE) if (endpoint %in% c("means", "rates")) { .assertIsNumericVector(minNumberOfSubjectsPerStage, "minNumberOfSubjectsPerStage", naAllowed = TRUE) .assertIsNumericVector(maxNumberOfSubjectsPerStage, "maxNumberOfSubjectsPerStage", naAllowed = TRUE) } else if (endpoint == "survival") { .assertIsNumericVector(minNumberOfEventsPerStage, "minNumberOfEventsPerStage", naAllowed = TRUE) .assertIsNumericVector(maxNumberOfEventsPerStage, "maxNumberOfEventsPerStage", naAllowed = TRUE) } .assertIsSinglePositiveInteger(maxNumberOfIterations, "maxNumberOfIterations", validateType = FALSE) .assertIsSingleLogical(showStatistics, "showStatistics", naAllowed = FALSE) .assertIsSingleNumber(seed, "seed", naAllowed = TRUE) if (endpoint %in% c("rates", "survival")) { .assertIsSingleLogical(directionUpper, "directionUpper") } if (endpoint %in% c("means", "survival")) { .assertIsSingleNumber(thetaH1, "thetaH1", naAllowed = TRUE) # means + survival only } if (endpoint == "means") { .assertIsValidStandardDeviation(stDev) # means only .assertIsSingleNumber(stDevH1, "stDevH1", naAllowed = TRUE) .assertIsInOpenInterval(stDevH1, "stDevH1", 0, NULL, naAllowed = TRUE) } successCriterion <- .assertIsValidSuccessCriterion(successCriterion) effectMeasure <- .assertIsValidEffectMeasure(effectMeasure) if (endpoint == "means") { simulationResults <- SimulationResultsMultiArmMeans(design, showStatistics = showStatistics) } else if (endpoint == "rates") { simulationResults <- SimulationResultsMultiArmRates(design, showStatistics = showStatistics) } else if (endpoint == "survival") { simulationResults <- SimulationResultsMultiArmSurvival(design, showStatistics = showStatistics) } gMax <- activeArms kMax <- design$kMax intersectionTest <- .getCorrectedIntersectionTestMultiArmIfNecessary( design, intersectionTest, userFunctionCallEnabled = TRUE ) .assertIsValidIntersectionTestMultiArm(design, intersectionTest) typeOfSelection <- .assertIsValidTypeOfSelection(typeOfSelection, rValue, epsilonValue, activeArms) if (length(typeOfSelection) == 1 && typeOfSelection == "userDefined" && !is.null(threshold) && length(threshold) == 1 && threshold != -Inf) { warning("'threshold' (", threshold, ") will be ignored because 'typeOfSelection' = \"userDefined\"", call. = FALSE) threshold <- -Inf } if (length(typeOfSelection) == 1 && typeOfSelection != "userDefined" && !is.null(selectArmsFunction)) { warning("'selectArmsFunction' will be ignored because 'typeOfSelection' is not \"userDefined\"", call. = FALSE) } else if (!is.null(selectArmsFunction) && is.function(selectArmsFunction)) { simulationResults$selectArmsFunction <- selectArmsFunction } typeOfShape <- .assertIsValidTypeOfShape(typeOfShape) if (endpoint %in% c("rates", "survival")) { .setValueAndParameterType(simulationResults, "directionUpper", directionUpper, TRUE) } if (endpoint == "means") { effectMatrix <- .assertIsValidEffectMatrixMeans( typeOfShape = typeOfShape, effectMatrix = effectMatrix, muMaxVector = muMaxVector, gED50 = gED50, gMax = gMax, slope = slope ) if (typeOfShape == "userDefined") { muMaxVector <- effectMatrix[, 1] } else { .assertIsNumericVector(muMaxVector, "muMaxVector") } .setValueAndParameterType( simulationResults, "muMaxVector", muMaxVector, C_ALTERNATIVE_POWER_SIMULATION_DEFAULT ) if (typeOfShape == "userDefined") { simulationResults$.setParameterType("muMaxVector", C_PARAM_DERIVED) } } else if (endpoint == "rates") { .assertIsSingleNumber(piH1, "piH1", naAllowed = TRUE) .assertIsInOpenInterval(piH1, "piH1", 0, 1, naAllowed = TRUE) piH1 <- .ignoreParameterIfNotUsed( "piH1", piH1, kMax > 1, "design is fixed ('kMax' = 1)", "Assumed active rate(s)" ) .setValueAndParameterType(simulationResults, "piH1", piH1, NA_real_) .assertIsSingleNumber(piControl, "piControl", naAllowed = FALSE) # , noDefaultAvailable = TRUE) .assertIsInOpenInterval(piControl, "piControl", 0, 1, naAllowed = FALSE) .setValueAndParameterType(simulationResults, "piControl", piControl, 0.2) piControlH1 <- .ignoreParameterIfNotUsed( "piControlH1", piControlH1, kMax > 1, "design is fixed ('kMax' = 1)", "Assumed control rate" ) .assertIsSingleNumber(piControlH1, "piControlH1", naAllowed = TRUE) .assertIsInOpenInterval(piControlH1, "piControlH1", 0, 1, naAllowed = TRUE) .setValueAndParameterType(simulationResults, "piControlH1", piControlH1, NA_real_) effectMatrix <- .assertIsValidEffectMatrixRates( typeOfShape = typeOfShape, effectMatrix = effectMatrix, piMaxVector = piMaxVector, piControl = piControl, gED50 = gED50, gMax = gMax, slope = slope ) if (typeOfShape == "userDefined") { piMaxVector <- effectMatrix[, 1] } .setValueAndParameterType(simulationResults, "piMaxVector", piMaxVector, C_PI_1_DEFAULT) if (typeOfShape == "userDefined") { simulationResults$.setParameterType("piMaxVector", C_PARAM_DERIVED) } } else if (endpoint == "survival") { effectMatrix <- .assertIsValidEffectMatrixSurvival(typeOfShape, effectMatrix, omegaMaxVector, gED50, gMax, slope) if (typeOfShape == "userDefined") { omegaMaxVector <- effectMatrix[, 1] } .setValueAndParameterType(simulationResults, "omegaMaxVector", omegaMaxVector, C_RANGE_OF_HAZARD_RATIOS_DEFAULT) if (typeOfShape == "userDefined") { simulationResults$.setParameterType("omegaMaxVector", C_PARAM_DERIVED) } .assertIsIntegerVector(plannedEvents, "plannedEvents", validateType = FALSE) if (length(plannedEvents) != kMax) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'plannedEvents' (", .arrayToString(plannedEvents), ") must have length ", kMax ) } .assertIsInClosedInterval(plannedEvents, "plannedEvents", lower = 1, upper = NULL) .assertValuesAreStrictlyIncreasing(plannedEvents, "plannedEvents") .setValueAndParameterType(simulationResults, "plannedEvents", plannedEvents, NA_real_) } .assertIsValidThreshold(threshold, gMax) if (endpoint %in% c("means", "rates")) { .assertIsValidPlannedSubjects(plannedSubjects, kMax) # means + rates only } if (endpoint %in% c("means", "survival")) { thetaH1 <- .ignoreParameterIfNotUsed( "thetaH1", thetaH1, kMax > 1, "design is fixed ('kMax' = 1)", "Assumed effect" ) } if (endpoint == "means") { stDevH1 <- .ignoreParameterIfNotUsed( "stDevH1", stDevH1, kMax > 1, "design is fixed ('kMax' = 1)", "Assumed standard deviation" ) } conditionalPower <- .ignoreParameterIfNotUsed( "conditionalPower", conditionalPower, kMax > 1, "design is fixed ('kMax' = 1)" ) if (endpoint %in% c("means", "rates")) { # means + rates only minNumberOfSubjectsPerStage <- .ignoreParameterIfNotUsed( "minNumberOfSubjectsPerStage", minNumberOfSubjectsPerStage, kMax > 1, "design is fixed ('kMax' = 1)" ) minNumberOfSubjectsPerStage <- .assertIsValidNumberOfSubjectsPerStage(minNumberOfSubjectsPerStage, "minNumberOfSubjectsPerStage", plannedSubjects, conditionalPower, calcSubjectsFunction, kMax, endpoint = endpoint ) maxNumberOfSubjectsPerStage <- .ignoreParameterIfNotUsed( "maxNumberOfSubjectsPerStage", maxNumberOfSubjectsPerStage, kMax > 1, "design is fixed ('kMax' = 1)" ) maxNumberOfSubjectsPerStage <- .assertIsValidNumberOfSubjectsPerStage(maxNumberOfSubjectsPerStage, "maxNumberOfSubjectsPerStage", plannedSubjects, conditionalPower, calcSubjectsFunction, kMax, endpoint = endpoint ) if (kMax > 1) { if (!all(is.na(maxNumberOfSubjectsPerStage - minNumberOfSubjectsPerStage)) && any(maxNumberOfSubjectsPerStage - minNumberOfSubjectsPerStage < 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjectsPerStage' (", .arrayToString(maxNumberOfSubjectsPerStage), ") must be not smaller than minNumberOfSubjectsPerStage' (", .arrayToString(minNumberOfSubjectsPerStage), ")" ) } .setValueAndParameterType( simulationResults, "minNumberOfSubjectsPerStage", minNumberOfSubjectsPerStage, NA_real_ ) .setValueAndParameterType( simulationResults, "maxNumberOfSubjectsPerStage", maxNumberOfSubjectsPerStage, NA_real_ ) } } else if (endpoint == "survival") { minNumberOfEventsPerStage <- .ignoreParameterIfNotUsed( "minNumberOfEventsPerStage", minNumberOfEventsPerStage, kMax > 1, "design is fixed ('kMax' = 1)" ) minNumberOfEventsPerStage <- .assertIsValidNumberOfSubjectsPerStage(minNumberOfEventsPerStage, "minNumberOfEventsPerStage", plannedEvents, conditionalPower, calcEventsFunction, kMax, endpoint = endpoint ) maxNumberOfEventsPerStage <- .ignoreParameterIfNotUsed( "maxNumberOfEventsPerStage", maxNumberOfEventsPerStage, kMax > 1, "design is fixed ('kMax' = 1)" ) maxNumberOfEventsPerStage <- .assertIsValidNumberOfSubjectsPerStage(maxNumberOfEventsPerStage, "maxNumberOfEventsPerStage", plannedEvents, conditionalPower, calcEventsFunction, kMax, endpoint = endpoint ) if (kMax > 1) { if (!all(is.na(maxNumberOfEventsPerStage - minNumberOfEventsPerStage)) && any(maxNumberOfEventsPerStage - minNumberOfEventsPerStage < 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfEventsPerStage' (", .arrayToString(maxNumberOfEventsPerStage), ") must be not smaller than 'minNumberOfEventsPerStage' (", .arrayToString(minNumberOfEventsPerStage), ")" ) } .setValueAndParameterType( simulationResults, "minNumberOfEventsPerStage", minNumberOfEventsPerStage, NA_real_ ) .setValueAndParameterType( simulationResults, "maxNumberOfEventsPerStage", maxNumberOfEventsPerStage, NA_real_ ) } } if (kMax == 1 && !is.na(conditionalPower)) { warning("'conditionalPower' will be ignored for fixed sample design", call. = FALSE) } if (endpoint %in% c("means", "rates") && kMax == 1 && !is.null(calcSubjectsFunction)) { warning("'calcSubjectsFunction' will be ignored for fixed sample design", call. = FALSE) } if (endpoint == "survival" && kMax == 1 && !is.null(calcEventsFunction)) { warning("'calcEventsFunction' will be ignored for fixed sample design", call. = FALSE) } if (endpoint %in% c("means", "rates") && is.na(conditionalPower) && is.null(calcSubjectsFunction)) { if (length(minNumberOfSubjectsPerStage) != 1 || !is.na(minNumberOfSubjectsPerStage)) { warning("'minNumberOfSubjectsPerStage' (", .arrayToString(minNumberOfSubjectsPerStage), ") will be ignored because ", "neither 'conditionalPower' nor 'calcSubjectsFunction' is defined", call. = FALSE ) simulationResults$minNumberOfSubjectsPerStage <- NA_real_ } if (length(maxNumberOfSubjectsPerStage) != 1 || !is.na(maxNumberOfSubjectsPerStage)) { warning("'maxNumberOfSubjectsPerStage' (", .arrayToString(maxNumberOfSubjectsPerStage), ") will be ignored because ", "neither 'conditionalPower' nor 'calcSubjectsFunction' is defined", call. = FALSE ) simulationResults$maxNumberOfSubjectsPerStage <- NA_real_ } } if (endpoint == "survival" && is.na(conditionalPower) && is.null(calcEventsFunction)) { if (length(minNumberOfEventsPerStage) != 1 || !is.na(minNumberOfEventsPerStage)) { warning("'minNumberOfEventsPerStage' (", .arrayToString(minNumberOfEventsPerStage), ") ", "will be ignored because neither 'conditionalPower' nor 'calcEventsFunction' is defined", call. = FALSE ) simulationResults$minNumberOfEventsPerStage <- NA_real_ } if (length(maxNumberOfEventsPerStage) != 1 || !is.na(maxNumberOfEventsPerStage)) { warning("'maxNumberOfEventsPerStage' (", .arrayToString(maxNumberOfEventsPerStage), ") ", "will be ignored because neither 'conditionalPower' nor 'calcEventsFunction' is defined", call. = FALSE ) simulationResults$maxNumberOfEventsPerStage <- NA_real_ } } if (endpoint %in% c("means", "rates")) { simulationResults$.setParameterType( "calcSubjectsFunction", ifelse(kMax == 1, C_PARAM_NOT_APPLICABLE, ifelse(!is.null(calcSubjectsFunction) && kMax > 1, C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE) ) ) } else if (endpoint == "survival") { simulationResults$.setParameterType( "calcEventsFunction", ifelse(kMax == 1, C_PARAM_NOT_APPLICABLE, ifelse(!is.null(calcEventsFunction) && kMax > 1, C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE) ) ) } if (endpoint == "means") { if (is.null(calcSubjectsFunction)) { calcSubjectsFunction <- .getSimulationMeansMultiArmStageSubjects } else { .assertIsValidFunction( fun = calcSubjectsFunction, funArgName = "calcSubjectsFunction", expectedFunction = .getSimulationMeansMultiArmStageSubjects ) } simulationResults$calcSubjectsFunction <- calcSubjectsFunction } else if (endpoint == "rates") { if (is.null(calcSubjectsFunction)) { calcSubjectsFunction <- .getSimulationRatesMultiArmStageSubjects } else { .assertIsValidFunction( fun = calcSubjectsFunction, funArgName = "calcSubjectsFunction", expectedFunction = .getSimulationRatesMultiArmStageSubjects ) } simulationResults$calcSubjectsFunction <- calcSubjectsFunction } else if (endpoint == "survival") { if (is.null(calcEventsFunction)) { calcEventsFunction <- .getSimulationSurvivalMultiArmStageEvents } else { .assertIsValidFunction( fun = calcEventsFunction, funArgName = "calcEventsFunction", expectedFunction = .getSimulationSurvivalMultiArmStageEvents ) } simulationResults$calcEventsFunction <- calcEventsFunction } if (endpoint == "means") { .setValueAndParameterType(simulationResults, "stDev", stDev, C_STDEV_DEFAULT) } if (is.na(allocationRatioPlanned)) { allocationRatioPlanned <- C_ALLOCATION_RATIO_DEFAULT } .setValueAndParameterType( simulationResults, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT ) .setValueAndParameterType(simulationResults, "effectMatrix", t(effectMatrix), NULL) if (endpoint %in% c("means", "rates")) { .setValueAndParameterType(simulationResults, "plannedSubjects", plannedSubjects, NA_real_) .setValueAndParameterType(simulationResults, "minNumberOfSubjectsPerStage", minNumberOfSubjectsPerStage, NA_real_, notApplicableIfNA = TRUE ) .setValueAndParameterType(simulationResults, "maxNumberOfSubjectsPerStage", maxNumberOfSubjectsPerStage, NA_real_, notApplicableIfNA = TRUE ) } else if (endpoint == "survival") { .setValueAndParameterType(simulationResults, "plannedEvents", plannedEvents, NA_real_) .setValueAndParameterType(simulationResults, "minNumberOfEventsPerStage", minNumberOfEventsPerStage, NA_real_, notApplicableIfNA = TRUE ) .setValueAndParameterType(simulationResults, "maxNumberOfEventsPerStage", maxNumberOfEventsPerStage, NA_real_, notApplicableIfNA = TRUE ) } .setValueAndParameterType(simulationResults, "conditionalPower", conditionalPower, NA_real_, notApplicableIfNA = TRUE ) if (endpoint %in% c("means", "survival")) { .setValueAndParameterType(simulationResults, "thetaH1", thetaH1, NA_real_, notApplicableIfNA = TRUE) } if (endpoint == "means") { .setValueAndParameterType(simulationResults, "stDevH1", stDevH1, NA_real_, notApplicableIfNA = TRUE) } .setValueAndParameterType( simulationResults, "maxNumberOfIterations", as.integer(maxNumberOfIterations), C_MAX_SIMULATION_ITERATIONS_DEFAULT ) simulationResults$.setParameterType("seed", ifelse(is.na(seed), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) simulationResults$seed <- .setSeed(seed) if (is.null(adaptations) || all(is.na(adaptations))) { adaptations <- rep(TRUE, kMax - 1) } if (length(adaptations) != kMax - 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'adaptations' must have length ", (kMax - 1), " (kMax - 1)") } .setValueAndParameterType(simulationResults, "adaptations", adaptations, rep(TRUE, kMax - 1)) simulationResults$.setParameterType( "effectMatrix", ifelse(typeOfShape == "userDefined", C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE) ) .setValueAndParameterType(simulationResults, "activeArms", as.integer(activeArms), 3L) if (typeOfShape == "sigmoidEmax") { .setValueAndParameterType(simulationResults, "gED50", gED50, NA_real_) } .setValueAndParameterType(simulationResults, "slope", slope, 1) if (typeOfSelection != "userDefined") { .setValueAndParameterType(simulationResults, "threshold", threshold, -Inf) .setValueAndParameterType(simulationResults, "epsilonValue", epsilonValue, NA_real_) .setValueAndParameterType(simulationResults, "rValue", rValue, NA_real_) } .setValueAndParameterType(simulationResults, "intersectionTest", intersectionTest, C_INTERSECTION_TEST_MULTIARMED_DEFAULT) .setValueAndParameterType(simulationResults, "typeOfSelection", typeOfSelection, C_TYPE_OF_SELECTION_DEFAULT) .setValueAndParameterType(simulationResults, "typeOfShape", typeOfShape, C_TYPE_OF_SHAPE_DEFAULT) .setValueAndParameterType(simulationResults, "successCriterion", successCriterion, C_SUCCESS_CRITERION_DEFAULT) .setValueAndParameterType(simulationResults, "effectMeasure", effectMeasure, C_EFFECT_MEASURE_DEFAULT) return(simulationResults) } rpact/R/f_simulation_utilities.R0000644000175000017500000004135214154132757016643 0ustar nileshnilesh## | ## | *Simulation of multi-arm design with combination test and conditional error approach* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5628 $ ## | Last changed: $Date: 2021-12-08 14:41:03 +0100 (Mi, 08 Dez 2021) $ ## | Last changed by: $Author: pahlke $ ## | .getGMaxFromSubGroups <- function(subGroups) { .assertIsCharacter(subGroups, "subGroups") subGroups[subGroups == "S"] <- "S1" subGroups <- trimws(gsub("\\D", "", subGroups)) subGroups <- subGroups[subGroups != ""] if (length(subGroups) == 0) { return(1) } gMax <- max(as.integer(unlist(strsplit(subGroups, "", fixed = TRUE)))) + 1 return(gMax) } .getSimulationParametersFromRawData <- function(data, ..., variantName = c("alternative", "pi1"), maxNumberOfIterations = max(data$iterationNumber)) { if (!is.data.frame(data)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'data' (", class(data), ") must be a data.frame") } variantName <- match.arg(variantName) stageNumbers <- sort(unique(na.omit(data$stageNumber))) kMax <- max(stageNumbers) variantLevels <- sort(unique(na.omit(data[[variantName]]))) numberOfVariants <- length(variantLevels) sampleSizes <- matrix(0, nrow = kMax, ncol = numberOfVariants) rejectPerStage <- matrix(0, nrow = kMax, ncol = numberOfVariants) futilityPerStage <- matrix(0, nrow = kMax - 1, ncol = numberOfVariants) expectedNumberOfSubjects <- rep(0, numberOfVariants) conditionalPowerAchieved <- matrix(NA_real_, nrow = kMax, ncol = numberOfVariants) index <- 1 for (variantValue in variantLevels) { subData <- data[data[[variantName]] == variantValue, ] iterations <- table(subData$stageNumber) for (k in sort(unique(na.omit(subData$stageNumber)))) { subData2 <- subData[subData$stageNumber == k, ] sampleSizes[k, index] <- sum(subData2$numberOfSubjects) / iterations[k] rejectPerStage[k, index] <- sum(subData2$rejectPerStage) / maxNumberOfIterations if (k < kMax) { futilityPerStage[k, index] <- sum(na.omit(subData2$futilityPerStage)) / maxNumberOfIterations } expectedNumberOfSubjects[index] <- expectedNumberOfSubjects[index] + sum(subData2$numberOfSubjects) / maxNumberOfIterations if (k > 1) { conditionalPowerAchieved[k, index] <- sum(subData$conditionalPowerAchieved[subData$stageNumber == k]) / iterations[k] } } index <- index + 1 } overallReject <- colSums(rejectPerStage) futilityStop <- colSums(futilityPerStage) iterations <- table(data$stageNumber, data[[variantName]]) if (kMax > 1) { if (numberOfVariants == 1) { earlyStop <- sum(futilityPerStage) + sum(rejectPerStage[1:(kMax - 1)]) } else { if (kMax > 2) { rejectPerStageColSum <- colSums(rejectPerStage[1:(kMax - 1), ]) } else { rejectPerStageColSum <- rejectPerStage[1, ] } earlyStop <- colSums(futilityPerStage) + rejectPerStageColSum } } else { earlyStop <- rep(0, numberOfVariants) } sampleSizes[is.na(sampleSizes)] <- 0 return(list( sampleSizes = sampleSizes, rejectPerStage = rejectPerStage, overallReject = overallReject, futilityPerStage = futilityPerStage, futilityStop = futilityStop, iterations = iterations, earlyStop = earlyStop, expectedNumberOfSubjects = expectedNumberOfSubjects, conditionalPowerAchieved = conditionalPowerAchieved )) } .assertArgumentFitsWithSubGroups <- function(arg, argName, subGroups) { if (is.null(arg) || length(arg) == 0 || all(is.na(arg))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'effectList' must contain ", sQuote(argName)) } argName <- paste0("effectList$", argName) len <- ifelse(is.matrix(arg), ncol(arg), length(arg)) if (len != length(subGroups)) { argName <- sQuote(argName) if (!is.matrix(arg)) { argName <- paste0(argName, " (", .arrayToString(arg), ")") } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, argName, " must have ", length(subGroups), " columns given by the number of sub-groups" ) } } .getEffectData <- function(effectList, ..., gMax = NA_integer_, nullAllowed = TRUE) { if (nullAllowed && is.null(effectList)) { return(NULL) } .assertIsSingleInteger(gMax, "gMax", naAllowed = TRUE, validateType = FALSE) if (is.null(effectList) || length(effectList) == 0 || !is.list(effectList)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("effectList"), " must be a non-empty list") } effectListNames <- names(effectList) if (is.null(effectListNames) || any(nchar(trimws(effectListNames)) == 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("effectList"), " must be named. Current names are ", .arrayToString(effectListNames, encapsulate = TRUE) ) } for (singularName in c( "subGroup", "effect", "piTreatment", "piControl", "hazardRatio", "prevalence", "stDev" )) { names(effectList)[names(effectList) == singularName] <- paste0(singularName, "s") } effectListNames <- names(effectList) if (!("subGroups" %in% effectListNames)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("effectList"), " must contain ", sQuote("subGroups")) } subGroups <- effectList[["subGroups"]] if (is.null(subGroups) || length(subGroups) == 0 || (!is.character(subGroups) && !is.factor(subGroups))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("effectList$subGroups"), " must be a non-empty character vector or factor" ) } if (is.factor(subGroups)) { subGroups <- as.character(subGroups) } expectedSubGroups <- "F" if (length(subGroups) > 1) { if (is.na(gMax)) { if (length(subGroups) > 2) { gMax <- max(as.integer(strsplit(gsub("\\D", "", paste0(subGroups, collapse = "")), "", fixed = TRUE )[[1]]), na.rm = TRUE) + 1 } else { gMax <- length(subGroups) } } expectedSubGroups <- .createSubsetsByGMax(gMax, all = FALSE) # expectedNumberOfColumns = 2^(gMax - 1) if (gMax < 3) { expectedSubGroups <- gsub("\\d", "", expectedSubGroups) } } missingSubGroups <- expectedSubGroups[!(expectedSubGroups %in% subGroups)] if (length(missingSubGroups) > 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("effectList$subGroups"), " must contain ", .arrayToString(dQuote(missingSubGroups)) ) } unknownSubGroups <- subGroups[!(subGroups %in% expectedSubGroups)] if (length(unknownSubGroups) > 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("effectList$subGroups"), " must not contain ", .arrayToString(dQuote(unknownSubGroups)), " (valid sub-group names: ", .arrayToString(dQuote(expectedSubGroups)), ")" ) } matrixName <- NA_character_ matrixNames <- c("effects", "piTreatments", "hazardRatios") for (m in matrixNames) { if (m %in% effectListNames) { matrixName <- m break } } if (is.na(matrixName)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("effectList"), " must contain ", .arrayToString(matrixNames, mode = "or", encapsulate = TRUE) ) } matrixValues <- effectList[[matrixName]] if (is.vector(matrixValues)) { matrixValues <- matrix(matrixValues, nrow = 1) } if (is.matrix(matrixValues)) { .assertIsValidMatrix(matrixValues, paste0("effectList$", matrixName), naAllowed = TRUE) } if (!is.matrix(matrixValues) && !is.data.frame(matrixValues)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(paste0("effectList$", matrixName)), " must be a matrix or data.frame" ) } if (!is.data.frame(matrixValues)) { matrixValues <- as.data.frame(matrixValues) } if (nrow(matrixValues) == 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(paste0("effectList$", matrixName)), " must have one or more rows ", "reflecting the different situations to consider" ) } .assertArgumentFitsWithSubGroups(matrixValues, matrixName, subGroups) colNames <- paste0(matrixName, 1:ncol(matrixValues)) colnames(matrixValues) <- colNames matrixValues$situation <- 1:nrow(matrixValues) longData <- stats::reshape(data = matrixValues, direction = "long", varying = colNames, idvar = "situation", sep = "") timeColumnIndex <- which(colnames(longData) == "time") colnames(longData)[timeColumnIndex] <- "subGroupNumber" longData$subGroups <- rep(NA_character_, nrow(longData)) indices <- sort(unique(longData$subGroupNumber)) for (i in indices) { longData$subGroups[longData$subGroupNumber == i] <- subGroups[i] } longData$prevalences <- rep(NA_real_, nrow(longData)) prevalences <- effectList[["prevalences"]] if (is.null(prevalences)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, sQuote("effectList$prevalences"), " must be specified") } .assertIsNumericVector(prevalences, "effectList$prevalences") .assertArgumentFitsWithSubGroups(prevalences, "prevalences", subGroups) if (abs(sum(prevalences) - 1) > 1e-04) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("effectList$prevalences"), " must sum to 1") } for (i in indices) { longData$prevalences[longData$subGroupNumber == i] <- prevalences[i] } # means only if (matrixName == "effects") { longData$stDevs <- rep(NA_real_, nrow(longData)) stDevs <- effectList[["stDevs"]] if (is.null(stDevs)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, sQuote("effectList$stDevs"), " must be specified") } .assertIsNumericVector(stDevs, "effectList$stDevs") if (!is.null(stDevs) && length(stDevs) == 1) { stDevs <- rep(stDevs, length(prevalences)) } .assertArgumentFitsWithSubGroups(stDevs, "stDevs", subGroups) for (i in indices) { longData$stDevs[longData$subGroupNumber == i] <- stDevs[i] } } # rates only else if (matrixName == "piTreatments") { longData$piControls <- rep(NA_real_, nrow(longData)) piControls <- effectList[["piControls"]] if (is.null(piControls)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, sQuote("effectList$piControls"), " must be specified") } .assertIsNumericVector(piControls, "effectList$piControls") .assertArgumentFitsWithSubGroups(piControls, "piControls", subGroups) for (i in indices) { longData$piControls[longData$subGroupNumber == i] <- piControls[i] } } rownames(longData) <- NULL # order by subGroup longData$subGroupNumber <- as.integer(gsub("\\D", "", gsub("^S$", "S1", longData$subGroups))) longData$subGroupNumber[is.na(longData$subGroupNumber)] <- 99999 longData <- longData[order(longData$subGroupNumber, longData$situation), ] longData <- .moveColumn(longData, matrixName, colnames(longData)[length(colnames(longData))]) for (singularName in c( "subGroup", "effect", "piTreatment", "piControl", "hazardRatio", "prevalence", "stDev" )) { colnames(longData)[colnames(longData) == paste0(singularName, "s")] <- singularName } longData <- longData[, colnames(longData) != "subGroupNumber"] return(longData) } .getSimulationEnrichmentEffectMatrixName <- function(obj) { if (!grepl("SimulationResultsEnrichment", class(obj))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("obj"), " must be a SimulationResultsEnrichment object (is ", class(obj), ")" ) } if (grepl("Means", class(obj))) { return("effects") } if (grepl("Rates", class(obj))) { return("piTreatments") } if (grepl("Survival", class(obj))) { return("hazardRatios") } stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "class ", class(obj), " not supported") } .getSimulationEnrichmentEffectData <- function(simulationResults, validatePlotCapability = TRUE) { effectMatrixName <- .getSimulationEnrichmentEffectMatrixName(simulationResults) effectData <- simulationResults$effectList[[effectMatrixName]] discreteXAxis <- FALSE if (ncol(effectData) == 1) { xValues <- effectData[, 1] } else { xValues <- 1:nrow(effectData) discreteXAxis <- TRUE } valid <- TRUE if (length(xValues) <= 1) { if (validatePlotCapability) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "2 ore more situations must be specifed in ", sQuote(paste0("effectList$", effectMatrixName)) ) } valid <- FALSE } return(list( effectMatrixName = effectMatrixName, effectData = effectData, xValues = xValues, discreteXAxis = discreteXAxis, valid = valid )) } .getEffectList <- function(effectData, parameterName = "effectData") { if (is.null(effectData) || length(effectData) == 0 || !is.data.frame(effectData)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(parameterName), " must be a non-empty data.frame") } effectList <- list(subGroups = character(0), prevalences = numeric(0)) matrixName <- NA_character_ matrixNames <- c("effect", "piTreatment", "hazardRatio") for (m in matrixNames) { if (m %in% colnames(effectData)) { matrixName <- m break } } if (is.na(matrixName)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(parameterName), " must contain ", .arrayToString(matrixNames, mode = "or", encapsulate = TRUE) ) } matrixNameNew <- paste0(matrixName, "s") effectList[[matrixNameNew]] <- NULL if (matrixName == "effects") { effectList$stDevs <- numeric(0) } else if (matrixName == "piTreatments") { effectList$piControls <- numeric(0) } for (subGroup in unique(effectData$subGroup)) { effectList$subGroups <- c(effectList$subGroups, subGroup) subData <- effectData[effectData$subGroup == subGroup, ] effectList$prevalences <- c(effectList$prevalences, subData$prevalence[1]) if (matrixName == "effect") { if (!("stDev" %in% colnames(effectData))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(parameterName), " must contain ", sQuote("stDev")) } effectList$stDevs <- c(effectList$stDevs, subData$stDev[1]) } else if (matrixName == "piTreatment") { if (!("piControl" %in% colnames(effectData))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(parameterName), " must contain ", sQuote("piControl")) } effectList$piControls <- c(effectList$piControls, subData$piControl[1]) } if (is.null(effectList[[matrixNameNew]])) { effectList[[matrixNameNew]] <- subData[[matrixName]] } else { effectList[[matrixNameNew]] <- cbind(effectList[[matrixNameNew]], subData[[matrixName]]) } } if (!is.matrix(effectList[[matrixNameNew]])) { effectList[[matrixNameNew]] <- matrix(effectList[[matrixNameNew]], ncol = 1) } return(effectList) } .getValidatedEffectList <- function(effectList, ..., gMax = NA_integer_, nullAllowed = TRUE) { if (is.data.frame(effectList)) { return(.getEffectList(effectList, parameterName = "effectList")) } effectData <- .getEffectData(effectList, gMax = gMax, nullAllowed = nullAllowed) return(.getEffectList(effectData)) } rpact/R/f_analysis_base.R0000644000175000017500000030003514165522172015171 0ustar nileshnilesh## | ## | *Analysis functions* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5684 $ ## | Last changed: $Date: 2022-01-05 12:27:24 +0100 (Mi, 05 Jan 2022) $ ## | Last changed by: $Author: wassmer $ ## | #' @title #' Get Analysis Results #' #' @description #' Calculates and returns the analysis results for the specified design and data. #' #' @inheritParams param_design #' @inheritParams param_dataInput #' @inheritParams param_directionUpper #' @inheritParams param_thetaH0 #' @inheritParams param_nPlanned #' @inheritParams param_allocationRatioPlanned #' @inheritParams param_stage #' @inheritParams param_maxInformation #' @inheritParams param_informationEpsilon #' @param ... Further arguments to be passed to methods (cf. separate functions in "See Also" below), e.g., #' \describe{ #' \item{\code{thetaH1} and \code{assumedStDev} or \code{pi1}, \code{pi2}}{The #' assumed effect size or assumed rates to calculate the #' conditional power. Depending on the type of dataset, either \code{thetaH1} (means and survival) #' or \code{pi1}, \code{pi2} (rates) can be specified. #' For testing means, an assumed standard deviation can be specified, default is \code{1}.} #' \item{\code{normalApproximation}}{The type of computation of the p-values. Default is \code{FALSE} for #' testing means (i.e., the t test is used) and \code{TRUE} for testing rates and the hazard ratio. #' For testing rates, if \code{normalApproximation = FALSE} is specified, the binomial test #' (one sample) or the exact test of Fisher (two samples) is used for calculating the p-values. #' In the survival setting, \code{normalApproximation = FALSE} has no effect.} #' \item{\code{equalVariances}}{The type of t test. For testing means in two treatment groups, either #' the t test assuming that the variances are equal or the t test without assuming this, #' i.e., the test of Welch-Satterthwaite is calculated, default is \code{TRUE}.} #' \item{\code{iterations}}{Iterations for simulating the power for Fisher's combination test. #' If the power for more than one remaining stages is to be determined for #' Fisher's combination test, it is estimated via simulation with specified \cr #' \code{iterations}, the default is \code{1000}.} #' \item{\code{seed}}{Seed for simulating the power for Fisher's combination test. #' See above, default is a random seed.} #' \item{\code{intersectionTest}}{Defines the multiple test for the intersection #' hypotheses in the closed system of hypotheses when testing multiple hypotheses. #' Five options are available in multi-arm designs: \code{"Dunnett"}, \code{"Bonferroni"}, \code{"Simes"}, #' \code{"Sidak"}, and \code{"Hierarchical"}, default is \code{"Dunnett"}. #' Four options are available in population enrichment designs: \code{"SpiessensDebois"} (one subset only), #' \code{"Bonferroni"}, \code{"Simes"}, and \code{"Sidak"}, default is \code{"Simes"}.} #' \item{\code{varianceOption}}{Defines the way to calculate the variance in multiple treatment arms (> 2) #' or population enrichment designs for testing means. For multiple arms, three options are available: #' \code{"overallPooled"}, \code{"pairwisePooled"}, and \code{"notPooled"}, default is \code{"overallPooled"}. #' For enrichment designs, the options are: \code{"pooled"}, \code{"pooledFromFull"} (one subset only), #' and \code{"notPooled"}, default is \code{"pooled"}.} #' \item{\code{thetaH1} and \code{assumedStDevs} or \code{piTreatments}, \code{piControl}}{The #' assumed effect size or assumed rates to calculate the conditional power in multi-arm trials #' or enrichment designs. For survival designs, \code{thetaH1} refers to the hazard ratio. #' You can specify a value or a vector with elements referring to the #' treatment arms or the sub-populations, respectively. If not specified, the conditional #' power is calculated under the assumption of observed effect sizes, standard deviations, rates, or hazard ratios.} #' \item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. #' For testing means and rates, also a non-stratified analysis based on overall data can be performed. #' For survival data, only a stratified analysis is possible (see Brannath et al., 2009), default is \code{TRUE}.} #' } #' #' @details #' Given a design and a dataset, at given stage the function calculates the test results #' (effect sizes, stage-wise test statistics and p-values, overall p-values and test statistics, #' conditional rejection probability (CRP), conditional power, Repeated Confidence Intervals (RCIs), #' repeated overall p-values, and final stage p-values, median unbiased effect estimates, #' and final confidence intervals. #' #' For designs with more than two treatments arms (multi-arm designs) or enrichment designs #' a closed combination test is performed. #' That is, additionally the statistics to be used in a closed testing procedure are provided. #' #' The conditional power is calculated only if effect size and sample size #' is specified. Median unbiased effect estimates and confidence intervals are calculated if #' a group sequential design or an inverse normal combination test design was chosen, i.e., it is not applicable #' for Fisher's p-value combination test design. #' For the inverse normal combination test design with more than two stages, a warning informs that the validity #' of the confidence interval is theoretically shown only if no sample size change was performed. #' #' A final stage p-value for Fisher's combination test is calculated only if a two-stage design was chosen. #' For Fisher's combination test, the conditional power for more than one remaining stages is estimated via simulation. #' #' Final stage p-values, median unbiased effect estimates, and final confidence intervals are not calculated #' for multi-arm and enrichment designs. #' #' @return Returns an \code{\link{AnalysisResults}} object. #' The following generics (R generic functions) are available for this result object: #' \itemize{ #' \item \code{\link[=names.AnalysisResults]{names}} to obtain the field names, #' \item \code{\link[=print.ParameterSet]{print}} to print the object, #' \item \code{\link[=summary.AnalysisResults]{summary}} to display a summary of the object, #' \item \code{\link[=plot.AnalysisResults]{plot}} to plot the object, #' \item \code{\link[=as.data.frame.AnalysisResults]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, #' \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. #' } #' @template how_to_get_help_for_generics #' #' @template details_analysis_base_mnormt_dependency #' #' @seealso #' \itemize{ #' \item \code{\link{getObservedInformationRates}} for recalculation the observed information rates. #' } #' #' @family analysis functions #' #' @template examples_get_analysis_results #' #' @export #' getAnalysisResults <- function(design, dataInput, ..., directionUpper = TRUE, # C_DIRECTION_UPPER_DEFAULT thetaH0 = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = 1, # C_ALLOCATION_RATIO_DEFAULT stage = NA_integer_, maxInformation = NULL, informationEpsilon = NULL) { if (missing(dataInput) && !missing(design) && inherits(design, "Dataset")) { dataInput <- design design <- .getDefaultDesign(..., type = "analysis") } else if (!missing(dataInput) && missing(design)) { design <- .getDefaultDesign(..., type = "analysis") } else { .assertIsTrialDesign(design) .warnInCaseOfTwoSidedPowerArgument(...) } repeatedPValues <- NULL informationRatesRecalculated <- FALSE if (.isAlphaSpendingDesign(design) && .isTrialDesignGroupSequential(design) && !.isMultiArmDataset(dataInput)) { observedInformationRates <- NULL absoluteInformations <- NULL status <- NULL if (!is.null(maxInformation) && !is.na(maxInformation)) { showObservedInformationRatesMessage <- .getOptionalArgument( "showObservedInformationRatesMessage", optionalArgumentDefaultValue = TRUE, ... ) observedInformation <- getObservedInformationRates( dataInput, maxInformation = maxInformation, informationEpsilon = informationEpsilon, stage = stage, showObservedInformationRatesMessage = showObservedInformationRatesMessage ) observedInformationRates <- observedInformation$informationRates absoluteInformations <- observedInformation$absoluteInformations status <- observedInformation$status } else if (!is.null(informationEpsilon) && !is.na(informationEpsilon)) { warning("'informationEpsilon' (", .arrayToString(informationEpsilon), ") will be ignored because 'maxInformation' is undefined", call. = FALSE ) } if (!is.null(observedInformationRates)) { stageFromData <- dataInput$getNumberOfStages() if (!is.null(status) && status %in% c("under-running", "over-running") && length(observedInformationRates) > 1) { if (stageFromData == 1) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "Recalculation of the information rates not possible at stage 1" ) } if (!(getLogLevel() %in% c(C_LOG_LEVEL_DISABLED, C_LOG_LEVEL_PROGRESS))) { message( "Calculate alpha values that have actually been spent ", "at earlier interim analyses at stage ", (stageFromData - 1) ) } .assertIsSingleInteger(stage, "stage", naAllowed = TRUE, validateType = FALSE) observedInformationRatesBefore <- getObservedInformationRates( dataInput, maxInformation = maxInformation, informationEpsilon = informationEpsilon, stage = ifelse(!is.na(stage), stage - 1, stageFromData - 1), showObservedInformationRatesMessage = FALSE )$informationRates if (length(observedInformationRatesBefore) < length(design$informationRates)) { for (i in (length(observedInformationRatesBefore) + 1):length(design$informationRates)) { if (observedInformationRatesBefore[length(observedInformationRatesBefore)] < 1) { observedInformationRatesBefore <- c(observedInformationRatesBefore, design$informationRates[i]) } } } designBefore <- eval(parse(text = getObjectRCode(design, newArgumentValues = list( informationRates = observedInformationRatesBefore ), stringWrapParagraphWidth = NULL ))) if (is.na(stage) || stage == stageFromData) { repeatedPValues <- getAnalysisResults( design = designBefore, dataInput = dataInput, directionUpper = directionUpper, thetaH0 = thetaH0, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, stage = stageFromData - 1, maxInformation = maxInformation, informationEpsilon = informationEpsilon, showObservedInformationRatesMessage = FALSE )$repeatedPValues } userAlphaSpending <- designBefore$alphaSpent message( "Use alpha values that have actually been spent at earlier stages ", "and spend all remaining alpha at the final analysis, ", "i.e., userAlphaSpending = (", .arrayToString(userAlphaSpending, digits = 6), ") " ) observedInformationRates <- getObservedInformationRates( dataInput, maxInformation = absoluteInformations[stageFromData], informationEpsilon = informationEpsilon, stage = stage, showObservedInformationRatesMessage = FALSE )$informationRates design <- eval(parse(text = getObjectRCode(design, newArgumentValues = list( informationRates = observedInformationRates, userAlphaSpending = userAlphaSpending, typeOfDesign = C_TYPE_OF_DESIGN_AS_USER ), stringWrapParagraphWidth = NULL ))) options("rpact.analyis.repeated.p.values.warnings.enabled" = "FALSE") warning("Repeated p-values not available at final stage because there is 'typeOfDesign' = '", design$typeOfDesign, "'", call. = FALSE ) } else { design <- eval(parse(text = getObjectRCode(design, newArgumentValues = list(informationRates = observedInformationRates), stringWrapParagraphWidth = NULL ))) } informationRatesRecalculated <- TRUE } } else { if (!is.null(maxInformation) && !is.na(maxInformation)) { warning("'maxInformation' (", .arrayToString(maxInformation), ") will be ignored because it is only applicable for ", "alpha spending group sequential designs with a single hypothesis", call. = FALSE ) } if (!is.null(informationEpsilon) && !is.na(informationEpsilon)) { warning("'informationEpsilon' (", .arrayToString(informationEpsilon), ") will be ignored because it is only applicable for ", "alpha spending group sequential designs with a single hypothesis", call. = FALSE ) } } result <- NULL if (.isEnrichmentDataset(dataInput)) { result <- .getAnalysisResultsEnrichment( design = design, dataInput = dataInput, directionUpper = directionUpper, thetaH0 = thetaH0, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, stage = stage, ... ) } else if (.isMultiArmDataset(dataInput)) { result <- .getAnalysisResultsMultiArm( design = design, dataInput = dataInput, directionUpper = directionUpper, thetaH0 = thetaH0, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, stage = stage, ... ) } else { stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design, stage = stage, showWarnings = TRUE ) .assertIsValidDirectionUpper(directionUpper, sided = design$sided) .assertIsValidDataInput(dataInput = dataInput, design = design, stage = stage) on.exit(dataInput$.trim()) .assertIsValidThetaH0DataInput(thetaH0, dataInput) if (is.null(maxInformation) || is.na(maxInformation)) { .assertAreSuitableInformationRates(design, dataInput, stage = stage) } .assertIsValidNPlanned(nPlanned, design$kMax, stage, required = FALSE) .assertIsValidAllocationRatioPlanned(allocationRatioPlanned, numberOfGroups = dataInput$getNumberOfGroups() ) if (dataInput$isDatasetMeans()) { if (is.na(thetaH0)) { thetaH0 <- C_THETA_H0_MEANS_DEFAULT } result <- .getAnalysisResultsMeans( design = design, dataInput = dataInput, directionUpper = directionUpper, thetaH0 = thetaH0, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, stage = stage, ... ) } else if (dataInput$isDatasetRates()) { if (is.na(thetaH0)) { thetaH0 <- C_THETA_H0_RATES_DEFAULT } result <- .getAnalysisResultsRates( design = design, dataInput = dataInput, directionUpper = directionUpper, thetaH0 = thetaH0, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, stage = stage, ... ) } else if (dataInput$isDatasetSurvival()) { if (is.na(thetaH0)) { thetaH0 <- C_THETA_H0_SURVIVAL_DEFAULT } result <- .getAnalysisResultsSurvival( design = design, dataInput = dataInput, directionUpper = directionUpper, thetaH0 = thetaH0, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, stage = stage, ... ) } if (is.null(result)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(dataInput), "' is not implemented yet") } if (informationRatesRecalculated) { result$maxInformation <- as.integer(maxInformation) result$.setParameterType("maxInformation", C_PARAM_USER_DEFINED) if (!is.null(informationEpsilon) && !is.na(informationEpsilon)) { result$informationEpsilon <- informationEpsilon result$.setParameterType("informationEpsilon", C_PARAM_USER_DEFINED) } } } if (!is.null(result) && !is.null(repeatedPValues)) { result$repeatedPValues <- repeatedPValues } if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design) && design$typeOfDesign %in% c(C_TYPE_OF_DESIGN_AS_USER, C_TYPE_OF_DESIGN_NO_EARLY_EFFICACY)) { indices <- design$userAlphaSpending == 0 if (.isEnrichmentDataset(dataInput) || .isMultiArmDataset(dataInput)) { result$repeatedConfidenceIntervalLowerBounds[, indices] <- NA_real_ result$repeatedConfidenceIntervalUpperBounds[, indices] <- NA_real_ result$repeatedPValues[, indices] <- NA_real_ } else { result$repeatedConfidenceIntervalLowerBounds[indices] <- NA_real_ result$repeatedConfidenceIntervalUpperBounds[indices] <- NA_real_ result$repeatedPValues[indices] <- NA_real_ } } options("rpact.analyis.repeated.p.values.warnings.enabled" = "TRUE") return(result) } #' @title #' Get Stage Results #' #' @description #' Returns summary statistics and p-values for a given data set and a given design. #' #' @inheritParams param_design #' @inheritParams param_dataInput #' @inheritParams param_stage #' @param ... Further (optional) arguments to be passed: #' \describe{ #' \item{\code{thetaH0}}{The null hypothesis value, #' default is \code{0} for the normal and the binary case (testing means and rates, respectively), #' it is \code{1} for the survival case (testing the hazard ratio).\cr\cr #' For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. #' That is, in case of (one-sided) testing of #' \itemize{ #' \item \emph{means}: a value \code{!= 0} #' (or a value \code{!= 1} for testing the mean ratio) can be specified. #' \item \emph{rates}: a value \code{!= 0} #' (or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. #' \item \emph{survival data}: a bound for testing H0: #' \code{hazard ratio = thetaH0 != 1} can be specified. #' } #' For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for #' defining the null hypothesis H0: \code{pi = thetaH0}.} #' \item{\code{normalApproximation}}{The #' type of computation of the p-values. Default is \code{FALSE} for #' testing means (i.e., the t test is used) and \code{TRUE} for testing rates and the hazard ratio. #' For testing rates, if \code{normalApproximation = FALSE} is specified, the binomial test #' (one sample) or the exact test of Fisher (two samples) is used for calculating the p-values. #' In the survival setting, \code{normalApproximation = FALSE} has no effect.} #' \item{\code{equalVariances}}{The type of t test. For testing means in two treatment groups, either #' the t test assuming that the variances are equal or the t test without assuming this, #' i.e., the test of Welch-Satterthwaite is calculated, default is \code{TRUE}.} #' \item{\code{directionUpper}}{The direction of one-sided testing. #' Default is \code{TRUE} which means that larger values of the #' test statistics yield smaller p-values.} #' \item{\code{intersectionTest}}{Defines the multiple test for the intersection #' hypotheses in the closed system of hypotheses when testing multiple hypotheses. #' Five options are available in multi-arm designs: \code{"Dunnett"}, \code{"Bonferroni"}, \code{"Simes"}, #' \code{"Sidak"}, and \code{"Hierarchical"}, default is \code{"Dunnett"}. #' Four options are available in population enrichment designs: \code{"SpiessensDebois"} (one subset only), #' \code{"Bonferroni"}, \code{"Simes"}, and \code{"Sidak"}, default is \code{"Simes"}.} #' \item{\code{varianceOption}}{Defines the way to calculate the variance in multiple treatment arms (> 2) #' or population enrichment designs for testing means. For multiple arms, three options are available: #' \code{"overallPooled"}, \code{"pairwisePooled"}, and \code{"notPooled"}, default is \code{"overallPooled"}. #' For enrichment designs, the options are: \code{"pooled"}, \code{"pooledFromFull"} (one subset only), #' and \code{"notPooled"}, default is \code{"pooled"}.} #' \item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. #' For testing means and rates, also a non-stratified analysis based on overall data can be performed. #' For survival data, only a stratified analysis is possible (see Brannath et al., 2009), default is \code{TRUE}.} #' } #' #' @details #' Calculates and returns the stage results of the specified design and data input at the specified stage. #' #' @return Returns a \code{\link{StageResults}} object. #' \itemize{ #' \item \code{\link[=names.StageResults]{names}} to obtain the field names, #' \item \code{\link[=print.FieldSet]{print}} to print the object, #' \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, #' \item \code{\link[=plot.StageResults]{plot}} to plot the object, #' \item \code{\link[=as.data.frame.StageResults]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, #' \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. #' } #' @template how_to_get_help_for_generics #' #' @family analysis functions #' #' @template examples_get_stage_results #' #' @export #' getStageResults <- function(design, dataInput, ..., stage = NA_integer_) { if (.isMultiArmDataset(dataInput)) { return(.getStageResultsMultiArm( design = design, dataInput = dataInput, stage = stage, ... )) } if (.isEnrichmentDataset(dataInput)) { return(.getStageResultsEnrichment( design = design, dataInput = dataInput, stage = stage, ... )) } .assertIsTrialDesign(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design, stage = stage) .assertIsValidDataInput(dataInput = dataInput, design = design, stage = stage) on.exit(dataInput$.trim()) if (dataInput$isDatasetMeans()) { return(.getStageResultsMeans( design = design, dataInput = dataInput, stage = stage, userFunctionCallEnabled = TRUE, ... )) } if (dataInput$isDatasetRates()) { return(.getStageResultsRates( design = design, dataInput = dataInput, stage = stage, userFunctionCallEnabled = TRUE, ... )) } if (dataInput$isDatasetSurvival()) { return(.getStageResultsSurvival( design = design, dataInput = dataInput, stage = stage, userFunctionCallEnabled = TRUE, ... )) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(dataInput), "' is not supported") } .getStageFromOptionalArguments <- function(..., dataInput, design, showWarnings = FALSE) { .assertIsTrialDesign(design) stage <- .getOptionalArgument("stage", ...) if (!is.null(stage) && !is.na(stage)) { .assertIsValidStage(stage, design$kMax) if (showWarnings) { .assertIsDataset(dataInput) if (stage > dataInput$getNumberOfStages()) { warning("'stage' (", stage, ") will be ignored because 'dataInput' ", "has only ", dataInput$getNumberOfStages(), " stages defined", call. = FALSE ) } } return(as.integer(stage)) } .assertIsDataset(dataInput) stage <- dataInput$getNumberOfStages() stage <- min(stage, design$kMax) stage <- as.integer(stage) .assertIsValidStage(stage, design$kMax) return(stage) } #' #' @title #' Get Test Actions #' #' @description #' Returns test actions. #' #' @inheritParams param_stageResults #' @param ... Only available for backward compatibility. #' #' @details #' Returns the test actions of the specified design and stage results at the specified stage. #' #' @return Returns a \code{\link[base]{character}} vector of length \code{kMax} #' Returns a \code{\link[base]{numeric}} vector of length \code{kMax}containing the test actions of each stage. #' #' @family analysis functions #' #' @template examples_get_test_actions #' #' @export #' getTestActions <- function(stageResults, ...) { .warnInCaseOfUnknownArguments(functionName = "getTestActions", ...) stageResults <- .getStageResultsObject(stageResults, functionName = "getTestActions", ...) .stopInCaseOfIllegalStageDefinition(stageResults, ...) .assertIsStageResultsNonMultiHypotheses(stageResults) design <- stageResults$.design testActions <- rep(NA_character_, design$kMax) if (.isTrialDesignInverseNormal(design)) { for (k in 1:stageResults$stage) { if (design$sided == 1) { if (k < design$kMax) { if (stageResults$combInverseNormal[k] > design$criticalValues[k]) { testActions[k] <- "reject and stop" } else if (stageResults$combInverseNormal[k] < design$futilityBounds[k]) { testActions[k] <- "accept and stop" } else { testActions[k] <- "continue" } } else { if (stageResults$combInverseNormal[k] > design$criticalValues[k]) { testActions[k] <- "reject" } else { testActions[k] <- "accept" } } } if (design$sided == 2) { if (k < design$kMax) { if (abs(stageResults$combInverseNormal[k]) > design$criticalValues[k]) { testActions[k] <- "reject and stop" } else { testActions[k] <- "continue" } } else { if (abs(stageResults$combInverseNormal[k]) > design$criticalValues[k]) { testActions[k] <- "reject" } else { testActions[k] <- "accept" } } } } } else if (.isTrialDesignGroupSequential(design)) { for (k in 1:stageResults$stage) { if (design$sided == 1) { if (k < design$kMax) { if (.getOneMinusQNorm(stageResults$overallPValues[k]) > design$criticalValues[k]) { testActions[k] <- "reject and stop" } else if (.getOneMinusQNorm(stageResults$overallPValues[k]) < design$futilityBounds[k]) { testActions[k] <- "accept and stop" } else { testActions[k] <- "continue" } } else { if (.getOneMinusQNorm(stageResults$overallPValues[k]) > design$criticalValues[k]) { testActions[k] <- "reject" } else { testActions[k] <- "accept" } } } if (design$sided == 2) { if (k < design$kMax) { if (abs(.getOneMinusQNorm(stageResults$overallPValues[k])) > design$criticalValues[k]) { testActions[k] <- "reject and stop" } else { testActions[k] <- "continue" } } else { if (abs(.getOneMinusQNorm(stageResults$overallPValues[k])) > design$criticalValues[k]) { testActions[k] <- "reject" } else { testActions[k] <- "accept" } } } } } else if (.isTrialDesignFisher(design)) { for (k in 1:stageResults$stage) { if (design$sided == 1) { if (k < design$kMax) { if (stageResults$combFisher[k] < design$criticalValues[k]) { testActions[k] <- "reject and stop" } else if (stageResults$pValues[k] > design$alpha0Vec[k]) { testActions[k] <- "accept and stop" } else { testActions[k] <- "continue" } } else { if (stageResults$combFisher[k] < design$criticalValues[k]) { testActions[k] <- "reject" } else { testActions[k] <- "accept" } } } if (design$sided == 2) { if (k < design$kMax) { if (min(stageResults$combFisher[k], 1 - stageResults$combFisher[k]) < design$criticalValues[k]) { testActions[k] <- "reject and stop" } else { testActions[k] <- "continue" } } else { if (min(stageResults$combFisher[k], 1 - stageResults$combFisher[k]) < design$criticalValues[k]) { testActions[k] <- "reject" } else { testActions[k] <- "accept" } } } } } return(testActions) } #' #' @title #' Get Repeated Confidence Intervals #' #' @description #' Calculates and returns the lower and upper limit of the repeated confidence intervals of the trial. #' #' @inheritParams param_design #' @inheritParams param_dataInput #' @inheritParams param_directionUpper #' @inheritParams param_tolerance #' @inheritParams param_stage #' @param ... Further arguments to be passed to methods (cf. separate functions in "See Also" below), e.g., #' \describe{ #' \item{\code{normalApproximation}}{The #' type of computation of the p-values. Default is \code{FALSE} for #' testing means (i.e., the t test is used) and \code{TRUE} for testing rates and the hazard ratio. #' For testing rates, if \code{normalApproximation = FALSE} is specified, the binomial test #' (one sample) or the exact test of Fisher (two samples) is used for calculating the p-values. #' In the survival setting, \code{normalApproximation = FALSE} has no effect.} #' \item{\code{equalVariances}}{The type of t test. For testing means in two treatment groups, either #' the t test assuming that the variances are equal or the t test without assuming this, #' i.e., the test of Welch-Satterthwaite is calculated, default is \code{TRUE}.} #' \item{\code{intersectionTest}}{Defines the multiple test for the intersection #' hypotheses in the closed system of hypotheses when testing multiple hypotheses. #' Five options are available in multi-arm designs: \code{"Dunnett"}, \code{"Bonferroni"}, \code{"Simes"}, #' \code{"Sidak"}, and \code{"Hierarchical"}, default is \code{"Dunnett"}. #' Four options are available in population enrichment designs: \code{"SpiessensDebois"} (one subset only), #' \code{"Bonferroni"}, \code{"Simes"}, and \code{"Sidak"}, default is \code{"Simes"}.} #' \item{\code{varianceOption}}{Defines the way to calculate the variance in multiple treatment arms (> 2) #' or population enrichment designs for testing means. For multiple arms, three options are available: #' \code{"overallPooled"}, \code{"pairwisePooled"}, and \code{"notPooled"}, default is \code{"overallPooled"}. #' For enrichment designs, the options are: \code{"pooled"}, \code{"pooledFromFull"} (one subset only), #' and \code{"notPooled"}, default is \code{"pooled"}.} #' \item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. #' For testing means and rates, also a non-stratified analysis based on overall data can be performed. #' For survival data, only a stratified analysis is possible (see Brannath et al., 2009), default is \code{TRUE}.} #' } #' #' @details #' The repeated confidence interval at a given stage of the trial contains the #' parameter values that are not rejected using the specified sequential design. #' It can be calculated at each stage of the trial and can thus be used as a monitoring tool. #' #' The repeated confidence intervals are provided up to the specified stage. #' #' @return Returns a \code{\link[base]{matrix}} with \code{2} rows #' and \code{kMax} columns containing the lower RCI limits in the first row and #' the upper RCI limits in the second row, where each column represents a stage. #' #' @family analysis functions #' #' @template examples_get_repeated_confidence_intervals #' #' @export #' getRepeatedConfidenceIntervals <- function(design, dataInput, ..., directionUpper = TRUE, # C_DIRECTION_UPPER_DEFAULT tolerance = 1e-06, # C_ANALYSIS_TOLERANCE_DEFAULT stage = NA_integer_) { .assertIsValidTolerance(tolerance) if (.isEnrichmentDataset(dataInput)) { return(.getRepeatedConfidenceIntervalsEnrichment( design = design, dataInput = dataInput, stage = stage, ... )) } if (.isMultiArmDataset(dataInput)) { return(.getRepeatedConfidenceIntervalsMultiArm( design = design, dataInput = dataInput, stage = stage, ... )) } .assertIsTrialDesign(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design, stage = stage) .assertIsValidDataInput(dataInput = dataInput, design = design, stage = stage) on.exit(dataInput$.trim()) if (dataInput$isDatasetMeans()) { return(.getRepeatedConfidenceIntervalsMeans( design = design, dataInput = dataInput, directionUpper = directionUpper, tolerance = tolerance, stage = stage, ... )) } if (dataInput$isDatasetRates()) { return(.getRepeatedConfidenceIntervalsRates( design = design, dataInput = dataInput, directionUpper = directionUpper, tolerance = tolerance, stage = stage, ... )) } if (dataInput$isDatasetSurvival()) { return(.getRepeatedConfidenceIntervalsSurvival( design = design, dataInput = dataInput, directionUpper = directionUpper, tolerance = tolerance, stage = stage, ... )) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(dataInput), "' is not implemented yet") } .getStageResultsObject <- function(stageResults, ..., functionName) { args <- list(...) if (.isTrialDesign(stageResults)) { if (length(args) == 0) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'stageResults' must be defined") } stageResults <- args[[1]] .logDebug( "The separate specification of the design in ", functionName, "() is deprecated ", "because the 'stageResults' object contains the design already" ) } if (!.isStageResults(stageResults)) { for (arg in args) { if (.isStageResults(arg)) { return(arg) } } stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'stageResults' must be defined") } return(stageResults) } #' #' @title #' Get Conditional Power #' #' @description #' Calculates and returns the conditional power. #' #' @inheritParams param_stageResults #' @inheritParams param_nPlanned #' @inheritParams param_allocationRatioPlanned #' @param ... Further (optional) arguments to be passed: #' \describe{ #' \item{\code{thetaH1} and \code{assumedStDevs} or \code{piTreatments}, \code{piControl}}{The #' assumed effect size or assumed rates to calculate the conditional power in multi-arm trials #' or enrichment designs. For survival designs, \code{thetaH1} refers to the hazard ratio. #' You can specify a value or a vector with elements referring to the #' treatment arms or the sub-populations, respectively. #' For testing means, an assumed standard deviation can be specified, default is \code{1}.} #' \item{\code{iterations}}{Iterations for simulating the power for Fisher's combination test. #' If the power for more than one remaining stages is to be determined for Fisher's combination test, #' it is estimated via simulation with specified \cr #' \code{iterations}, the default value is \code{10000}.} #' \item{\code{seed}}{Seed for simulating the power for Fisher's combination test. #' See above, default is a random seed.} #' } #' #' @details #' The conditional power is calculated only if the effect size and the sample size is specified. #' #' For Fisher's combination test, the conditional power for more than one remaining stages is #' estimated via simulation. #' #' @seealso #' \code{\link{plot.StageResults}} or \code{\link{plot.AnalysisResults}} for plotting the conditional power. #' #' @return Returns a \code{\link{ConditionalPowerResults}} object. #' The following generics (R generic functions) are available for this result object: #' \itemize{ #' \item \code{\link[=names.FieldSet]{names}} to obtain the field names, #' \item \code{\link[=print.FieldSet]{print}} to print the object, #' \item \code{\link[=summary.ParameterSet]{summary}} to display a summary of the object, #' \item \code{\link[=plot.ParameterSet]{plot}} to plot the object, #' \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame}} to coerce the object to a \code{\link[base]{data.frame}}, #' \item \code{\link[=as.matrix.FieldSet]{as.matrix}} to coerce the object to a \code{\link[base]{matrix}}. #' } #' @template how_to_get_help_for_generics #' #' @family analysis functions #' #' @template examples_get_conditional_power #' #' @export #' getConditionalPower <- function(stageResults, ..., nPlanned, allocationRatioPlanned = 1 # C_ALLOCATION_RATIO_DEFAULT ) { .stopInCaseOfIllegalStageDefinition(stageResults, ...) .assertIsValidAllocationRatioPlanned(allocationRatioPlanned, stageResults$.dataInput$getNumberOfGroups()) stageResults <- .getStageResultsObject(stageResults = stageResults, functionName = "getConditionalPower", ...) conditionalPower <- NULL if (.isEnrichmentStageResults(stageResults)) { conditionalPower <- .getConditionalPowerEnrichment( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... ) } else if (.isMultiArmStageResults(stageResults)) { conditionalPower <- .getConditionalPowerMultiArm( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... ) } else { .assertIsStageResults(stageResults) if (stageResults$isDatasetMeans()) { conditionalPower <- .getConditionalPowerMeans( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... ) } else if (stageResults$isDatasetRates()) { conditionalPower <- .getConditionalPowerRates( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... ) } else if (stageResults$isDatasetSurvival()) { conditionalPower <- .getConditionalPowerSurvival( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... ) } } if (!is.null(conditionalPower)) { addPlotData <- .getOptionalArgument("addPlotData", ...) if (!is.null(addPlotData) && isTRUE(addPlotData)) { conditionalPower$.plotData <- .getConditionalPowerPlot( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... ) } conditionalPower$.setParameterType("nPlanned", C_PARAM_USER_DEFINED) conditionalPower$.setParameterType( "allocationRatioPlanned", ifelse(allocationRatioPlanned == C_ALLOCATION_RATIO_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED ) ) return(conditionalPower) } else { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(stageResults$.dataInput), "' is not implemented yet" ) } } .getConditionalPowerPlot <- function(..., stageResults, nPlanned, allocationRatioPlanned = NA_real_) { if (.isMultiArmStageResults(stageResults)) { return(.getConditionalPowerPlotMultiArm( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... )) } if (.isEnrichmentStageResults(stageResults)) { return(.getConditionalPowerPlotEnrichment( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... )) } .assertIsStageResults(stageResults) .stopInCaseOfIllegalStageDefinition2(...) stage <- stageResults$stage if (stage == stageResults$.design$kMax && length(nPlanned) > 0) { stage <- stageResults$.design$kMax - 1 } .assertIsValidNPlanned(nPlanned, stageResults$.design$kMax, stage) if (is.na(allocationRatioPlanned)) { allocationRatioPlanned <- C_ALLOCATION_RATIO_DEFAULT } if (stageResults$isDatasetMeans()) { return(.getConditionalPowerPlotMeans( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... )) } if (stageResults$isDatasetRates()) { return(.getConditionalPowerPlotRates( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... )) } if (stageResults$isDatasetSurvival()) { return(.getConditionalPowerPlotSurvival( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... )) } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(stageResults$.dataInput), "' is not implemented yet" ) } #' #' @title #' Get Repeated P Values #' #' @description #' Calculates the repeated p-values for a given test results. #' #' @inheritParams param_stageResults #' @inheritParams param_tolerance #' @inheritParams param_three_dots #' #' @details #' The repeated p-value at a given stage of the trial is defined as the smallest #' significance level under which at given test design the test results #' obtain rejection of the null hypothesis. It can be calculated at each #' stage of the trial and can thus be used as a monitoring tool. #' #' The repeated p-values are provided up to the specified stage. #' #' In multi-arm trials, the repeated p-values are defined separately for each #' treatment comparison within the closed testing procedure. #' #' @template details_analysis_base_mnormt_dependency #' #' @return Returns a \code{\link[base]{numeric}} vector of length \code{kMax} or in case of multi-arm stage results #' a \code{\link[base]{matrix}} (each column represents a stage, each row a comparison) #' containing the repeated p values. #' #' @family analysis functions #' #' @template examples_get_repeated_p_values #' #' @export #' getRepeatedPValues <- function(stageResults, ..., tolerance = 1e-06 # C_ANALYSIS_TOLERANCE_DEFAULT ) { .assertIsValidTolerance(tolerance) .assertIsValidTolerance(tolerance) stageResults <- .getStageResultsObject(stageResults, functionName = "getRepeatedPValues", ...) .stopInCaseOfIllegalStageDefinition(stageResults, ...) if (.isEnrichmentStageResults(stageResults)) { return(.getRepeatedPValuesEnrichment(stageResults = stageResults, tolerance = tolerance, ...)) } if (.isMultiArmStageResults(stageResults)) { return(.getRepeatedPValuesMultiArm(stageResults = stageResults, tolerance = tolerance, ...)) } .assertIsStageResults(stageResults) design <- stageResults$.design if (design$kMax == 1) { return(ifelse(design$sided == 1, stageResults$pValues[1], 2 * min(stageResults$pValues[1], 1 - stageResults$pValues[1]) )) } if (.isTrialDesignInverseNormalOrGroupSequential(design)) { if (design$typeOfDesign %in% c(C_TYPE_OF_DESIGN_AS_USER, C_TYPE_OF_DESIGN_WT_OPTIMUM)) { showWarnings <- as.logical(getOption("rpact.analyis.repeated.p.values.warnings.enabled", "TRUE")) if (showWarnings) { warning("Repeated p-values not available for 'typeOfDesign' = '", design$typeOfDesign, "'", call. = FALSE ) } return(rep(NA_real_, design$kMax)) } } if (.isTrialDesignFisher(design)) { if (design$method == C_FISHER_METHOD_USER_DEFINED_ALPHA) { warning("Repeated p-values not available for 'method' = '", C_FISHER_METHOD_USER_DEFINED_ALPHA, "'", call. = FALSE ) return(rep(NA_real_, design$kMax)) } } if (.isTrialDesignInverseNormal(design)) { return(.getRepeatedPValuesInverseNormal( stageResults = stageResults, tolerance = tolerance, ... )) } if (.isTrialDesignGroupSequential(design)) { return(.getRepeatedPValuesGroupSequential( stageResults = stageResults, tolerance = tolerance, ... )) } if (.isTrialDesignFisher(design)) { return(.getRepeatedPValuesFisher( stageResults = stageResults, tolerance = tolerance, ... )) } .stopWithWrongDesignMessage(design) } # # Get final p-value based on inverse normal method # .getFinalPValueInverseNormalOrGroupSequential <- function(stageResults) { design <- stageResults$.design .assertIsTrialDesignInverseNormalOrGroupSequential(design) if (.isTrialDesignInverseNormal(design)) { stageInverseNormalOrGroupSequential <- .getStageInverseNormal( design = design, stageResults = stageResults, stage = stageResults$stage ) } else { stageInverseNormalOrGroupSequential <- .getStageGroupSeq( design = design, stageResults = stageResults, stage = stageResults$stage ) } finalStage <- min(stageInverseNormalOrGroupSequential, design$kMax) # Early stopping or at end of study if (stageInverseNormalOrGroupSequential < design$kMax || stageResults$stage == design$kMax) { if (stageInverseNormalOrGroupSequential == 1) { pFinal <- stageResults$pValues[1] } else { if (design$bindingFutility) { if (.isTrialDesignInverseNormal(design)) { decisionMatrix <- matrix(c( design$futilityBounds[1:(finalStage - 1)], C_FUTILITY_BOUNDS_DEFAULT, c(design$criticalValues[1:(finalStage - 1)], stageResults$combInverseNormal[finalStage]) ), nrow = 2, byrow = TRUE ) } else { decisionMatrix <- matrix(c( design$futilityBounds[1:(finalStage - 1)], C_FUTILITY_BOUNDS_DEFAULT, c(design$criticalValues[1:(finalStage - 1)], .getOneMinusQNorm(stageResults$overallPValues[finalStage])) ), nrow = 2, byrow = TRUE ) } } else { if (.isTrialDesignInverseNormal(design)) { decisionMatrix <- matrix(c( rep(C_FUTILITY_BOUNDS_DEFAULT, finalStage), c(design$criticalValues[1:(finalStage - 1)], stageResults$combInverseNormal[finalStage]) ), nrow = 2, byrow = TRUE ) } else { decisionMatrix <- matrix(c( rep(C_FUTILITY_BOUNDS_DEFAULT, finalStage), c(design$criticalValues[1:(finalStage - 1)], .getOneMinusQNorm(stageResults$overallPValues[finalStage])) ), nrow = 2, byrow = TRUE ) } } probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = design$informationRates[1:finalStage] ) pFinal <- sum(probs[3, ] - probs[2, ]) if (design$sided == 2) { if (stageInverseNormalOrGroupSequential == 1) { pFinalOtherDirection <- 1 - stageResults$pValues[1] } else { if (.isTrialDesignInverseNormal(design)) { decisionMatrix <- matrix(c( rep(C_FUTILITY_BOUNDS_DEFAULT, finalStage), c(design$criticalValues[1:(finalStage - 1)], -stageResults$combInverseNormal[finalStage]) ), nrow = 2, byrow = TRUE ) } else { decisionMatrix <- matrix(c( rep(C_FUTILITY_BOUNDS_DEFAULT, finalStage), c(design$criticalValues[1:(finalStage - 1)], -.getOneMinusQNorm(stageResults$overallPValues[finalStage])) ), nrow = 2, byrow = TRUE ) } probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = design$informationRates[1:finalStage] ) pFinalOtherDirection <- sum(probs[3, ] - probs[2, ]) } pFinal <- 2 * min(pFinal, pFinalOtherDirection) } } return(list(finalStage = finalStage, pFinal = pFinal)) } return(list(finalStage = NA_integer_, pFinal = NA_real_)) } .setWeightsToStageResults <- function(design, stageResults) { if (.isTrialDesignInverseNormal(design)) { stageResults$weightsInverseNormal <- .getWeightsInverseNormal(design) stageResults$.setParameterType("weightsInverseNormal", C_PARAM_GENERATED) } else if (.isTrialDesignFisher(design)) { stageResults$weightsFisher <- .getWeightsFisher(design) stageResults$.setParameterType("weightsFisher", C_PARAM_GENERATED) } } # # Returns the weights for inverse normal statistic # .getWeightsInverseNormal <- function(design) { if (design$kMax == 1) { return(1) } weights <- rep(NA, design$kMax) weights[1] <- sqrt(design$informationRates[1]) weights[2:design$kMax] <- sqrt(design$informationRates[2:design$kMax] - design$informationRates[1:(design$kMax - 1)]) return(weights) } # # Returns the weights for Fisher's combination test statistic # .getWeightsFisher <- function(design) { if (design$kMax == 1) { return(1) } weights <- rep(NA, design$kMax) weights[1] <- 1 weights[2:design$kMax] <- sqrt((design$informationRates[2:design$kMax] - design$informationRates[1:(design$kMax - 1)]) / design$informationRates[1]) return(weights) } # # Returns the stage when using the inverse normal combination test # .getStageInverseNormal <- function(..., design, stageResults, stage) { for (k in 1:stage) { if (stageResults$combInverseNormal[k] >= design$criticalValues[k]) { return(k) } if (design$sided == 2) { if (stageResults$combInverseNormal[k] <= -design$criticalValues[k]) { return(k) } } if (design$bindingFutility && k < design$kMax && stageResults$combInverseNormal[k] <= design$futilityBounds[k]) { return(k) } } # no early stopping return(as.integer(stage + design$kMax)) } # # Returns the stage when using the group sequential test # .getStageGroupSeq <- function(..., design, stageResults, stage) { for (k in 1:stage) { if (.getOneMinusQNorm(stageResults$overallPValues[k]) >= design$criticalValues[k]) { return(k) } if (design$sided == 2) { if (.getOneMinusQNorm(stageResults$overallPValues[k]) <= -design$criticalValues[k]) { return(k) } } if (design$bindingFutility && k < design$kMax && .getQNorm(max(1e-8, 1 - stageResults$overallPValues[k])) <= design$futilityBounds[k]) { return(k) } } # no early stopping return(as.integer(stage + design$kMax)) } # # Returns the stage when using Fisher's combination test # .getStageFisher <- function(..., design, stageResults, stage) { for (k in 1:stage) { if (stageResults$combFisher[k] <= design$criticalValues[k]) { return(k) } if (design$sided == 2) { if (1 - stageResults$combFisher[k] <= design$criticalValues[k]) { return(k) } } if (design$bindingFutility && k < design$kMax && stageResults$pValues[k] >= design$alpha0Vec[k]) { return(k) } } # no early stopping return(as.integer(stage + design$kMax)) } # @title # q function # # @description # Function for calculating the final p-value for two-stage design with Fisher's combination test # and its use for calculating confidence intervals, see Wassmer & Brannath, p. 192 and Brannath et al. (2002), p. 241. # Formula generalized for arbitrary weight in combination test. # .getQFunctionResult <- function(..., design, stageResults, theta, infRate) { alpha1 <- design$criticalValues[1] alpha0 <- design$alpha0Vec[1] if (!design$bindingFutility || (design$sided == 2)) { alpha0 <- 1 } weightForFisher <- stageResults$weightsFisher[2] if (theta != 0) { alpha1Adj <- ifelse(alpha1 <= 0, 0, 1 - stats::pnorm(.getOneMinusQNorm(alpha1) - theta / stageResults$overallStDevs[1] * infRate[1]) ) } else { alpha1Adj <- alpha1 } if (is.na(alpha1Adj)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to calculate 'alpha1Adj'") } if (theta != 0) { alpha0Adj <- ifelse(alpha0 >= 1, 1, 1 - stats::pnorm(.getOneMinusQNorm(alpha0) - theta / stageResults$overallStDevs[1] * infRate[1]) ) } else { alpha0Adj <- alpha0 } if (is.na(alpha0Adj)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to calculate 'alpha0Adj'") } if (stageResults$pValues[1] <= alpha1Adj || stageResults$pValues[1] >= alpha0Adj) { return(stageResults$pValues[1]) } if (weightForFisher == 1) { return(max(alpha1Adj, stageResults$pValues[1] * stageResults$pValues[2]) + stageResults$pValues[1] * stageResults$pValues[2] * (log(alpha0Adj) - log(max( alpha1Adj, stageResults$pValues[1] * stageResults$pValues[2] )))) } return(max(alpha1Adj, stageResults$pValues[1] * stageResults$pValues[2]^weightForFisher) + weightForFisher / (weightForFisher - 1) * stageResults$pValues[1]^(1 / weightForFisher) * stageResults$pValues[2] * (alpha0Adj^(1 - 1 / weightForFisher) - max(alpha1Adj, stageResults$pValues[1] * stageResults$pValues[2]^weightForFisher)^(1 - 1 / weightForFisher))) } # # Get final p-value based on Fisher combination test # .getFinalPValueFisher <- function(stageResults) { design <- stageResults$.design .assertIsTrialDesignFisher(design) stageFisher <- .getStageFisher(design = design, stageResults = stageResults, stage = stageResults$stage) finalStage <- min(stageFisher, design$kMax) # Early stopping or at end of study if (stageFisher < design$kMax || stageResults$stage == design$kMax) { if (stageFisher == 1) { pFinal <- stageResults$pValues[1] } else { if (design$kMax > 2) { message( "Final p-value cannot be calculated for kMax = ", design$kMax, " ", "because the function for Fisher's design is implemented only for kMax <= 2" ) return(list(finalStage = NA_integer_, pFinal = NA_real_)) } # Final p-value for kMax = 2 pFinal <- .getQFunctionResult( design = design, stageResults = stageResults, theta = 0, infRate = 0 ) } if (design$sided == 2) { if (stageFisher == 1) { pFinalOtherDirection <- 1 - stageResults$pValues[1] } else { stageResults$pValues <- 1 - stageResults$pValues pFinalOtherDirection <- .getQFunctionResult( design = design, stageResults = stageResults, theta = 0, infRate = 0 ) stageResults$pValues <- 1 - stageResults$pValues } # Final p-value for kMax = 2 pFinal <- 2 * min(pFinal, pFinalOtherDirection) } return(list(finalStage = finalStage, pFinal = pFinal)) } return(list(finalStage = NA_integer_, pFinal = NA_real_)) } #' #' @title #' Get Final P Value #' #' @description #' Returns the final p-value for given stage results. #' #' @inheritParams param_stageResults #' @param ... Only available for backward compatibility. #' #' @return Returns a \code{\link[base]{list}} containing #' \itemize{ #' \item \code{finalStage}, #' \item \code{pFinal}. #' } #' #' @details #' The calculation of the final p-value is based on the stage-wise ordering of the sample space. #' This enables the calculation for both the non-adaptive and the adaptive case. #' For Fisher's combination test, it is available for \code{kMax = 2} only. #' #' @family analysis functions #' #' @template examples_get_final_p_value #' #' @export #' getFinalPValue <- function(stageResults, ...) { stageResults <- .getStageResultsObject(stageResults, functionName = "getFinalPValue", ...) .stopInCaseOfIllegalStageDefinition(stageResults, ...) .assertIsStageResultsNonMultiHypotheses(stageResults) if (stageResults$.design$kMax == 1) { return(list(finalStage = NA_integer_, pFinal = NA_real_)) } if (.isTrialDesignInverseNormalOrGroupSequential(stageResults$.design)) { return(.getFinalPValueInverseNormalOrGroupSequential(stageResults)) } if (.isTrialDesignFisher(stageResults$.design)) { return(.getFinalPValueFisher(stageResults)) } .stopWithWrongDesignMessage(stageResults$.design) } .getVectorWithFinalValueAtFinalStage <- function(..., kMax, finalValue, finalStage) { v <- rep(NA_real_, kMax) if (is.null(finalValue) || is.na(finalValue) || is.null(finalStage) || is.na(finalStage) || finalStage < 1 || finalStage > kMax) { return(v) } v[finalStage] <- finalValue return(v) } #' @title #' Get Final Confidence Interval #' #' @description #' Returns the final confidence interval for the parameter of interest. #' It is based on the prototype case, i.e., the test for testing a mean for #' normally distributed variables. #' #' @inheritParams param_design #' @inheritParams param_dataInput #' @inheritParams param_thetaH0 #' @inheritParams param_directionUpper #' @inheritParams param_tolerance #' @inheritParams param_stage #' @param ... Further (optional) arguments to be passed: #' \describe{ #' \item{\code{normalApproximation}}{ #' The type of computation of the p-values. Default is \code{FALSE} for #' testing means (i.e., the t test is used) and TRUE for testing rates and the hazard ratio. #' For testing rates, if \code{normalApproximation = FALSE} is specified, the binomial test #' (one sample) or the exact test of Fisher (two samples) is used for calculating the p-values. #' In the survival setting, \code{normalApproximation = FALSE} has no effect.} #' \item{\code{equalVariances}}{The type of t test. For testing means in two treatment groups, either #' the t test assuming that the variances are equal or the t test without assuming this, #' i.e., the test of Welch-Satterthwaite is calculated, default is \code{TRUE}.} #' } #' #' @details #' Depending on \code{design} and \code{dataInput} the final confidence interval and median unbiased estimate #' that is based on the stage-wise ordering of the sample space will be calculated and returned. #' Additionally, a non-standardized ("general") version is provided, #' the estimated standard deviation must be used to obtain #' the confidence interval for the parameter of interest. #' #' For the inverse normal combination test design with more than two #' stages, a warning informs that the validity of the confidence interval is theoretically shown only if #' no sample size change was performed. #' #' @return Returns a \code{\link[base]{list}} containing #' \itemize{ #' \item \code{finalStage}, #' \item \code{medianUnbiased}, #' \item \code{finalConfidenceInterval}, #' \item \code{medianUnbiasedGeneral}, and #' \item \code{finalConfidenceIntervalGeneral}. #' } #' #' @family analysis functions #' #' @template examples_get_final_confidence_interval #' #' @export #' getFinalConfidenceInterval <- function(design, dataInput, ..., directionUpper = TRUE, # C_DIRECTION_UPPER_DEFAULT thetaH0 = NA_real_, tolerance = 1e-06, # C_ANALYSIS_TOLERANCE_DEFAULT stage = NA_integer_) { .assertIsValidTolerance(tolerance) .assertIsTrialDesign(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design, stage = stage) .assertIsValidDataInput(dataInput = dataInput, design = design, stage = stage) .assertIsDatasetNonMultiHypotheses(dataInput) on.exit(dataInput$.trim()) if (design$bindingFutility) { warning("Two-sided final confidence bounds are not appropriate, ", "use one-sided version (i.e., one bound) only", call. = FALSE ) } if (dataInput$isDatasetMeans()) { return(.getFinalConfidenceIntervalMeans( design = design, dataInput = dataInput, stage = stage, ... )) } if (dataInput$isDatasetRates()) { return(.getFinalConfidenceIntervalRates( design = design, dataInput = dataInput, stage = stage, ... )) } if (dataInput$isDatasetSurvival()) { return(.getFinalConfidenceIntervalSurvival( design = design, dataInput = dataInput, stage = stage, ... )) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(dataInput), "' is not implemented yet") } # # Get repeated p-values based on group sequential test # .getRepeatedPValuesGroupSequential <- function(..., stageResults, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments(functionName = ".getRepeatedPValuesGroupSequential", ...) design <- stageResults$.design .assertIsTrialDesignInverseNormalOrGroupSequential(design) repeatedPValues <- rep(NA_real_, design$kMax) if (design$typeOfDesign == C_TYPE_OF_DESIGN_HP && stageResults$stage == design$kMax) { if (!is.na(stageResults$overallPValues[design$kMax]) && .getOneMinusQNorm(stageResults$overallPValues[design$kMax]) == Inf) { repeatedPValues[design$kMax] <- tolerance } else { startTime <- Sys.time() lower <- .getDesignGroupSequential( kMax = design$kMax, sided = design$sided, informationRates = design$informationRates, typeOfDesign = C_TYPE_OF_DESIGN_HP, futilityBounds = design$futilityBounds, bindingFutility = design$bindingFutility )$alphaSpent[design$kMax - 1] + tolerance upper <- 0.5 repeatedPValues[design$kMax] <- .getOneDimensionalRootBisectionMethod( fun = function(level) { y <- .getDesignGroupSequential( kMax = design$kMax, alpha = level, sided = design$sided, informationRates = design$informationRates, typeOfDesign = C_TYPE_OF_DESIGN_HP, futilityBounds = design$futilityBounds, bindingFutility = design$bindingFutility ) if (design$sided == 2) { return(y$criticalValues[design$kMax] - abs(.getOneMinusQNorm(stageResults$overallPValues[design$kMax]))) } return(y$criticalValues[design$kMax] - .getOneMinusQNorm(stageResults$overallPValues[design$kMax])) }, lower = lower, upper = upper, tolerance = tolerance, direction = -1, acceptResultsOutOfTolerance = TRUE, suppressWarnings = TRUE, callingFunctionInformation = ".getRepeatedPValuesGroupSequential" ) .logProgress("Repeated p-values for final stage calculated", startTime = startTime) } } else { typeOfDesign <- design$typeOfDesign deltaWT <- design$deltaWT typeBetaSpending <- design$typeBetaSpending if (!design$bindingFutility) { if (design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { typeOfDesign <- C_TYPE_OF_DESIGN_WT deltaWT <- design$deltaPT1 } if (design$typeBetaSpending != "none") { typeBetaSpending <- "none" } } else if ((design$typeOfDesign == C_TYPE_OF_DESIGN_PT) || (design$typeBetaSpending != "none")) { message("Calculation of repeated p-values might take a while for binding case, please wait...") } for (k in 1:stageResults$stage) { if (!is.na(stageResults$overallPValues[k]) && .getOneMinusQNorm(stageResults$overallPValues[k]) == Inf) { repeatedPValues[k] <- tolerance } else { startTime <- Sys.time() upper <- 0.5 repeatedPValues[k] <- .getOneDimensionalRootBisectionMethod( fun = function(level) { y <- .getDesignGroupSequential( kMax = design$kMax, alpha = level, sided = design$sided, informationRates = design$informationRates, typeOfDesign = typeOfDesign, typeBetaSpending = typeBetaSpending, gammaB = design$gammaB, deltaWT = deltaWT, deltaPT0 = design$deltaPT0, deltaPT1 = design$deltaPT1, beta = design$beta, gammaA = design$gammaA, futilityBounds = design$futilityBounds, bindingFutility = design$bindingFutility ) if (design$sided == 2) { return(y$criticalValues[k] - abs(.getOneMinusQNorm(stageResults$overallPValues[k]))) } return(y$criticalValues[k] - .getOneMinusQNorm(stageResults$overallPValues[k])) }, lower = tolerance, upper = upper, tolerance = tolerance, direction = -1, acceptResultsOutOfTolerance = TRUE, suppressWarnings = TRUE, callingFunctionInformation = ".getRepeatedPValuesGroupSequential" ) .logProgress("Repeated p-values of stage %s calculated", startTime = startTime, k) } } } return(repeatedPValues) } # # Get repeated p-values based on inverse normal method # .getRepeatedPValuesInverseNormal <- function(..., stageResults, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { design <- stageResults$.design .assertIsTrialDesignInverseNormalOrGroupSequential(design) .warnInCaseOfUnknownArguments(functionName = ".getRepeatedPValuesInverseNormal", ...) repeatedPValues <- rep(NA_real_, design$kMax) if (design$typeOfDesign == C_TYPE_OF_DESIGN_HP && stageResults$stage == design$kMax) { if (!is.na(stageResults$combInverseNormal[design$kMax]) && stageResults$combInverseNormal[design$kMax] == Inf) { repeatedPValues[design$kMax] <- tolerance } else { startTime <- Sys.time() lower <- .getDesignGroupSequential( kMax = design$kMax, sided = design$sided, informationRates = design$informationRates, typeOfDesign = C_TYPE_OF_DESIGN_HP, futilityBounds = design$futilityBounds, bindingFutility = design$bindingFutility )$alphaSpent[design$kMax - 1] + tolerance upper <- 0.5 repeatedPValues[design$kMax] <- .getOneDimensionalRootBisectionMethod( fun = function(level) { y <- .getDesignGroupSequential( kMax = design$kMax, alpha = level, sided = design$sided, informationRates = design$informationRates, typeOfDesign = C_TYPE_OF_DESIGN_HP, futilityBounds = design$futilityBounds, bindingFutility = design$bindingFutility ) if (design$sided == 2) { return(y$criticalValues[design$kMax] - abs(stageResults$combInverseNormal[design$kMax])) } return(y$criticalValues[design$kMax] - stageResults$combInverseNormal[design$kMax]) }, lower = lower, upper = upper, tolerance = tolerance, direction = -1, acceptResultsOutOfTolerance = TRUE, suppressWarnings = TRUE, callingFunctionInformation = ".getRepeatedPValuesInverseNormal" ) .logProgress("Repeated p-values for final stage calculated", startTime = startTime) } } else { typeOfDesign <- design$typeOfDesign deltaWT <- design$deltaWT typeBetaSpending <- design$typeBetaSpending if (!design$bindingFutility) { if (design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { typeOfDesign <- C_TYPE_OF_DESIGN_WT deltaWT <- design$deltaPT1 } if (design$typeBetaSpending != "none") { typeBetaSpending <- "none" } } else if ((design$typeOfDesign == C_TYPE_OF_DESIGN_PT) || (design$typeBetaSpending != "none")) { message("Calculation of repeated p-values might take a while for binding case, please wait...") } for (k in 1:stageResults$stage) { if (!is.na(stageResults$combInverseNormal[k]) && (stageResults$combInverseNormal[k] == Inf)) { repeatedPValues[k] <- tolerance } else { startTime <- Sys.time() upper <- 0.5 repeatedPValues[k] <- .getOneDimensionalRootBisectionMethod( fun = function(level) { y <- .getDesignGroupSequential( kMax = design$kMax, alpha = level, sided = design$sided, informationRates = design$informationRates, typeOfDesign = typeOfDesign, typeBetaSpending = typeBetaSpending, gammaB = design$gammaB, deltaWT = deltaWT, deltaPT0 = design$deltaPT0, deltaPT1 = design$deltaPT1, beta = design$beta, gammaA = design$gammaA, futilityBounds = design$futilityBounds, bindingFutility = design$bindingFutility ) if (design$sided == 2) { return(y$criticalValues[k] - abs(stageResults$combInverseNormal[k])) } return(y$criticalValues[k] - stageResults$combInverseNormal[k]) }, lower = tolerance, upper = upper, tolerance = tolerance, direction = -1, acceptResultsOutOfTolerance = TRUE, suppressWarnings = TRUE, callingFunctionInformation = ".getRepeatedPValuesInverseNormal" ) .logProgress("Repeated p-values of stage %s calculated", startTime = startTime, k) } } } return(repeatedPValues) } # # Get repeated p-values based on Fisher combination test # .getRepeatedPValuesFisher <- function(..., stageResults, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments(functionName = ".getRepeatedPValuesFisher", ...) design <- stageResults$.design .assertIsTrialDesignFisher(design) repeatedPValues <- rep(NA_real_, design$kMax) for (k in 1:stageResults$stage) { if (!is.na(stageResults$combFisher[k]) && (stageResults$combFisher[k] == 0)) { repeatedPValues[k] <- tolerance } else { startTime <- Sys.time() repeatedPValues[k] <- .getOneDimensionalRootBisectionMethod( fun = function(level) { y <- .getDesignFisher( kMax = design$kMax, alpha = level, sided = design$sided, informationRates = design$informationRates, alpha0Vec = design$alpha0Vec, bindingFutility = design$bindingFutility, method = design$method ) if (design$sided == 2) { combFisherNegStagek <- prod((1 - stageResults$pValues[1:k])^stageResults$weightsFisher[1:k]) return(y$criticalValues[k] - min(stageResults$combFisher[k], combFisherNegStagek)) } return(y$criticalValues[k] - stageResults$combFisher[k]) }, lower = tolerance, upper = 0.5, tolerance = tolerance, direction = 1, acceptResultsOutOfTolerance = TRUE, suppressWarnings = TRUE, callingFunctionInformation = ".getRepeatedPValuesFisher" ) .logProgress("Repeated p-values of stage %s calculated", startTime = startTime, k) } } return(repeatedPValues) } .getRejectValueConditionalPowerFisher <- function(..., kMax, alpha0Vec, criticalValues, weightsFisher, pValues, currentKMax, thetaH1, stage, nPlanned) { pValues <- c(pValues[1:stage], 1 - stats::pnorm(stats::rnorm( kMax - stage, thetaH1 * sqrt(nPlanned[(stage + 1):currentKMax]) ))) for (j in 1:currentKMax) { reject <- .getRejectValueFisherForOneStage( kMax = currentKMax, alpha0Vec = alpha0Vec, criticalValues = criticalValues, weightsFisher = weightsFisher, stage = j, pValues = pValues ) if (reject >= 0) { return(reject) } } return(0) } .getRejectValueFisherForOneStage <- function(..., kMax, alpha0Vec, criticalValues, weightsFisher, stage, pValues) { if (stage < kMax && pValues[stage] >= alpha0Vec[stage]) { return(0) } p <- prod(pValues[1:stage]^weightsFisher[1:stage]) if (is.na(p)) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "calculation of 'p' failed for stage ", stage, " ('pValues' = ", .arrayToString(pValues), ", 'weightsFisher' = ", .arrayToString(weightsFisher), ")" ) } if (is.na(criticalValues[stage])) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "no critical value available for stage ", stage, " ('criticalValues' = ", .arrayToString(criticalValues), ")" ) } if (p < criticalValues[stage]) { return(1) } return(-1) } .getRejectValueCrpFisher <- function(..., kMax, alpha0Vec, criticalValues, weightsFisher, k, stageResults) { pValues <- c(stageResults$pValues[1:k], stats::runif(kMax - k)) for (stage in 1:kMax) { reject <- .getRejectValueFisherForOneStage( kMax = kMax, alpha0Vec = alpha0Vec, criticalValues = criticalValues, weightsFisher = weightsFisher, stage = stage, pValues = pValues ) if (reject >= 0) { return(reject) } } return(0) } # # Get CRP based on inverse normal or group sequential method # .getConditionalRejectionProbabilitiesInverseNormalorGroupSequential <- function(..., stageResults) { .warnInCaseOfUnknownArguments( functionName = ".getConditionalRejectionProbabilitiesInverseNormalorGroupSequential", ignore = c("design"), ... ) design <- stageResults$.design .assertIsTrialDesignInverseNormalOrGroupSequential(design) criticalValues <- design$criticalValues informationRates <- design$informationRates weights <- stageResults$weightsInverseNormal futilityBounds <- design$futilityBounds kMax <- design$kMax conditionalRejectionProbabilities <- rep(NA_real_, kMax) if (kMax == 1) { return(NA_real_) } for (k in 1:min(kMax - 1, stageResults$stage)) { if (.isTrialDesignInverseNormal(design)) { # Shifted decision region for use in getGroupSeqProbs shiftedDecision <- criticalValues[(k + 1):kMax] * sqrt(sum(weights[1:k]^2) + cumsum(weights[(k + 1):kMax]^2)) / sqrt(cumsum(weights[(k + 1):kMax]^2)) - as.vector(weights[1:k] %*% .getOneMinusQNorm(stageResults$pValues[1:k])) / sqrt(cumsum(weights[(k + 1):kMax]^2)) if (k == kMax - 1) { shiftedFutilityBounds <- c() } else { shiftedFutilityBounds <- futilityBounds[(k + 1):(kMax - 1)] * sqrt(sum(weights[1:k]^2) + cumsum(weights[(k + 1):(kMax - 1)]^2)) / sqrt(cumsum(weights[(k + 1):(kMax - 1)]^2)) - as.vector(weights[1:k] %*% .getOneMinusQNorm(stageResults$pValues[1:k])) / sqrt(cumsum(weights[(k + 1):(kMax - 1)]^2)) } } else { # Shifted decision region for use in getGroupSeqProbs shiftedDecision <- criticalValues[(k + 1):kMax] * sqrt(sum(weights[1:k]^2) + cumsum(weights[(k + 1):kMax]^2)) / sqrt(cumsum(weights[(k + 1):kMax]^2)) - .getOneMinusQNorm(stageResults$overallPValues[k]) * sqrt(sum(weights[1:k]^2)) / sqrt(cumsum(weights[(k + 1):kMax]^2)) if (k == kMax - 1) { shiftedFutilityBounds <- c() } else { shiftedFutilityBounds <- futilityBounds[(k + 1):(kMax - 1)] * sqrt(sum(weights[1:k]^2) + cumsum(weights[(k + 1):(kMax - 1)]^2)) / sqrt(cumsum(weights[(k + 1):(kMax - 1)]^2)) - .getOneMinusQNorm(stageResults$overallPValues[k]) * sqrt(sum(weights[1:k]^2)) / sqrt(cumsum(weights[(k + 1):(kMax - 1)]^2)) } } # Scaled information for use in getGroupSeqProbs scaledInformation <- (informationRates[(k + 1):kMax] - informationRates[k]) / (1 - informationRates[k]) if (design$sided == 2) { decisionMatrix <- matrix(c(-shiftedDecision, shiftedDecision), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities(decisionMatrix = decisionMatrix, informationRates = scaledInformation) crp <- sum(probs[3, ] - probs[2, ] + probs[1, ]) } else { if (design$bindingFutility) { decisionMatrix <- matrix(c(shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, shiftedDecision), nrow = 2, byrow = TRUE ) } else { decisionMatrix <- matrix(c(rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - k), shiftedDecision), nrow = 2, byrow = TRUE ) } probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = scaledInformation ) crp <- sum(probs[3, ] - probs[2, ]) } conditionalRejectionProbabilities[k] <- crp } if (design$bindingFutility) { for (k in (1:min(kMax - 1, stageResults$stage))) { if (.isTrialDesignInverseNormal(design)) { if (stageResults$combInverseNormal[k] <= futilityBounds[k]) { conditionalRejectionProbabilities[k:stageResults$stage] <- 0 } } else { if (.getOneMinusQNorm(stageResults$overallPValues[k]) <= futilityBounds[k]) { conditionalRejectionProbabilities[k:stageResults$stage] <- 0 } } } } return(conditionalRejectionProbabilities) } # # Get CRP based on Fisher combination test # .getConditionalRejectionProbabilitiesFisher <- function(..., stageResults) { .warnInCaseOfUnknownArguments( functionName = ".getConditionalRejectionProbabilitiesFisher", ignore = c("stage", "design"), ... ) design <- stageResults$.design .assertIsTrialDesignFisher(design) kMax <- design$kMax if (kMax == 1) { return(NA_real_) } criticalValues <- design$criticalValues weights <- stageResults$weightsFisher if (design$bindingFutility) { alpha0Vec <- design$alpha0Vec } else { alpha0Vec <- rep(1, kMax - 1) } conditionalRejectionProbabilities <- rep(NA_real_, kMax) for (k in (1:min(kMax - 1, stageResults$stage))) { if (prod(stageResults$pValues[1:k]^weights[1:k]) <= criticalValues[k]) { conditionalRejectionProbabilities[k] <- 1 } else { if (k < kMax - 1) { conditionalRejectionProbabilities[k] <- .getFisherCombinationSize( kMax - k, alpha0Vec[(k + 1):(kMax - 1)], (criticalValues[(k + 1):kMax] / prod(stageResults$pValues[1:k]^weights[1:k]))^(1 / weights[k + 1]), weights[(k + 2):kMax] / weights[k + 1] ) } else { conditionalRejectionProbabilities[k] <- (criticalValues[kMax] / prod(stageResults$pValues[1:k]^weights[1:k]))^(1 / weights[kMax]) } } } if (design$bindingFutility) { for (k in (1:min(kMax - 1, stageResults$stage))) { if (stageResults$pValues[k] > alpha0Vec[k]) { conditionalRejectionProbabilities[k:stageResults$stage] <- 0 } } } conditionalRejectionProbabilities[conditionalRejectionProbabilities >= 1] <- 1 conditionalRejectionProbabilities[conditionalRejectionProbabilities < 0] <- NA_real_ return(conditionalRejectionProbabilities) } # # Get CRP based on Fisher combination test, tested through simulation # .getConditionalRejectionProbabilitiesFisherSimulated <- function(..., stageResults, iterations = 0, seed = NA_real_) { .warnInCaseOfUnknownArguments( functionName = ".getConditionalRejectionProbabilitiesFisherSimulated", ignore = c("design"), ... ) design <- stageResults$.design .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed) criticalValues <- design$criticalValues alpha0Vec <- design$alpha0Vec weightsFisher <- stageResults$weightsFisher kMax <- design$kMax crpFisherSimulated <- rep(NA_real_, kMax) if (iterations > 0) { seed <- .setSeed(seed) if (kMax >= 2) { for (k in 1:min(kMax - 1, stageResults$stage)) { reject <- 0 for (i in 1:iterations) { reject <- reject + .getRejectValueCrpFisher( kMax = kMax, alpha0Vec = alpha0Vec, criticalValues = criticalValues, weightsFisher = weightsFisher, k = k, stageResults = stageResults ) } crpFisherSimulated[k] <- reject / iterations } } else { warning("Simulation of CRP Fisher stopped: 'kMax' must be >= 2", call. = FALSE) } } return(list( crpFisherSimulated = crpFisherSimulated, iterations = iterations, seed = seed )) } #' #' @title #' Get Conditional Rejection Probabilities #' #' @description #' Calculates the conditional rejection probabilities (CRP) for given test results. #' #' @inheritParams param_stageResults #' @param ... Further (optional) arguments to be passed: #' \describe{ #' \item{\code{iterations}}{Iterations for simulating the conditional #' rejection probabilities for Fisher's combination test. #' For checking purposes, it can be estimated via simulation with #' specified \code{iterations}.} #' \item{\code{seed}}{Seed for simulating the conditional rejection probabilities #' for Fisher's combination test. See above, default is a random seed.} #' } #' #' @details #' The conditional rejection probability is the probability, under H0, to reject H0 #' in one of the subsequent (remaining) stages. #' The probability is calculated using the specified design. For testing rates and the #' survival design, the normal approximation is used, i.e., it is calculated with the #' use of the prototype case testing a mean for normally distributed data with known variance. #' #' The conditional rejection probabilities are provided up to the specified stage. #' #' For Fisher's combination test, you can check the validity of the CRP calculation via simulation. #' #' @return Returns a \code{\link[base]{numeric}} vector of length \code{kMax} or in case of multi-arm stage results #' a \code{\link[base]{matrix}} (each column represents a stage, each row a comparison) #' containing the conditional rejection probabilities. #' #' @family analysis functions #' #' @template examples_get_conditional_rejection_probabilities #' #' @export #' getConditionalRejectionProbabilities <- function(stageResults, ...) { stageResults <- .getStageResultsObject(stageResults, functionName = "getConditionalRejectionProbabilities", ... ) .stopInCaseOfIllegalStageDefinition(stageResults, ...) if (.isEnrichmentStageResults(stageResults)) { return(.getConditionalRejectionProbabilitiesEnrichment(stageResults = stageResults, ...)) } if (.isMultiArmStageResults(stageResults)) { return(.getConditionalRejectionProbabilitiesMultiArm(stageResults = stageResults, ...)) } .assertIsStageResults(stageResults) if (.isTrialDesignInverseNormalOrGroupSequential(stageResults$.design)) { return(.getConditionalRejectionProbabilitiesInverseNormalorGroupSequential( stageResults = stageResults, ... )) } if (.isTrialDesignFisher(stageResults$.design)) { simulateCRP <- .getOptionalArgument("simulateCRP", ...) if (!is.null(simulateCRP) && isTRUE(simulateCRP)) { iterations <- .getOptionalArgument("iterations", ...) if (!is.null(iterations) && iterations > 0) { return(.getConditionalRejectionProbabilitiesFisherSimulated( stageResults = stageResults, ... )) } } return(.getConditionalRejectionProbabilitiesFisher( stageResults = stageResults, ... )) } .stopWithWrongDesignMessage(stageResults$.design) } .getDecisionMatrixRoot <- function(..., design, stage, stageResults, tolerance, firstParameterName, case = c("finalConfidenceIntervalGeneralLower", "finalConfidenceIntervalGeneralUpper", "medianUnbiasedGeneral")) { case <- match.arg(case) firstValue <- stageResults[[firstParameterName]][stage] if (.isTrialDesignGroupSequential(design)) { firstValue <- .getOneMinusQNorm(firstValue) } if (firstValue >= 8) { return(NA_real_) } result <- .getOneDimensionalRoot( function(theta) { if (design$bindingFutility) { row1part1 <- design$futilityBounds[1:(stage - 1)] } else { row1part1 <- rep(C_FUTILITY_BOUNDS_DEFAULT, stage - 1) } row1part2 <- C_FUTILITY_BOUNDS_DEFAULT row2part1 <- design$criticalValues[1:(stage - 1)] row2part2 <- firstValue if (.isTrialDesignGroupSequential(design)) { if (stageResults$isDatasetSurvival()) { row1part3 <- theta * sqrt(design$informationRates[1:stage] / design$informationRates[stage]) * sqrt(stageResults$overallEvents[stage]) } else { if (stageResults$isOneSampleDataset()) { row1part3 <- theta * sqrt(design$informationRates[1:stage] / design$informationRates[stage]) * sqrt(stageResults$overallSampleSizes[stage]) } if (stageResults$isTwoSampleDataset()) { row1part3 <- theta * sqrt(design$informationRates[1:stage] / design$informationRates[stage]) / sqrt(1 / stageResults$overallSampleSizes1[stage] + 1 / stageResults$overallSampleSizes2[stage]) } } } if (.isTrialDesignInverseNormal(design)) { if (stageResults$isDatasetSurvival()) { events <- stageResults$getDataInput()$getEventsUpTo(stage) adjInfRate <- cumsum(stageResults$weightsInverseNormal[1:stage] * sqrt(events[1:stage])) / sqrt(cumsum(stageResults$weightsInverseNormal[1:stage]^2)) } else { if (stageResults$isOneSampleDataset()) { sampleSizes <- stageResults$getDataInput()$getSampleSizesUpTo(stage) adjInfRate <- cumsum(stageResults$weightsInverseNormal[1:stage] * sqrt(sampleSizes[1:stage])) / sqrt(cumsum(stageResults$weightsInverseNormal[1:stage]^2)) } if (stageResults$isTwoSampleDataset()) { sampleSizes1 <- stageResults$getDataInput()$getSampleSizesUpTo(stage, 1) sampleSizes2 <- stageResults$getDataInput()$getSampleSizesUpTo(stage, 2) adjInfRate <- cumsum(stageResults$weightsInverseNormal[1:stage] / sqrt(1 / sampleSizes1[1:stage] + 1 / sampleSizes2[1:stage])) / sqrt(cumsum(stageResults$weightsInverseNormal[1:stage]^2)) } } row1part3 <- theta * adjInfRate } row2part3 <- row1part3 row1 <- c(row1part1, row1part2) - row1part3 row2 <- c(row2part1, row2part2) - row2part3 decisionMatrix <- matrix(c(row1, row2), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = design$informationRates[1:stage] ) if (case == "finalConfidenceIntervalGeneralLower") { return(sum(probs[3, ] - probs[2, ]) - design$alpha / design$sided) } else if (case == "finalConfidenceIntervalGeneralUpper") { return(1 - sum(probs[3, ] - probs[2, ]) - design$alpha / design$sided) } else if (case == "medianUnbiasedGeneral") { return(sum(probs[3, ] - probs[2, ]) - 0.50) } else { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'case' = '", case, "' is not implemented") } }, lower = -8, upper = 8, tolerance = tolerance, callingFunctionInformation = ".getDecisionMatrixRoot" ) } rpact/R/class_core_parameter_set.R0000644000175000017500000015350614154651323017107 0ustar nileshnilesh## | ## | *Parameter set classes* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5644 $ ## | Last changed: $Date: 2021-12-10 14:14:55 +0100 (Fr, 10 Dez 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include f_core_constants.R NULL #' #' @name FieldSet #' #' @title #' Field Set #' #' @description #' Basic class for field sets. #' #' @details #' The field set implements basic functions for a set of fields. #' #' @include class_core_plot_settings.R #' #' @keywords internal #' #' @importFrom methods new #' FieldSet <- setRefClass("FieldSet", fields = list( .parameterTypes = "list", .parameterNames = "list", .parameterFormatFunctions = "list", .showParameterTypeEnabled = "logical", .catLines = "character" ), methods = list( .getFieldNames = function() { return(names(.self$getRefClass()$fields())) }, .getVisibleFieldNames = function() { fieldNames <- names(.self$getRefClass()$fields()) fieldNames <- fieldNames[!startsWith(fieldNames, ".")] return(fieldNames) }, .resetCat = function() { .catLines <<- character(0) }, .cat = function(..., file = "", sep = "", fill = FALSE, labels = NULL, append = FALSE, heading = 0, tableColumns = 0, consoleOutputEnabled = TRUE, na = NA_character_) { if (consoleOutputEnabled) { cat(..., file = file, sep = sep, fill = fill, labels = labels, append = append) return(invisible()) } args <- list(...) line <- "" if (length(args) > 0) { if (tableColumns > 0) { values <- unlist(args, use.names = FALSE) values <- values[values != "\n"] for (i in 1:length(values)) { values[i] <- gsub("\n", "", values[i]) } if (!is.null(na) && length(na) == 1 && !is.na(na)) { len <- min(nchar(values)) naStr <- paste0(trimws(na), " ") while (nchar(naStr) < len) { naStr <- paste0(" ", naStr) } values[is.na(values) | nchar(trimws(values)) == 0] <- naStr } line <- paste0(values, collapse = "| ") if (trimws(line) != "" && !grepl("\\| *$", line)) { line <- paste0(line, "|") } line <- paste0("| ", line) extraCells <- tableColumns - length(values) if (extraCells > 0 && trimws(line) != "") { line <- paste0(line, paste0(rep(" |", extraCells), collapse = "")) } line <- paste0(line, "\n") } else { line <- paste0(args, collapse = sep) listItemEnabled <- grepl("^ ", line) headingBaseNumber <- as.integer(getOption("rpact.print.heading.base.number", 0L)) if (is.na(headingBaseNumber)) { headingBaseNumber <- 0L } if (headingBaseNumber < -1) { warning("Illegal option ", sQuote("rpact.print.heading.base.number"), " (", headingBaseNumber, ") was set to 0") headingBaseNumber <- 0L } if (headingBaseNumber > 4) { warning("Illgeal option ", sQuote("rpact.print.heading.base.number"), " (", headingBaseNumber, ") was set to 4 becasue it was too large") headingBaseNumber <- 4L } if (heading > 0) { if (headingBaseNumber == -1) { lineBreak <- "" if (grepl("\n *$", line)) { lineBreak <- "\n\n" } line <- paste0("**", sub(": *", "", trimws(line)), "**", lineBreak) } else { headingCmd <- paste0(rep("#", heading + headingBaseNumber + 1), collapse = "") lineBreak <- "" if (grepl("\n *$", line)) { lineBreak <- "\n\n" } line <- paste0(headingCmd, " ", sub(": *", "", trimws(line)), lineBreak) } } else { parts <- strsplit(line, " *: ")[[1]] if (length(parts) == 2) { line <- paste0("*", trimws(parts[1]), "*: ", parts[2]) } } if (listItemEnabled) { if (grepl("^ ", line)) { line <- sub("^ ", "* ", line) } else { line <- paste0("* ", line) } } } } if (length(.catLines) == 0) { .catLines <<- line } else { .catLines <<- c(.catLines, line) } return(invisible()) }, .getFields = function(values) { flds = names(.self$getRefClass()$fields()) if (!missing(values)) { flds = flds[flds %in% values] } result = setNames(vector("list", length(flds)), flds) for (fld in flds) { result[[fld]] = .self[[fld]] } return(result) } ) ) #' #' @name ParameterSet #' #' @title #' Parameter Set #' #' @description #' Basic class for parameter sets. #' #' @details #' The parameter set implements basic functions for a set of parameters. #' #' @include f_core_constants.R #' @include f_parameter_set_utilities.R #' @include f_analysis_utilities.R #' #' @keywords internal #' #' @importFrom methods new #' ParameterSet <- setRefClass("ParameterSet", contains = "FieldSet", fields = list( .parameterTypes = "list", .parameterNames = "list", .parameterFormatFunctions = "list", .showParameterTypeEnabled = "logical", .catLines = "character" ), methods = list( initialize = function(..., .showParameterTypeEnabled = TRUE) { callSuper(..., .showParameterTypeEnabled = .showParameterTypeEnabled) .parameterTypes <<- list() .parameterNames <<- list() .parameterFormatFunctions <<- list() .catLines <<- character(0) }, .toString = function(startWithUpperCase = FALSE) { s <- .formatCamelCase(class(.self)) return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) }, .initParameterTypes = function() { for (parameterName in names(.parameterNames)) { .parameterTypes[[parameterName]] <<- C_PARAM_TYPE_UNKNOWN } }, .getParameterType = function(parameterName) { if (is.null(parameterName) || length(parameterName) == 0 || is.na(parameterName)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterName' must be a valid character with length > 0") } parameterType <- .parameterTypes[[parameterName]] if (is.null(parameterType)) { return(C_PARAM_TYPE_UNKNOWN) } return(parameterType[1]) }, .getParametersToShow = function() { return(.getVisibleFieldNames()) }, .setParameterType = function(parameterName, parameterType) { if (is.null(parameterName) || length(parameterName) == 0 || is.na(parameterName)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterName' must be a valid character with length > 0") } parameterType <- parameterType[1] if (!all(parameterType %in% c(C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE, C_PARAM_GENERATED, C_PARAM_DERIVED, C_PARAM_NOT_APPLICABLE))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterType' ('", parameterType, "') is invalid") } .parameterTypes[[parameterName]] <<- parameterType invisible(parameterType) }, isUserDefinedParameter = function(parameterName) { return(.getParameterType(parameterName) == C_PARAM_USER_DEFINED) }, isDefaultParameter = function(parameterName) { return(.getParameterType(parameterName) == C_PARAM_DEFAULT_VALUE) }, isGeneratedParameter = function(parameterName) { return(.getParameterType(parameterName) == C_PARAM_GENERATED) }, isDerivedParameter = function(parameterName) { return(.getParameterType(parameterName) == C_PARAM_DERIVED) }, isUndefinedParameter = function(parameterName) { return(.getParameterType(parameterName) == C_PARAM_TYPE_UNKNOWN) }, .getInputParameters = function() { params <- .getParametersOfOneGroup(c(C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE)) return(params) }, .getUserDefinedParameters = function() { return(.getParametersOfOneGroup(C_PARAM_USER_DEFINED)) }, .getDefaultParameters = function() { return(.getParametersOfOneGroup(C_PARAM_DEFAULT_VALUE)) }, .getGeneratedParameters = function() { return(.getParametersOfOneGroup(C_PARAM_GENERATED)) }, .getDerivedParameters = function() { return(.getParametersOfOneGroup(C_PARAM_DERIVED)) }, .getUndefinedParameters = function() { return(.getParametersOfOneGroup(C_PARAM_TYPE_UNKNOWN)) }, .getParameterValueIfUserDefinedOrDefault = function(parameterName) { if (isUserDefinedParameter(parameterName) || isDefaultParameter(parameterName)) { return(.self[[parameterName]]) } parameterType <- .self$getRefClass()$fields()[[parameterName]] if (parameterType == "numeric") { return(NA_real_) } if (parameterType == "integer") { return(NA_integer_) } if (parameterType == "character") { return(NA_character_) } return(NA) }, .getParametersOfOneGroup = function(parameterType) { if (length(parameterType) == 1) { parameterNames <- names(.parameterTypes[.parameterTypes == parameterType]) } else { parameterNames <- names(.parameterTypes[which(.parameterTypes %in% parameterType)]) } parametersToShow <- .getParametersToShow() if (is.null(parametersToShow) || length(parametersToShow) == 0) { return(parameterNames) } return(parametersToShow[parametersToShow %in% parameterNames]) }, .showParameterType = function(parameterName) { if (!.showParameterTypeEnabled) { return(" ") } return(paste0("[", .getParameterType(parameterName), "]")) }, .showAllParameters = function(consoleOutputEnabled = TRUE) { parametersToShow <- .getVisibleFieldNamesOrdered() for (parameter in parametersToShow) { .showParameter(parameter, showParameterType = TRUE, consoleOutputEnabled = consoleOutputEnabled) } }, .getVisibleFieldNamesOrdered = function() { visibleFieldNames <- .getVisibleFieldNames() parametersToShowSorted <- .getParametersToShow() if (is.null(parametersToShowSorted) || length(parametersToShowSorted) == 0) { return(visibleFieldNames) } visibleFieldNames <- visibleFieldNames[!(visibleFieldNames %in% parametersToShowSorted)] visibleFieldNames <- c(parametersToShowSorted, visibleFieldNames) return(visibleFieldNames) }, .show = function(..., consoleOutputEnabled = FALSE) { showType <- .getOptionalArgument("showType", ...) if (!is.null(showType) && showType == 2) { .cat("Technical developer summary of the ", .self$.toString(), " object (", methods::classLabel(class(.self)), "):\n\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .showAllParameters(consoleOutputEnabled = consoleOutputEnabled) .showParameterTypeDescription(consoleOutputEnabled = consoleOutputEnabled) } else { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "method '.show()' is not implemented in class '", class(.self), "'") } }, .catMarkdownText = function(...) { .show(consoleOutputEnabled = FALSE, ...) if (length(.catLines) == 0) { return(invisible()) } for (line in .catLines) { cat(line) } }, .showParametersOfOneGroup = function(parameters, title, orderByParameterName = TRUE, consoleOutputEnabled = TRUE) { output <- "" if (is.null(parameters) || length(parameters) == 0 || all(is.na(parameters))) { if (!missing(title) && !is.null(title) && !is.na(title) && consoleOutputEnabled) { output <- paste0(title, ": not available\n\n") .cat(output, heading = 2, consoleOutputEnabled = consoleOutputEnabled) } invisible(output) } else { if (orderByParameterName) { parameters <- sort(parameters) } if (!missing(title) && !is.null(title) && !is.na(title)) { output <- paste0(title, ":\n") .cat(output, heading = 2, consoleOutputEnabled = consoleOutputEnabled) } for (parameterName in parameters) { output <- paste0(output, .showParameter(parameterName, consoleOutputEnabled = consoleOutputEnabled)) } .cat("\n", consoleOutputEnabled = consoleOutputEnabled) output <- paste0(output, "\n") invisible(output) } }, .showParameter = function(parameterName, showParameterType = FALSE, consoleOutputEnabled = TRUE) { tryCatch({ params <- .getParameterValueFormatted(obj = .self, parameterName = parameterName) if (is.null(params) || !is.list(params)) { return(invisible("")) } if (!is.null(names(params)) && "paramValue" %in% names(params)) { return(.showParameterSingle(param = params, parameterName = parameterName, showParameterType = showParameterType, consoleOutputEnabled = consoleOutputEnabled)) } output <- "" for (i in 1:length(params)) { param <- params[[i]] category <- NULL parts <- strsplit(param$paramName, "$", fixed = TRUE)[[1]] if (length(parts) == 2) { parameterName <- parts[1] param$paramName <- parameterName category <- parts[2] categoryCaption <- .parameterNames[[category]] if (is.null(categoryCaption)) { categoryCaption <- paste0("%", category, "%") } category <- categoryCaption } outputPart <- .showParameterSingle(param = param, parameterName = parameterName, category = category, showParameterType = showParameterType, consoleOutputEnabled = consoleOutputEnabled) if (nchar(output) > 0) { output <- paste0(output, "\n", outputPart) } else { output <- outputPart } } return(invisible(output)) }, error = function(e) { if (consoleOutputEnabled) { warning("Failed to show parameter '", parameterName, "': ", e$message) } }) }, .showParameterSingle = function( param, parameterName, ..., category = NULL, showParameterType = FALSE, consoleOutputEnabled = TRUE) { if (is.null(param)) { return(invisible("")) } output <- "" tryCatch({ if (param$type == "array" && length(dim(param$paramValue)) == 3) { numberOfEntries <- dim(param$paramValue)[3] numberOfRows <- dim(param$paramValue)[1] if (numberOfEntries > 0 && numberOfRows > 0) { index <- 1 for (i in 1:numberOfEntries) { for (j in 1:numberOfRows) { output <- paste0(output, .showParameterFormatted(paramName = param$paramName, paramValue = param$paramValue[j, , i], paramValueFormatted = param$paramValueFormatted[[index]], showParameterType = showParameterType, category = i, matrixRow = ifelse(numberOfRows == 1, NA_integer_, j), consoleOutputEnabled = consoleOutputEnabled, paramNameRaw = parameterName, numberOfCategories = numberOfEntries)) index <- index + 1 } } } } else if (param$type %in% c("matrix", "array")) { n <- length(param$paramValueFormatted) if (n > 0) { for (i in 1:n) { paramValue <- param$paramValue if (is.array(paramValue) && length(dim(paramValue)) == 3 && dim(paramValue)[3] == 1) { paramValue <- paramValue[i, , 1] } else if (dim(paramValue)[1] > 1 || dim(paramValue)[2] > 1) { paramValue <- paramValue[i, ] } output <- paste0(output, .showParameterFormatted(paramName = param$paramName, paramValue = paramValue, paramValueFormatted = param$paramValueFormatted[[i]], showParameterType = showParameterType, category = category, matrixRow = ifelse(n == 1, NA_integer_, i), consoleOutputEnabled = consoleOutputEnabled, paramNameRaw = parameterName, numberOfCategories = n)) } } } else { output <- .showParameterFormatted(paramName = param$paramName, paramValue = param$paramValue, paramValueFormatted = param$paramValueFormatted, showParameterType = showParameterType, category = category, consoleOutputEnabled = consoleOutputEnabled, paramNameRaw = parameterName) } }, error = function(e) { if (consoleOutputEnabled) { warning("Failed to show single parameter '", parameterName, "' (", param$type, "): ", e$message) } }) return(invisible(output)) }, .extractParameterNameAndValue = function(parameterName) { d <- regexpr(paste0("\\..+\\$"), parameterName) if (d[1] != 1) { return(list(parameterName = parameterName, paramValue = get(parameterName))) } index <- attr(d, "match.length") objectName <- substr(parameterName, 1, index - 1) parameterName <- substr(parameterName, index + 1, nchar(parameterName)) paramValue <- get(objectName)[[parameterName]] # .closedTestResults$rejected if (objectName == ".closedTestResults" && parameterName == "rejected") { paramValueLogical <- as.logical(paramValue) if (is.matrix(paramValue)) { paramValueLogical <- matrix(paramValueLogical, ncol = ncol(paramValue)) } paramValue <- paramValueLogical } return(list(parameterName = parameterName, paramValue = paramValue)) }, .showUnknownParameters = function(consoleOutputEnabled = TRUE) { params <- .getUndefinedParameters() if (length(params) > 0) { .showParametersOfOneGroup(params, "ISSUES (parameters with undefined type)", consoleOutputEnabled = consoleOutputEnabled) } }, .showParameterFormatted = function(paramName, paramValue, ..., paramValueFormatted = NA_character_, showParameterType = FALSE, category = NULL, matrixRow = NA_integer_, consoleOutputEnabled = TRUE, paramNameRaw = NA_character_, numberOfCategories = NA_integer_) { if (!is.na(paramNameRaw)) { paramCaption <- .parameterNames[[paramNameRaw]] } if (is.null(paramCaption)) { paramCaption <- .parameterNames[[paramName]] } if (is.null(paramCaption)) { paramCaption <- paste0("%", paramName, "%") } if (!is.null(category) && !is.na(category)) { if (.isMultiArmSimulationResults(.self) && paramName == "singleNumberOfEventsPerStage") { if (!inherits(.self, "SimulationResultsEnrichmentSurvival") && !is.na(numberOfCategories) && numberOfCategories == category) { category <- "control" } paramCaption <- paste0(paramCaption, " {", category, "}") } else if (paramName == "effectList") { paramCaption <- paste0(paramCaption, " [", category, "]") } else if (.isEnrichmentSimulationResults(.self)) { categoryCaption <- .getCategoryCaptionEnrichment(.self, paramName, category) paramCaption <- paste0(paramCaption, " (", categoryCaption, ")") } else { paramCaption <- paste0(paramCaption, " (", category, ")") } if (!is.na(matrixRow)) { if (paramName == "effectList") { paramCaption <- paste0(paramCaption, " (", matrixRow, ")") } else { paramCaption <- paste0(paramCaption, " [", matrixRow, "]") } } } else if (!is.na(matrixRow)) { if (.isMultiArmAnalysisResults(.self) && paramName %in% c("conditionalErrorRate", "secondStagePValues", "adjustedStageWisePValues", "overallAdjustedTestStatistics")) { treatments <- .closedTestResults$.getHypothesisTreatmentArmVariants()[matrixRow] paramCaption <- paste0("Treatment", ifelse(grepl(",", treatments), "s", ""), " ", treatments, " vs. control") } else if (.isEnrichmentAnalysisResults(.self) || .isEnrichmentStageResults(.self) || (inherits(.self, "ClosedCombinationTestResults") && isTRUE(.self$.enrichment))) { if (paramName %in% c("indices", "conditionalErrorRate", "secondStagePValues", "adjustedStageWisePValues", "overallAdjustedTestStatistics", "rejectedIntersections")) { if (.isEnrichmentAnalysisResults(.self)) { populations <- .closedTestResults$.getHypothesisPopulationVariants()[matrixRow] } else if (inherits(.self, "ClosedCombinationTestResults")) { populations <- .self$.getHypothesisPopulationVariants()[matrixRow] } else { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "only ClosedCombinationTestResults ", "supports function .getHypothesisPopulationVariants() (object is ", class(.self), ")") } paramCaption <- paste0(paramCaption, " ", populations) } else { if (!is.na(numberOfCategories) && numberOfCategories == matrixRow) { paramCaption <- paste0(paramCaption, " F") } else { paramCaption <- paste0(paramCaption, " S", matrixRow) } } } else if (.isMultiArmAnalysisResults(.self) || grepl("StageResultsMultiArm", class(.self)) || (inherits(.self, "SimulationResults") && paramName == "effectMatrix") || (inherits(.self, "ClosedCombinationTestResults") && paramName %in% c("rejected", "separatePValues"))) { paramCaption <- paste0(paramCaption, " (", matrixRow, ")") } else { paramCaption <- paste0(paramCaption, " [", matrixRow, "]") } } if (is.null(paramValueFormatted) || length(paramValueFormatted) == 0 || is.na(paramValueFormatted)) { paramValueFormatted <- paramValue } if (is.list(paramValueFormatted)) { paramValueFormatted <- .listToString(paramValueFormatted) } if (is.function(paramValue)) { paramValueFormatted <- ifelse( .getParameterType(paramName) == C_PARAM_USER_DEFINED, "user defined", "default") } prefix <- ifelse(showParameterType, .showParameterType(paramName), "") variableNameFormatted <- .getFormattedVariableName(name = paramCaption, n = .getNChar(), prefix = prefix) output <- paste(variableNameFormatted, paramValueFormatted, "\n") .cat(output, consoleOutputEnabled = consoleOutputEnabled) invisible(output) }, .getNChar = function() { if (length(.parameterNames) == 0) { return(40) } return(min(40, max(nchar(.parameterNames))) + 4) }, .showParameterTypeDescription = function(consoleOutputEnabled = consoleOutputEnabled) { .cat("\n", consoleOutputEnabled = consoleOutputEnabled) .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) .cat(" ", C_PARAM_USER_DEFINED, ": user defined\n", consoleOutputEnabled = consoleOutputEnabled) .cat(" ", C_PARAM_DERIVED, ": derived value\n", consoleOutputEnabled = consoleOutputEnabled) .cat(" ", C_PARAM_DEFAULT_VALUE, ": default value\n", consoleOutputEnabled = consoleOutputEnabled) .cat(" ", C_PARAM_GENERATED, ": generated/calculated value\n", consoleOutputEnabled = consoleOutputEnabled) .cat(" ", C_PARAM_NOT_APPLICABLE, ": not applicable or hidden\n", consoleOutputEnabled = consoleOutputEnabled) }, .printAsDataFrame = function(parameterNames, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, handleParameterNamesAsToBeExcluded = FALSE, lineBreakEnabled = FALSE) { if (.isTrialDesign(.self)) { tableColumnNames <- .getTableColumnNames(design = .self) } else { tableColumnNames <- C_TABLE_COLUMN_NAMES } if (.isTrialDesignPlan(.self)) { parameterNames <- NULL } dataFrame <- .getAsDataFrame(parameterNames, niceColumnNamesEnabled = niceColumnNamesEnabled, includeAllParameters = includeAllParameters, handleParameterNamesAsToBeExcluded = handleParameterNamesAsToBeExcluded, returnParametersAsCharacter = TRUE, tableColumnNames = tableColumnNames) result <- as.matrix(dataFrame) if (.isTrialDesignPlan(.self)) { dimnames(result)[[1]] <- paste(" ", c(1:nrow(dataFrame))) } else if (!is.null(dataFrame[["stages"]])) { dimnames(result)[[1]] <- paste(" Stage", dataFrame$stages) } print(result, quote = FALSE, right = FALSE) }, .getNumberOfRows = function(parameterNames) { numberOfRows <- 1 for (parameterName in parameterNames) { parameterValues <- .self[[parameterName]] if (is.vector(parameterValues) && length(parameterValues) > numberOfRows) { numberOfRows <- length(parameterValues) } else if (is.matrix(parameterValues) && (nrow(parameterValues) == 1 || ncol(parameterValues) == 1) && length(parameterValues) > numberOfRows) { numberOfRows <- length(parameterValues) } } return(numberOfRows) }, .containsMultidimensionalParameters = function(parameterNames) { for (parameterName in parameterNames) { parameterValues <- .self[[parameterName]] if (!is.null(parameterValues) && is.matrix(parameterValues) && nrow(parameterValues) > 0 && ncol(parameterValues) > 0) { return(TRUE) } } return(FALSE) }, .getMultidimensionalNumberOfStages = function(parameterNames) { if (!is.null(.self[[".design"]])) { return(.self$.design$kMax) } n <- 1 for (parameterName in parameterNames) { parameterValues <- .self[[parameterName]] if (!is.null(parameterValues) && is.matrix(parameterValues) && ncol(parameterValues) > 0 && nrow(parameterValues) > n) { n <- nrow(parameterValues) } } return(n) }, .getVariedParameter = function(parameterNames, numberOfVariants) { # search for user defined parameters for (parameterName in parameterNames) { parameterValues <- .self[[parameterName]] if (!is.null(parameterValues) && !is.matrix(parameterValues) && length(parameterValues) == numberOfVariants && parameterName %in% C_VARIABLE_DESIGN_PLAN_PARAMETERS && .getParameterType(parameterName) == C_PARAM_USER_DEFINED) { return(parameterName) } } # search for default values for (parameterName in parameterNames) { parameterValues <- .self[[parameterName]] if (!is.null(parameterValues) && !is.matrix(parameterValues) && length(parameterValues) == numberOfVariants && parameterName %in% C_VARIABLE_DESIGN_PLAN_PARAMETERS && .getParameterType(parameterName) == C_PARAM_DEFAULT_VALUE) { return(parameterName) } } return(NULL) }, .getDataFrameColumnCaption = function(parameterName, tableColumnNames, niceColumnNamesEnabled) { if (length(parameterName) == 0 || parameterName == "") { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterName' must be a valid parameter name") } tableColumnName <- tableColumnNames[[parameterName]] return(ifelse(niceColumnNamesEnabled && !is.null(tableColumnName), tableColumnName, parameterName)) }, .getUnidimensionalNumberOfStages = function(parameterNames) { kMax <- .self[["kMax"]] if (is.null(kMax) && !is.null(.self[[".design"]])) { kMax <- .self[[".design"]][["kMax"]] } if (!is.null(kMax) && length(kMax) == 1 && is.integer(kMax)) { return(kMax) } n <- 1 for (parameterName in parameterNames) { parameterValues <- .self[[parameterName]] if (!is.null(parameterValues) && !is.matrix(parameterValues) && length(parameterValues) > n) { n <- length(parameterValues) } } return(n) }, .formatDataFrameParametersAsCharacter = function(dataFrame, parameterName, parameterValues, parameterCaption) { tryCatch({ formatFunctionName <- .parameterFormatFunctions[[parameterName]] if (!is.null(formatFunctionName)) { parameterValuesFormatted <- eval(call(formatFunctionName, parameterValues)) } else { parameterValuesFormatted <- as.character(parameterValues) } if (parameterName == "sided") { parameterValuesFormatted <- ifelse(parameterValues == 1, "one-sided", "two-sided") } if (!is.null(dataFrame[[parameterCaption]])) { parameterValuesFormatted[is.na(dataFrame[[parameterCaption]])] <- "" } parameterValuesFormatted[is.na(parameterValuesFormatted)] <- "" parameterValuesFormatted[parameterValuesFormatted == "NA"] <- "" if (is.null(dataFrame)) { dataFrame <- data.frame(x = parameterValuesFormatted) names(dataFrame) <- parameterCaption } else { dataFrame[[parameterCaption]] <- parameterValuesFormatted } }, error = function(e) { .logError(paste0("Error in '.getAsDataFrame'. Failed to show parameter '%s' ", "(class '%s'): %s"), parameterName, class(.self), e) }) }, .getAsDataFrameUnidimensional = function(parameterNames, niceColumnNamesEnabled, includeAllParameters, returnParametersAsCharacter, tableColumnNames) { numberOfStages <- .getUnidimensionalNumberOfStages(parameterNames) dataFrame <- NULL for (parameterName in parameterNames) { tryCatch({ parameterCaption <- ifelse(niceColumnNamesEnabled && !is.null(tableColumnNames[[parameterName]]), tableColumnNames[[parameterName]], parameterName) parameterValues <- .self[[parameterName]] if (parameterName == "futilityBounds") { parameterValues[parameterValues == C_FUTILITY_BOUNDS_DEFAULT] <- -Inf } if (length(parameterValues) == 1) { parameterValues <- rep(parameterValues, numberOfStages) } else { while (length(parameterValues) < numberOfStages) { parameterValues <- c(parameterValues, NA) } } if (includeAllParameters || ( .getParameterType(parameterName) != C_PARAM_NOT_APPLICABLE && sum(is.na(parameterValues)) < length(parameterValues))) { if (is.null(dataFrame)) { dataFrame <- data.frame(x = parameterValues) names(dataFrame) <- parameterCaption } else { dataFrame[[parameterCaption]] <- parameterValues } } if (returnParametersAsCharacter) { .formatDataFrameParametersAsCharacter(dataFrame, parameterName, parameterValues, parameterCaption) } }, error = function(e) { .logError("Failed to add parameter '%s' to data.frame: %s", parameterName, e) }) } return(dataFrame) }, .getAsDataFrame = function(parameterNames, niceColumnNamesEnabled = TRUE, includeAllParameters = FALSE, handleParameterNamesAsToBeExcluded = FALSE, returnParametersAsCharacter = FALSE, tableColumnNames = C_TABLE_COLUMN_NAMES) { parameterNamesToBeExcluded <- c() if (handleParameterNamesAsToBeExcluded) { parameterNamesToBeExcluded <- parameterNames parameterNames <- .getVisibleFieldNamesOrdered() if (!is.null(parameterNamesToBeExcluded) && length(parameterNamesToBeExcluded) > 0) { parameterNames <- parameterNames[!(parameterNames %in% parameterNamesToBeExcluded)] } } else if (is.null(parameterNames)) { parameterNames <- .getVisibleFieldNamesOrdered() } parameterNames <- parameterNames[!grepl("^\\.", parameterNames)] if (!is.null(.self[[".piecewiseSurvivalTime"]]) && .self$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { parameterNames <- parameterNames[!(parameterNames %in% c("lambda1", "lambda2"))] } if (.containsMultidimensionalParameters(parameterNames)) { return(.getAsDataFrameMultidimensional(.self, parameterNames, niceColumnNamesEnabled, includeAllParameters, returnParametersAsCharacter, tableColumnNames)) } # remove matrices for (parameterName in parameterNames) { parameterValues <- .self[[parameterName]] if (is.matrix(parameterValues) && nrow(parameterValues) != 1 && ncol(parameterValues) != 1) { parameterNames <- parameterNames[parameterNames != parameterName] } } if (length(parameterNames) == 0) { return(data.frame()) } return(.getAsDataFrameUnidimensional(parameterNames, niceColumnNamesEnabled, includeAllParameters, returnParametersAsCharacter, tableColumnNames)) }, # # Returns a sub-list. # # @param x A list from which you would like to get a sub-list. # @param listEntryNames A vector of names which specify the entries of the sub-list to return. # .getSubListByNames = function(x, listEntryNames) { "Returns a sub-list." if (!is.list(x)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'x' must be a list") } if (!is.character(listEntryNames)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'listEntryNames' must be a character vector") } return(x[which(names(x) %in% listEntryNames)]) }, .isMultiHypothesesObject = function() { return(.isEnrichmentAnalysisResults(.self) || .isEnrichmentStageResults(.self) || .isMultiArmAnalysisResults(.self) || .isMultiArmStageResults(.self)) } ) ) .getMultidimensionalNumberOfVariants <- function(parameterSet, parameterNames) { if (!is.null(parameterSet[["effectList"]])) { effectMatrixName <- .getSimulationEnrichmentEffectMatrixName(parameterSet) return(nrow(parameterSet$effectList[[effectMatrixName]])) } parameterNames <- parameterNames[!(parameterNames %in% c( "accrualTime", "accrualIntensity", "plannedSubjects", "plannedEvents", "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", "piecewiseSurvivalTime", "lambda2", "adaptations", "adjustedStageWisePValues", "overallAdjustedTestStatistics"))] if (!is.null(parameterSet[[".piecewiseSurvivalTime"]]) && parameterSet$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { parameterNames <- parameterNames[!(parameterNames %in% c("lambda1"))] } n <- 1 for (parameterName in parameterNames) { parameterValues <- parameterSet[[parameterName]] if (!is.null(parameterValues) && (is.matrix(parameterValues) || !is.array(parameterValues))) { if (is.matrix(parameterValues)) { if (parameterSet$.isMultiHypothesesObject()) { if (nrow(parameterValues) > n && ncol(parameterValues) > 0) { n <- nrow(parameterValues) } } else if (nrow(parameterValues) > 0 && ncol(parameterValues) > n) { n <- ncol(parameterValues) } } else if (length(parameterValues) > n && !parameterSet$.isMultiHypothesesObject()) { n <- length(parameterValues) } } } return(n) } .getDataFrameColumnValues <- function( parameterSet, parameterName, numberOfVariants, numberOfStages, includeAllParameters) { if (parameterSet$.getParameterType(parameterName) == C_PARAM_TYPE_UNKNOWN) { return(NULL) } if (!includeAllParameters && parameterSet$.getParameterType(parameterName) == C_PARAM_NOT_APPLICABLE) { return(NULL) } parameterValues <- parameterSet[[parameterName]] if (is.null(parameterValues) || length(parameterValues) == 0) { return(NULL) } if (is.function(parameterValues)) { return(NULL) } if (is.array(parameterValues) && !is.matrix(parameterValues)) { return(NULL) } if (parameterName %in% c("adjustedStageWisePValues", "overallAdjustedTestStatistics")) { return(NULL) } if (!is.matrix(parameterValues)) { if (length(parameterValues) == 1) { return(rep(parameterValues, numberOfVariants * numberOfStages)) } if (parameterSet$.isMultiHypothesesObject()) { if (length(parameterValues) == numberOfStages) { return(as.vector(sapply(FUN = rep, X = parameterValues, times = numberOfVariants))) } } if (length(parameterValues) == numberOfVariants) { return(rep(parameterValues, numberOfStages)) } if (parameterName %in% c("accrualTime", "accrualIntensity", "plannedEvents", "plannedSubjects", "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", "piecewiseSurvivalTime", "lambda2")) { return(NULL) } stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter '", parameterName, "' has an invalid ", "dimension (length is ", length(parameterValues), ")") } else if (parameterName == "effectMatrix") { # return effect matrix row if 'effectMatrix' is user defined if (parameterSet$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED) { return(1:ncol(parameterValues)) } return(parameterValues[nrow(parameterValues), ]) } if (grepl("futility|alpha0Vec|earlyStop", parameterName) && nrow(parameterValues) == numberOfStages - 1) { parameterValues <- rbind(parameterValues, rep(NA_real_, ncol(parameterValues))) } if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == 1) { columnValues <- c() for (parameterValue in parameterValues) { columnValues <- c(columnValues, rep(parameterValue, numberOfVariants)) } return(columnValues) } if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == numberOfVariants) { columnValues <- c() for (i in 1:nrow(parameterValues)) { for (j in 1:ncol(parameterValues)) { columnValues <- c(columnValues, parameterValues[i, j]) } } return(columnValues) } # applicable for analysis enrichment if (parameterSet$.isMultiHypothesesObject()) { if (nrow(parameterValues) %in% c(1, numberOfVariants) && ncol(parameterValues) %in% c(1, numberOfStages)) { columnValues <- c() for (j in 1:ncol(parameterValues)) { for (i in 1:nrow(parameterValues)) { columnValues <- c(columnValues, parameterValues[i, j]) } } if (nrow(parameterValues) == 1) { columnValues <- as.vector(sapply(FUN = rep, X = columnValues, times = numberOfVariants)) } if (ncol(parameterValues) == 1) { columnValues <- rep(columnValues, numberOfStages) } return(columnValues) } } if (nrow(parameterValues) == 1 && ncol(parameterValues) == 1) { return(rep(parameterValues[1, 1], numberOfStages * numberOfVariants)) } if (nrow(parameterValues) == 1 && ncol(parameterValues) == numberOfVariants) { return(rep(parameterValues[1, ], numberOfStages)) } if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == 1) { return(rep(parameterValues[, 1], numberOfVariants)) } stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter '", parameterName, "' has an invalid ", "dimension (", nrow(parameterValues), " x ", ncol(parameterValues), "); ", "expected was (", numberOfStages, " x ", numberOfVariants, ")") } .getAsDataFrameMultidimensional <- function( parameterSet, parameterNames, niceColumnNamesEnabled, includeAllParameters, returnParametersAsCharacter, tableColumnNames) { numberOfVariants <- .getMultidimensionalNumberOfVariants(parameterSet, parameterNames) numberOfStages <- parameterSet$.getMultidimensionalNumberOfStages(parameterNames) stagesCaption <- parameterSet$.getDataFrameColumnCaption("stages", tableColumnNames, niceColumnNamesEnabled) dataFrame <- data.frame( stages = sort(rep(1:numberOfStages, numberOfVariants)) ) names(dataFrame) <- stagesCaption if (parameterSet$.isMultiHypothesesObject()) { populations <- character(0) for (i in 1:numberOfVariants) { populations <- c(populations, ifelse(i == numberOfVariants, "F", paste0("S", i))) } dataFrame$populations <- rep(populations, numberOfStages) populationsCaption <- parameterSet$.getDataFrameColumnCaption("populations", tableColumnNames, niceColumnNamesEnabled) names(dataFrame) <- c(stagesCaption, populationsCaption) } variedParameter <- parameterSet$.getVariedParameter(parameterNames, numberOfVariants) tryCatch({ if (!is.null(variedParameter) && variedParameter != "stages") { variedParameterCaption <- parameterSet$.getDataFrameColumnCaption(variedParameter, tableColumnNames, niceColumnNamesEnabled) dataFrame[[variedParameterCaption]] <- rep(parameterSet[[variedParameter]], numberOfStages) } }, error = function(e) { warning(".getAsDataFrameMultidimensional: ", "failed to add 'variedParameterCaption' to data.frame; ", e$message) }) for (parameterName in parameterNames) { tryCatch({ if (!(parameterName %in% c("stages", "adaptations", "effectList")) && (is.null(variedParameter) || parameterName != variedParameter)) { columnValues <- .getDataFrameColumnValues(parameterSet, parameterName, numberOfVariants, numberOfStages, includeAllParameters) if (!is.null(columnValues)) { columnCaption <- parameterSet$.getDataFrameColumnCaption(parameterName, tableColumnNames, niceColumnNamesEnabled) dataFrame[[columnCaption]] <- columnValues if (returnParametersAsCharacter) { parameterSet$.formatDataFrameParametersAsCharacter(dataFrame, parameterName, columnValues, columnCaption) } } } if (parameterName == "effectList") { effectMatrixName <- .getSimulationEnrichmentEffectMatrixName(parameterSet) effectMatrixNameSingular <- sub("s$", "", effectMatrixName) effectMatrix <- parameterSet$effectList[[effectMatrixName]] if (ncol(effectMatrix) == 1) { dataFrame[[effectMatrixNameSingular]] <- rep(effectMatrix, numberOfStages) } else { for (j in 1:ncol(effectMatrix)) { dataFrame[[paste0(effectMatrixNameSingular, j)]] <- rep(effectMatrix[, j], numberOfStages) } } dataFrame$situation <- rep(1:nrow(effectMatrix), numberOfStages) } }, error = function(e) { warning(".getAsDataFrameMultidimensional: failed to add parameter ", sQuote(parameterName), " to data.frame; ", e$message) }) } return(dataFrame) } .getCategoryCaptionEnrichment <- function(parameterSet, parameterName, categoryNumber) { categoryCaption <- categoryNumber if (parameterName %in% c("sampleSizes", "singleNumberOfEventsPerStage")) { categoryCaption <- parameterSet$effectList$subGroups[categoryNumber] maxNumberOfDigits <- max(nchar(sub("\\D*", "", parameterSet$effectList$subGroups))) if ( parameterSet$populations > 2 && grepl(paste0("^S\\d{1,", maxNumberOfDigits - 1, "}$"), categoryCaption)) { categoryCaption <- paste0(categoryCaption, " only") } } else { if (parameterSet$populations <= 2) { categoryCaption <- ifelse(categoryNumber == parameterSet$populations, "F", "S") } else { categoryCaption <- ifelse(categoryNumber == parameterSet$populations, "F", paste0("S", categoryNumber)) } } return(categoryCaption) } #' #' @name FieldSet_names #' #' @title #' Names of a Field Set Object #' #' @description #' Function to get the names of a \code{\link{FieldSet}} object. #' #' @param x A \code{\link{FieldSet}} object. #' #' @details #' Returns the names of a field set that can be accessed by the user. #' #' @template return_names #' #' @export #' #' @keywords internal #' names.FieldSet <- function(x) { return(x$.getVisibleFieldNames()) } #' #' @name FieldSet_print #' #' @title #' Print Field Set Values #' #' @description #' \code{print} prints its \code{\link{FieldSet}} argument and returns it invisibly (via \code{invisible(x)}). #' #' @param x A \code{\link{FieldSet}} object. #' @inheritParams param_three_dots #' #' @details #' Prints the field set. #' #' @export #' #' @keywords internal #' print.FieldSet <- function(x, ...) { x$show() invisible(x) } #' #' @name ParameterSet_as.data.frame #' #' @title #' Coerce Parameter Set to a Data Frame #' #' @description #' Returns the \code{ParameterSet} as data frame. #' #' @param x A \code{\link{FieldSet}} object. #' @inheritParams param_niceColumnNamesEnabled #' @inheritParams param_includeAllParameters #' @inheritParams param_three_dots #' #' @details #' Coerces the parameter set to a data frame. #' #' @template return_dataframe #' #' @export #' #' @keywords internal #' as.data.frame.ParameterSet <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { .warnInCaseOfUnknownArguments(functionName = "as.data.frame", ...) return(x$.getAsDataFrame(parameterNames = NULL, niceColumnNamesEnabled = niceColumnNamesEnabled, includeAllParameters = includeAllParameters)) } #' #' @title #' Field Set Transpose #' #' @description #' Given a \code{FieldSet} \code{x}, t returns the transpose of \code{x}. #' #' @param x A \code{FieldSet}. #' #' @details #' Implementation of the base R generic function \code{\link[base]{t}} #' #' @keywords internal #' #' @export #' setMethod("t", "FieldSet", function(x) { x <- as.matrix(x, niceColumnNamesEnabled = TRUE) return(t(x)) } ) #' #' @title #' Create output in Markdown #' #' @description #' The \code{kable()} function returns the output of the specified object formatted in Markdown. #' #' @param x A \code{ParameterSet}. If x does not inherit from class \code{\link{ParameterSet}}, #' \code{knitr::kable(x)} will be returned. #' @param ... Other arguments (see \code{\link[knitr]{kable}}). #' #' @details #' Generic function to represent a parameter set in Markdown. #' Use \code{options("rpact.print.heading.base.number" = "NUMBER")} (where \code{NUMBER} is an integer value >= -1) to #' specify the heading level. The default is \code{options("rpact.print.heading.base.number" = "0")}, i.e., the #' top headings start with \code{##} in Markdown. \code{options("rpact.print.heading.base.number" = "-1")} means #' that all headings will be written bold but are not explicit defined as header. #' #' @export #' kable.ParameterSet <- function(x, ...) { if (inherits(x, "ParameterSet")) { return(print(x, markdown = TRUE)) } .assertPackageIsInstalled("knitr") knitr::kable(x, ...) } #' #' @title #' Create tables in Markdown #' #' @description #' The \code{kable()} function returns a single table for a single object that inherits from class \code{\link{ParameterSet}}. #' #' @details #' Generic to represent a parameter set in Markdown. #' #' @param x The object that inherits from \code{\link{ParameterSet}}. #' @param ... Other arguments (see \code{\link[knitr]{kable}}). #' #' @export #' setGeneric("kable", kable.ParameterSet) #' #' @name FrameSet_as.matrix #' #' @title #' Coerce Frame Set to a Matrix #' #' @description #' Returns the \code{FrameSet} as matrix. #' #' @param x A \code{\link{FieldSet}} object. #' @param enforceRowNames If \code{TRUE}, row names will be created #' depending on the object type, default is \code{TRUE}. #' @inheritParams param_niceColumnNamesEnabled #' @inheritParams param_three_dots #' #' @details #' Coerces the frame set to a matrix. #' #' @template return_matrix #' #' @export #' #' @keywords internal #' as.matrix.FieldSet <- function(x, ..., enforceRowNames = TRUE, niceColumnNamesEnabled = TRUE) { dataFrame <- as.data.frame(x, niceColumnNamesEnabled = niceColumnNamesEnabled) dataFrame <- .setStagesAsFirstColumn(dataFrame) result <- as.matrix(dataFrame) if (nrow(result) == 0) { return(result) } if (inherits(x, "PowerAndAverageSampleNumberResult")) { dimnames(result)[[1]] <- rep("", nrow(result)) return(result) } if (inherits(x, "AnalysisResults")) { dfDesign <- as.data.frame(x$.design, niceColumnNamesEnabled = niceColumnNamesEnabled) dfStageResults <- as.data.frame(x$.stageResults, niceColumnNamesEnabled = niceColumnNamesEnabled) dfStageResults <- dfStageResults[!is.na(dfStageResults[, grep("(test statistic)|(testStatistics)", colnames(dfStageResults))]), ] if (length(intersect(names(dfDesign), names(dfStageResults))) == 1) { dfTemp <- merge(dfDesign, dfStageResults) if (length(intersect(names(dfTemp), names(dataFrame))) >= 1) { dataFrame <- merge(dfTemp, dataFrame, all.x = FALSE, all.y = TRUE) dataFrame <- .setStagesAsFirstColumn(dataFrame) result <- as.matrix(dataFrame) } } else if (length(intersect(names(dfStageResults), names(dataFrame))) >= 1) { dataFrame <- merge(dfStageResults, dataFrame, all.x = FALSE, all.y = TRUE) dataFrame <- .setStagesAsFirstColumn(dataFrame) result <- as.matrix(dataFrame) } } if (any(grepl("^(S|s)tages?$", colnames(result)))) { dimnames(result)[[1]] <- rep("", nrow(result)) } return(result) } .setStagesAsFirstColumn <- function(data) { columnNames <- colnames(data) index <- grep("^(S|s)tages?$", columnNames) if (length(index) == 0 || index == 1) { return(data) } stageName <- columnNames[index[1]] stageNumbers <- data[, stageName] if (is.null(stageNumbers)|| length(stageNumbers) == 0) { return(data) } data <- data[, c(stageName, columnNames[columnNames != stageName])] return(data) } #' #' @name ParameterSet_summary #' #' @title #' Parameter Set Summary #' #' @description #' Displays a summary of \code{\link{ParameterSet}} object. #' #' @param object A \code{\link{ParameterSet}} object. #' @inheritParams param_digits #' @inheritParams param_three_dots #' #' @details #' Summarizes the parameters and results of a parameter set. #' #' @template details_summary #' #' @template return_object_summary #' @template how_to_get_help_for_generics #' #' @export #' #' @keywords internal #' summary.ParameterSet <- function(object, ..., type = 1, digits = NA_integer_, output = c("all", "title", "overview", "body")) { .warnInCaseOfUnknownArguments(functionName = "summary", ...) if (type == 1 && inherits(object, "SummaryFactory")) { return(object) } if (type == 1 && (inherits(object, "TrialDesign") || inherits(object, "TrialDesignPlan") || inherits(object, "SimulationResults") || inherits(object, "AnalysisResults") || inherits(object, "TrialDesignCharacteristics"))) { output <- match.arg(output) return(.createSummary(object, digits = digits, output = output)) } # create technical summary object$show(showType = 2) object$.cat("\n") if (!is.null(object[[".piecewiseSurvivalTim"]])) { object$.piecewiseSurvivalTime$show() object$.cat("\n") } if (!is.null(object[[".accrualTime"]])) { object$.accrualTime$show() object$.cat("\n") } object$.cat(object$.toString(startWithUpperCase = TRUE), " table:\n", heading = 1) parametersToShow <- object$.getParametersToShow() for (parameter in parametersToShow) { if (length(object[[parameter]]) == 1) { parametersToShow <- parametersToShow[parametersToShow != parameter] } } object$.printAsDataFrame(parameterNames = parametersToShow, niceColumnNamesEnabled = TRUE) invisible(object) } #' #' @name ParameterSet_print #' #' @title #' Print Parameter Set Values #' #' @description #' \code{print} prints its \code{ParameterSet} argument and returns it invisibly (via \code{invisible(x)}). #' #' @param x The \code{\link{ParameterSet}} object to print. #' @param markdown If \code{TRUE}, the object \code{x} will be printed using markdown syntax; #' normal representation will be used otherwise (default is \code{FALSE}) #' @inheritParams param_three_dots #' #' @details #' Prints the parameters and results of a parameter set. #' #' @export #' #' @keywords internal #' print.ParameterSet <- function(x, ..., markdown = FALSE) { if (markdown) { x$.catMarkdownText() return(invisible(x)) } x$show() invisible(x) } #' #' @title #' Parameter Set Plotting #' #' @description #' Plots an object that inherits from class \code{\link{ParameterSet}}. #' #' @param x The object that inherits from \code{\link{ParameterSet}}. #' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). #' @param main The main title. #' @param xlab The x-axis label. #' @param ylab The y-axis label. #' @param type The plot type (default = 1). #' @inheritParams param_palette #' @inheritParams param_showSource #' @inheritParams param_plotSettings #' @inheritParams param_legendPosition #' @inheritParams param_three_dots_plot #' #' @details #' Generic function to plot a parameter set. #' #' @template return_object_ggplot #' #' @export #' plot.ParameterSet <- function(x, y, ..., main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", legendPosition = NA_integer_, showSource = FALSE, plotSettings = NULL) { .assertGgplotIsInstalled() stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "sorry, function 'plot' is not implemented yet for class '", class(x), "'") } rpact/R/f_analysis_enrichment_survival.R0000644000175000017500000014352714165522544020364 0ustar nileshnilesh## | ## | *Analysis of survival in enrichment designs with adaptive test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5684 $ ## | Last changed: $Date: 2022-01-05 12:27:24 +0100 (Mi, 05 Jan 2022) $ ## | Last changed by: $Author: wassmer $ ## | ## | # @title # Get Analysis Results Survival # # @description # Returns an analysis result object. # # @param design The trial design. # # @return Returns a \code{AnalysisResultsSurvival} object. # # @keywords internal # .calcSurvivalTestStatistics <- function(dataInput, subset, stage, thetaH0, stratifiedAnalysis, directionUpper = TRUE) { overallEvents <- NA_real_ testStatistics <- NA_real_ separatePValues <- NA_real_ overallAllocationRatios <- NA_real_ overallTestStatistics <- NA_real_ if (!all(is.na(dataInput$getOverallEvents(stage = stage, subset = subset)))) { overallEvents <- sum(dataInput$getOverallEvents(stage = stage, subset = subset), na.rm = TRUE) if (dataInput$isStratified()) { overallAllocationRatios <- sum(dataInput$getOverallAllocationRatios(stage = stage, subset = subset) * dataInput$getOverallEvents(stage = stage, subset = subset), na.rm = TRUE) / sum(dataInput$getOverallEvents(stage = stage, subset = subset), na.rm = TRUE) overallTestStatistics <- (sum(dataInput$getOverallEvents(stage = stage, subset = subset), na.rm = TRUE) - sum(dataInput$getOverallExpectedEvents(stage = stage, subset = subset), na.rm = TRUE)) / sqrt(sum(dataInput$getOverallVarianceEvents(stage = stage, subset = subset), na.rm = TRUE)) - sqrt(sum(dataInput$getOverallEvents(stage = stage, subset = subset), na.rm = TRUE)) * sqrt(overallAllocationRatios) / (1 + overallAllocationRatios) * log(thetaH0) if (stage == 1) { testStatistics <- overallTestStatistics } else { testStatistics <- (sqrt(sum(dataInput$getOverallEvents(stage = stage, subset = subset), na.rm = TRUE)) * (sum(dataInput$getOverallEvents(stage = stage, subset = subset), na.rm = TRUE) - sum(dataInput$getOverallExpectedEvents(stage = stage, subset = subset), na.rm = TRUE)) / sqrt(sum(dataInput$getOverallVarianceEvents(stage = stage, subset = subset), na.rm = TRUE)) - sqrt(sum(dataInput$getOverallEvents(stage = stage - 1, subset = subset), na.rm = TRUE)) * (sum(dataInput$getOverallEvents(stage = stage - 1, subset = subset) - dataInput$getOverallExpectedEvents(stage = stage - 1, subset = subset), na.rm = TRUE)) / sqrt(sum(dataInput$getOverallVarianceEvents(stage = stage - 1, subset = subset), na.rm = TRUE))) / sqrt(sum(dataInput$getOverallEvents(stage = stage, subset = subset) - dataInput$getOverallEvents(stage = stage - 1, subset = subset), na.rm = TRUE)) - sqrt(sum(dataInput$getOverallEvents(stage = stage, subset = subset) - dataInput$getOverallEvents(stage = stage - 1, subset = subset), na.rm = TRUE)) * sqrt(overallAllocationRatios) / (1 + overallAllocationRatios) * log(thetaH0) } } # non-stratified data input else { overallTestStatistics <- dataInput$getOverallLogRanks(stage = stage, subset = subset) - sqrt(dataInput$getOverallEvents(stage = stage, subset = subset)) * sqrt(dataInput$getOverallAllocationRatios(stage = stage, subset = subset)) / (1 + dataInput$getOverallAllocationRatios(stage = stage, subset = subset)) * log(thetaH0) testStatistics <- dataInput$getLogRanks(stage = stage, subset = subset) - sqrt(dataInput$getEvents(stage = stage, subset = subset)) * sqrt(dataInput$getAllocationRatios(stage = stage, subset = subset)) / (1 + dataInput$getAllocationRatios(stage = stage, subset = subset)) * log(thetaH0) overallAllocationRatios <- dataInput$getOverallAllocationRatios(stage = stage, subset = subset) } if (directionUpper) { separatePValues <- 1 - stats::pnorm(testStatistics) } else { separatePValues <- stats::pnorm(testStatistics) } } if (("R" %in% subset) && is.na(dataInput$getOverallEvents(stage = stage, subset = "R")) || ("S1" %in% subset) && is.na(dataInput$getOverallEvents(stage = stage, subset = "S1")) || ("S2" %in% subset) && is.na(dataInput$getOverallEvents(stage = stage, subset = "S2")) || ("S3" %in% subset) && is.na(dataInput$getOverallEvents(stage = stage, subset = "S3")) || ("S4" %in% subset) && is.na(dataInput$getOverallEvents(stage = stage, subset = "S4")) ) { overallEvents <- NA_real_ separatePValues <- NA_real_ testStatistics <- NA_real_ overallAllocationRatios <- NA_real_ overallTestStatistics <- NA_real_ } return(list( overallEvents = overallEvents, separatePValues = separatePValues, testStatistics = testStatistics, overallAllocationRatios = overallAllocationRatios, overallTestStatistics = overallTestStatistics )) } .getStageResultsSurvivalEnrichment <- function(..., design, dataInput, thetaH0 = C_THETA_H0_SURVIVAL_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, calculateSingleStepAdjusted = FALSE, userFunctionCallEnabled = FALSE) { .assertIsTrialDesign(design) .assertIsDatasetSurvival(dataInput) .assertIsValidThetaH0DataInput(thetaH0, dataInput) .assertIsValidDirectionUpper(directionUpper, design$sided) .assertIsSingleLogical(calculateSingleStepAdjusted, "calculateSingleStepAdjusted") .warnInCaseOfUnknownArguments( functionName = ".getStageResultsSurvivalEnrichment", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) kMax <- design$kMax if (dataInput$isStratified()) { gMax <- log(length(levels(factor(dataInput$subsets))), 2) + 1 } else { gMax <- length(levels(factor(dataInput$subsets))) } .assertIsValidIntersectionTestEnrichment(design, intersectionTest) if ((gMax > 2) && intersectionTest == "SpiessensDebois") { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "gMax (", gMax, ") > 2: Spiessens & Debois intersection test test can only be used for one subset" ) } if (!stratifiedAnalysis) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "Only stratified analysis can be performed for enrichment survival designs" ) } if (dataInput$isStratified() && (gMax > 4)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "gMax (", gMax, ") > 4: Stratified analysis not implemented" ) } stageResults <- StageResultsEnrichmentSurvival( design = design, dataInput = dataInput, intersectionTest = intersectionTest, thetaH0 = thetaH0, direction = ifelse(directionUpper, C_DIRECTION_UPPER, C_DIRECTION_LOWER), directionUpper = directionUpper, stratifiedAnalysis = stratifiedAnalysis, stage = stage ) .setValueAndParameterType( stageResults, "stratifiedAnalysis", stratifiedAnalysis, C_STRATIFIED_ANALYSIS_DEFAULT ) .setValueAndParameterType( stageResults, "intersectionTest", intersectionTest, C_INTERSECTION_TEST_ENRICHMENT_DEFAULT ) effectSizes <- matrix(NA_real_, nrow = gMax, ncol = kMax) testStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) separatePValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallTestStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallEvents <- matrix(NA_real_, nrow = gMax, ncol = kMax) dimnames(testStatistics) <- list(paste("population ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "")) dimnames(separatePValues) <- list(paste("population ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "")) subsets <- .createSubsetsByGMax(gMax = gMax, stratifiedInput = dataInput$isStratified(), subsetIdPrefix = "S") for (k in 1:stage) { for (population in 1:gMax) { subset <- subsets[[population]] results <- .calcSurvivalTestStatistics( dataInput, subset, k, thetaH0, stratifiedAnalysis, directionUpper ) effectSizes[population, k] <- thetaH0 * exp(results$overallTestStatistics * (1 + results$overallAllocationRatios) / sqrt(results$overallAllocationRatios * results$overallEvents)) overallTestStatistics[population, k] <- results$overallTestStatistics testStatistics[population, k] <- results$testStatistics separatePValues[population, k] <- results$separatePValues overallEvents[population, k] <- results$overallEvents } } .setWeightsToStageResults(design, stageResults) # calculation of single stage adjusted p-Values and overall test statistics for determination of RCIs if (calculateSingleStepAdjusted) { singleStepAdjustedPValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) combInverseNormal <- matrix(NA_real_, nrow = gMax, ncol = kMax) combFisher <- matrix(NA_real_, nrow = gMax, ncol = kMax) if (.isTrialDesignInverseNormal(design)) { weightsInverseNormal <- stageResults$weightsInverseNormal } else if (.isTrialDesignFisher(design)) { weightsFisher <- stageResults$weightsFisher } for (k in 1:stage) { selected <- sum(!is.na(separatePValues[, k])) for (population in 1:gMax) { if ((intersectionTest == "Bonferroni") || (intersectionTest == "Simes")) { singleStepAdjustedPValues[population, k] <- min(1, separatePValues[population, k] * selected) } else if (intersectionTest == "Sidak") { singleStepAdjustedPValues[population, k] <- 1 - (1 - separatePValues[population, k])^selected } else if (intersectionTest == "SpiessensDebois") { if (!is.na(testStatistics[population, k])) { df <- NA_real_ sigma <- 1 if (selected == 2) { if (dataInput$isStratified()) { sigma <- matrix(rep(sqrt(dataInput$getEvents(stage = k, subset = "S1") / sum(dataInput$getEvents(stage = k))), 4), nrow = 2) } else { sigma <- matrix(rep(sqrt(dataInput$getEvents(stage = k, subset = "S1") / dataInput$getEvents(stage = k, subset = "F")), 4), nrow = 2) } diag(sigma) <- 1 } singleStepAdjustedPValues[population, k] <- 1 - .getMultivariateDistribution( type = "normal", upper = ifelse(directionUpper, testStatistics[population, k], -testStatistics[population, k]), sigma = sigma, df = NA ) } } if (.isTrialDesignInverseNormal(design)) { combInverseNormal[population, k] <- (weightsInverseNormal[1:k] %*% .getOneMinusQNorm(singleStepAdjustedPValues[population, 1:k])) / sqrt(sum(weightsInverseNormal[1:k]^2)) } else if (.isTrialDesignFisher(design)) { combFisher[population, k] <- prod(singleStepAdjustedPValues[population, 1:k]^weightsFisher[1:k]) } } } stageResults$overallTestStatistics <- overallTestStatistics stageResults$effectSizes <- effectSizes stageResults$testStatistics <- testStatistics stageResults$separatePValues <- separatePValues stageResults$singleStepAdjustedPValues <- singleStepAdjustedPValues stageResults$.setParameterType("singleStepAdjustedPValues", C_PARAM_GENERATED) if (.isTrialDesignFisher(design)) { stageResults$combFisher <- combFisher stageResults$.setParameterType("combFisher", C_PARAM_GENERATED) } else if (.isTrialDesignInverseNormal(design)) { stageResults$combInverseNormal <- combInverseNormal stageResults$.setParameterType("combInverseNormal", C_PARAM_GENERATED) } } else { stageResults$overallTestStatistics <- overallTestStatistics stageResults$.overallEvents <- overallEvents stageResults$effectSizes <- effectSizes stageResults$testStatistics <- testStatistics stageResults$separatePValues <- separatePValues } return(stageResults) } .getAnalysisResultsSurvivalEnrichment <- function(..., design, dataInput) { if (.isTrialDesignInverseNormal(design)) { return(.getAnalysisResultsSurvivalInverseNormalEnrichment( design = design, dataInput = dataInput, ... )) } if (.isTrialDesignFisher(design)) { return(.getAnalysisResultsSurvivalFisherEnrichment( design = design, dataInput = dataInput, ... )) } .stopWithWrongDesignMessage(design) } .getAnalysisResultsSurvivalInverseNormalEnrichment <- function(..., design, dataInput, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, thetaH0 = C_THETA_H0_SURVIVAL_DEFAULT, thetaH1 = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .assertIsTrialDesignInverseNormal(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsSurvivalInverseNormalEnrichment", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsEnrichmentInverseNormal(design = design, dataInput = dataInput) results <- .getAnalysisResultsSurvivalEnrichmentAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, stratifiedAnalysis = stratifiedAnalysis, thetaH0 = thetaH0, thetaH1 = thetaH1, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance ) return(results) } .getAnalysisResultsSurvivalFisherEnrichment <- function(..., design, dataInput, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, thetaH0 = C_THETA_H0_SURVIVAL_DEFAULT, thetaH1 = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsSurvivalFisherEnrichment", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsEnrichmentFisher(design = design, dataInput = dataInput) results <- .getAnalysisResultsSurvivalEnrichmentAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, stratifiedAnalysis = stratifiedAnalysis, thetaH0 = thetaH0, thetaH1 = thetaH1, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance, iterations = iterations, seed = seed ) return(results) } .getAnalysisResultsSurvivalEnrichmentAll <- function(..., results, design, dataInput, intersectionTest, stage, directionUpper, stratifiedAnalysis, thetaH0, thetaH1, nPlanned, allocationRatioPlanned, tolerance, iterations, seed) { startTime <- Sys.time() stageResults <- .getStageResultsSurvivalEnrichment( design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, stratifiedAnalysis = stratifiedAnalysis ) results$.setStageResults(stageResults) .logProgress("Stage results calculated", startTime = startTime) thetaH1 <- .assertIsValidThetaH1ForEnrichment(thetaH1, stageResults, stage, results = results) .setValueAndParameterType(results, "intersectionTest", intersectionTest, C_INTERSECTION_TEST_ENRICHMENT_DEFAULT) .setValueAndParameterType(results, "directionUpper", directionUpper, C_DIRECTION_UPPER_DEFAULT) .setValueAndParameterType(results, "stratifiedAnalysis", stratifiedAnalysis, C_STRATIFIED_ANALYSIS_DEFAULT) .setValueAndParameterType(results, "thetaH0", thetaH0, C_THETA_H0_MEANS_DEFAULT) .setConditionalPowerArguments(results, dataInput, nPlanned, allocationRatioPlanned) .setNPlannedAndThetaH1(results, nPlanned, thetaH1) startTime <- Sys.time() results$.closedTestResults <- getClosedCombinationTestResults(stageResults = stageResults) .logProgress("Closed test calculated", startTime = startTime) if (design$kMax > 1) { # conditional power startTime <- Sys.time() if (.isTrialDesignFisher(design)) { conditionalPowerResults <- .getConditionalPowerSurvivalEnrichment( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, iterations = iterations, seed = seed ) if (conditionalPowerResults$simulated) { results$conditionalPowerSimulated <- conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalPowerSimulated", C_PARAM_GENERATED) } else { results$conditionalPower <- conditionalPowerResults$conditionalPower results$conditionalPowerSimulated <- matrix(numeric(0)) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$.setParameterType("conditionalPowerSimulated", C_PARAM_NOT_APPLICABLE) } } else { conditionalPowerResults <- .getConditionalPowerSurvivalEnrichment( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1 ) results$conditionalPower <- conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_GENERATED) } results$thetaH1 <- matrix(conditionalPowerResults$thetaH1, ncol = 1) results$.conditionalPowerResults <- conditionalPowerResults .logProgress("Conditional power calculated", startTime = startTime) # CRP - conditional rejection probabilities startTime <- Sys.time() results$conditionalRejectionProbabilities <- .getConditionalRejectionProbabilitiesEnrichment( stageResults = stageResults, stage = stage, iterations = iterations, seed = seed ) results$.setParameterType("conditionalRejectionProbabilities", C_PARAM_GENERATED) .logProgress("Conditional rejection probabilities (CRP) calculated", startTime = startTime) } else { results$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalPowerSimulated", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalRejectionProbabilities", C_PARAM_NOT_APPLICABLE) } # RCI - repeated confidence interval repeatedConfidenceIntervalLowerBounds <- numeric(0) repeatedConfidenceIntervalUpperBounds <- numeric(0) startTime <- Sys.time() repeatedConfidenceIntervals <- .getRepeatedConfidenceIntervalsSurvivalEnrichment( design = design, dataInput = dataInput, stratifiedAnalysis = stratifiedAnalysis, intersectionTest = intersectionTest, stage = stage, tolerance = tolerance ) gMax <- stageResults$getGMax() results$repeatedConfidenceIntervalLowerBounds <- matrix(rep(NA_real_, gMax * design$kMax), nrow = gMax, ncol = design$kMax) results$repeatedConfidenceIntervalUpperBounds <- results$repeatedConfidenceIntervalLowerBounds for (k in 1:design$kMax) { for (population in 1:gMax) { results$repeatedConfidenceIntervalLowerBounds[population, k] <- repeatedConfidenceIntervals[population, 1, k] results$repeatedConfidenceIntervalUpperBounds[population, k] <- repeatedConfidenceIntervals[population, 2, k] } } results$.setParameterType("repeatedConfidenceIntervalLowerBounds", C_PARAM_GENERATED) results$.setParameterType("repeatedConfidenceIntervalUpperBounds", C_PARAM_GENERATED) # repeated p-value results$repeatedPValues <- .getRepeatedPValuesEnrichment(stageResults = stageResults, tolerance = tolerance) results$.setParameterType("repeatedPValues", C_PARAM_GENERATED) message("Test statistics from full (and sub-populations) need to be stratified log-rank tests") return(results) } .getRootThetaSurvivalEnrichment <- function(..., design, dataInput, treatmentArm, stage, directionUpper, stratifiedAnalysis, intersectionTest, thetaLow, thetaUp, firstParameterName, secondValue, tolerance) { result <- .getOneDimensionalRoot( function(theta) { stageResults <- .getStageResultsSurvivalEnrichment( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, stratifiedAnalysis = stratifiedAnalysis, intersectionTest = intersectionTest, calculateSingleStepAdjusted = TRUE ) firstValue <- stageResults[[firstParameterName]][treatmentArm, stage] return(firstValue - secondValue) }, lower = thetaLow, upper = thetaUp, tolerance = tolerance, callingFunctionInformation = ".getRootThetaSurvivalEnrichment" ) return(result) } .getUpperLowerThetaSurvivalEnrichment <- function(..., design, dataInput, theta, treatmentArm, stage, directionUpper, conditionFunction, stratifiedAnalysis, intersectionTest, firstParameterName, secondValue) { stageResults <- .getStageResultsSurvivalEnrichment( design = design, dataInput = dataInput, stage = stage, thetaH0 = exp(theta), directionUpper = directionUpper, stratifiedAnalysis = stratifiedAnalysis, intersectionTest = intersectionTest, calculateSingleStepAdjusted = TRUE ) firstValue <- stageResults[[firstParameterName]][treatmentArm, stage] maxSearchIterations <- 30 while (conditionFunction(secondValue, firstValue)) { theta <- 2 * theta stageResults <- .getStageResultsSurvivalEnrichment( design = design, dataInput = dataInput, stage = stage, thetaH0 = exp(theta), directionUpper = directionUpper, stratifiedAnalysis = stratifiedAnalysis, intersectionTest = intersectionTest, calculateSingleStepAdjusted = TRUE ) firstValue <- stageResults[[firstParameterName]][treatmentArm, stage] maxSearchIterations <- maxSearchIterations - 1 if (maxSearchIterations < 0) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, sprintf( paste0( "failed to find theta (k = %s, firstValue = %s, ", "secondValue = %s, levels(firstValue) = %s, theta = %s)" ), stage, stageResults[[firstParameterName]][treatmentArm, stage], secondValue, firstValue, theta ) ) } } return(theta) } .getRepeatedConfidenceIntervalsSurvivalEnrichmentAll <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, firstParameterName) { .assertIsValidIntersectionTestEnrichment(design, intersectionTest) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) stageResults <- .getStageResultsSurvivalEnrichment( design = design, dataInput = dataInput, stage = stage, thetaH0 = 1, directionUpper = directionUpper, stratifiedAnalysis = stratifiedAnalysis, intersectionTest = intersectionTest, calculateSingleStepAdjusted = FALSE ) gMax <- stageResults$getGMax() repeatedConfidenceIntervals <- array(NA_real_, dim = c(gMax, 2, design$kMax)) # Repeated onfidence intervals when using combination tests if (.isTrialDesignFisher(design)) { bounds <- design$alpha0Vec border <- C_ALPHA_0_VEC_DEFAULT criticalValues <- design$criticalValues conditionFunction <- .isFirstValueSmallerThanSecondValue } else if (.isTrialDesignInverseNormal(design)) { bounds <- design$futilityBounds border <- C_FUTILITY_BOUNDS_DEFAULT criticalValues <- design$criticalValues criticalValues[is.infinite(criticalValues) & criticalValues > 0] <- C_QNORM_MAXIMUM criticalValues[is.infinite(criticalValues) & criticalValues < 0] <- C_QNORM_MINIMUM conditionFunction <- .isFirstValueGreaterThanSecondValue } if (any(is.na(criticalValues[1:stage]))) { warning("Repeated confidence intervals not because ", sum(is.na(criticalValues)), " critical values are NA (", .arrayToString(criticalValues), ")", call. = FALSE ) return(repeatedConfidenceIntervals) } # necessary for adjustment for binding futility boundaries futilityCorr <- rep(NA_real_, design$kMax) stages <- (1:stage) for (k in stages) { startTime <- Sys.time() for (g in 1:gMax) { if (!is.na(stageResults$testStatistics[g, k])) { # Finding maximum upper and minimum lower bounds for RCIs thetaLow <- exp(.getUpperLowerThetaSurvivalEnrichment( design = design, dataInput = dataInput, theta = -1, treatmentArm = g, stage = k, directionUpper = TRUE, stratifiedAnalysis = stratifiedAnalysis, intersectionTest = intersectionTest, conditionFunction = conditionFunction, firstParameterName = firstParameterName, secondValue = criticalValues[k] )) thetaUp <- exp(.getUpperLowerThetaSurvivalEnrichment( design = design, dataInput = dataInput, theta = 1, treatmentArm = g, stage = k, directionUpper = FALSE, stratifiedAnalysis = stratifiedAnalysis, intersectionTest = intersectionTest, conditionFunction = conditionFunction, firstParameterName = firstParameterName, secondValue = criticalValues[k] )) # finding upper and lower RCI limits through root function repeatedConfidenceIntervals[g, 1, k] <- .getRootThetaSurvivalEnrichment( design = design, dataInput = dataInput, treatmentArm = g, stage = k, directionUpper = TRUE, thetaLow = thetaLow, thetaUp = thetaUp, stratifiedAnalysis = stratifiedAnalysis, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance ) repeatedConfidenceIntervals[g, 2, k] <- .getRootThetaSurvivalEnrichment( design = design, dataInput = dataInput, treatmentArm = g, stage = k, directionUpper = FALSE, thetaLow = thetaLow, thetaUp = thetaUp, stratifiedAnalysis = stratifiedAnalysis, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance ) # adjustment for binding futility bounds if (k > 1 && conditionFunction(bounds[k - 1], border) & design$bindingFutility) { parameterName <- ifelse(.isTrialDesignFisher(design), "singleStepAdjustedPValues", firstParameterName ) # Calculate new lower and upper bounds if (directionUpper) { thetaLow <- tolerance } else { thetaUp <- .getUpperLowerThetaSurvivalEnrichment( design = design, dataInput = dataInput, theta = 1, treatmentArm = g, stage = k - 1, directionUpper = FALSE, conditionFunction = conditionFunction, stratifiedAnalysis = stratifiedAnalysis, intersectionTest = intersectionTest, firstParameterName = parameterName, secondValue = bounds[k - 1] ) } futilityCorr[k] <- .getRootThetaSurvivalEnrichment( design = design, dataInput = dataInput, treatmentArm = g, stage = k - 1, directionUpper = directionUpper, thetaLow = thetaLow, thetaUp = thetaUp, stratifiedAnalysis = stratifiedAnalysis, intersectionTest = intersectionTest, firstParameterName = parameterName, secondValue = bounds[k - 1], tolerance = tolerance ) if (directionUpper) { repeatedConfidenceIntervals[g, 1, k] <- min( min(futilityCorr[2:k]), repeatedConfidenceIntervals[g, 1, k] ) } else { repeatedConfidenceIntervals[g, 2, k] <- max( max(futilityCorr[2:k]), repeatedConfidenceIntervals[g, 2, k] ) } } if (!is.na(repeatedConfidenceIntervals[g, 1, k]) && !is.na(repeatedConfidenceIntervals[g, 2, k]) && repeatedConfidenceIntervals[g, 1, k] > repeatedConfidenceIntervals[g, 2, k]) { repeatedConfidenceIntervals[g, , k] <- rep(NA_real_, 2) } } } .logProgress("Repeated confidence intervals for stage %s calculated", startTime = startTime, k) } return(repeatedConfidenceIntervals) } # # RCIs based on inverse normal combination test # .getRepeatedConfidenceIntervalsSurvivalEnrichmentInverseNormal <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsSurvivalEnrichmentInverseNormal", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) return(.getRepeatedConfidenceIntervalsSurvivalEnrichmentAll( design = design, dataInput = dataInput, directionUpper = directionUpper, stratifiedAnalysis = stratifiedAnalysis, intersectionTest = intersectionTest, tolerance = tolerance, firstParameterName = "combInverseNormal", ... )) } # # RCIs based on Fisher's combination test # .getRepeatedConfidenceIntervalsSurvivalEnrichmentFisher <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsSurvivalEnrichmentFisher", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) return(.getRepeatedConfidenceIntervalsSurvivalEnrichmentAll( design = design, dataInput = dataInput, directionUpper = directionUpper, stratifiedAnalysis = stratifiedAnalysis, intersectionTest = intersectionTest, tolerance = tolerance, firstParameterName = "combFisher", ... )) } # # Calculation of lower and upper limits of repeated confidence intervals (RCIs) for Survival # .getRepeatedConfidenceIntervalsSurvivalEnrichment <- function(..., design) { if (.isTrialDesignInverseNormal(design)) { return(.getRepeatedConfidenceIntervalsSurvivalEnrichmentInverseNormal(design = design, ...)) } if (.isTrialDesignFisher(design)) { return(.getRepeatedConfidenceIntervalsSurvivalEnrichmentFisher(design = design, ...)) } .stopWithWrongDesignMessage(design) } # # Calculation of conditional power for Survival # .getConditionalPowerSurvivalEnrichment <- function(..., stageResults, stage = stageResults$stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaH1 = NA_real_, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { design <- stageResults$.design gMax <- stageResults$getGMax() kMax <- design$kMax results <- ConditionalPowerResultsEnrichmentSurvival( .design = design, .stageResults = stageResults, thetaH1 = thetaH1, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned ) if (any(is.na(nPlanned))) { return(results) } .assertIsValidStage(stage, kMax) if (stage == kMax) { .logDebug( "Conditional power will be calculated only for subsequent stages ", "(stage = ", stage, ", kMax = ", kMax, ")" ) return(results) } if (!.isValidNPlanned(nPlanned = nPlanned, kMax = kMax, stage = stage)) { return(results) } .assertIsValidNPlanned(nPlanned, kMax, stage) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) results$.setParameterType("nPlanned", C_PARAM_USER_DEFINED) results$.setParameterType( "allocationRatioPlanned", ifelse(allocationRatioPlanned == C_ALLOCATION_RATIO_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED) ) thetaH1 <- .assertIsValidThetaH1ForEnrichment(thetaH1, stageResults, stage, results = results) if (any(thetaH1 <= 0, na.rm = TRUE)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'thetaH1' (", thetaH1, ") must be > 0") } if ((length(thetaH1) != 1) && (length(thetaH1) != gMax)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sprintf(paste0( "length of 'thetaH1' (%s) must be ", "equal to 'gMax' (%s) or 1" ), .arrayToString(thetaH1), gMax) ) } if (.isTrialDesignInverseNormal(design)) { return(.getConditionalPowerSurvivalEnrichmentInverseNormal( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, ... )) } else if (.isTrialDesignFisher(design)) { return(.getConditionalPowerSurvivalEnrichmentFisher( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, iterations = iterations, seed = seed, ... )) } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of TrialDesignInverseNormal or TrialDesignFisher" ) } # # Calculation of conditional power based on inverse normal method # .getConditionalPowerSurvivalEnrichmentInverseNormal <- function(..., results, design, stageResults, stage, allocationRatioPlanned, nPlanned, thetaH1) { .assertIsTrialDesignInverseNormal(design) .warnInCaseOfUnknownArguments(functionName = ".getConditionalPowerSurvivalEnrichmentInverseNormal", ...) kMax <- design$kMax gMax <- stageResults$getGMax() weights <- .getWeightsInverseNormal(design) informationRates <- design$informationRates nPlanned <- c(rep(NA_real_, stage), nPlanned) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned .setValueAndParameterType(results, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT) if (length(thetaH1) == 1) { thetaH1 <- rep(thetaH1, gMax) results$.setParameterType("thetaH1", C_PARAM_GENERATED) } else { results$.setParameterType("thetaH1", C_PARAM_DEFAULT_VALUE) } if (stageResults$directionUpper) { standardizedEffect <- log(thetaH1 / stageResults$thetaH0) } else { standardizedEffect <- -log(thetaH1 / stageResults$thetaH0) } ctr <- .performClosedCombinationTest(stageResults = stageResults) criticalValues <- design$criticalValues for (g in 1:gMax) { if (!is.na(ctr$separatePValues[g, stage])) { # shifted decision region for use in getGroupSeqProbs # Inverse Normal Method shiftedDecisionRegionUpper <- criticalValues[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stage], na.rm = TRUE) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - standardizedEffect[g] * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) if (stage == kMax - 1) { shiftedFutilityBounds <- c() } else { shiftedFutilityBounds <- design$futilityBounds[(stage + 1):(kMax - 1)] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):(kMax - 1)]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stage], na.rm = TRUE) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - standardizedEffect[g] * cumsum(sqrt(nPlanned[(stage + 1):(kMax - 1)]) * weights[(stage + 1):(kMax - 1)]) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) } # scaled information for use in getGroupSeqProbs scaledInformation <- (informationRates[(stage + 1):kMax] - informationRates[stage]) / (1 - informationRates[stage]) decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, shiftedDecisionRegionUpper ), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = scaledInformation ) results$conditionalPower[g, (stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ]) } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned results$nPlanned <- nPlanned results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$thetaH1 <- thetaH1 return(results) } # # Calculation of conditional power based on Fisher's combination test # .getConditionalPowerSurvivalEnrichmentFisher <- function(..., results, design, stageResults, stage, allocationRatioPlanned, nPlanned, thetaH1, iterations, seed) { .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) .warnInCaseOfUnknownArguments(functionName = ".getConditionalPowerSurvivalEnrichmentFisher", ...) kMax <- design$kMax gMax <- stageResults$getGMax() criticalValues <- design$criticalValues weightsFisher <- .getWeightsFisher(design) results$iterations <- as.integer(iterations) results$.setParameterType("iterations", C_PARAM_USER_DEFINED) results$.setParameterType("seed", ifelse(is.na(seed), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) results$seed <- .setSeed(seed) results$simulated <- FALSE results$.setParameterType("simulated", C_PARAM_DEFAULT_VALUE) .setValueAndParameterType(results, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT) if (length(thetaH1) == 1) { thetaH1 <- rep(thetaH1, gMax) results$.setParameterType("thetaH1", C_PARAM_GENERATED) } else { results$.setParameterType("thetaH1", C_PARAM_DEFAULT_VALUE) } if (stageResults$directionUpper) { standardizedEffect <- log(thetaH1 / stageResults$thetaH0) } else { standardizedEffect <- -log(thetaH1 / stageResults$thetaH0) } nPlanned <- c(rep(NA_real_, stage), nPlanned) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned ctr <- .performClosedCombinationTest(stageResults = stageResults) for (g in 1:gMax) { if (!is.na(ctr$separatePValues[g, stage])) { if (gMax == 1) { pValues <- ctr$adjustedStageWisePValues[ctr$indices[, g] == 1, ][1:stage] } else { pValues <- ctr$adjustedStageWisePValues[ctr$indices[, g] == 1, ][which.max( ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stage] ), 1:stage] } if (stage < kMax - 1) { for (k in (stage + 1):kMax) { reject <- 0 for (i in 1:iterations) { reject <- reject + .getRejectValueConditionalPowerFisher( kMax = kMax, alpha0Vec = design$alpha0Vec, criticalValues = criticalValues, weightsFisher = weightsFisher, pValues = pValues, currentKMax = k, thetaH1 = standardizedEffect[g], stage = stage, nPlanned = nPlanned ) } results$conditionalPower[g, k] <- reject / iterations } results$simulated <- TRUE results$.setParameterType("simulated", C_PARAM_GENERATED) } else if (stage == kMax - 1) { divisor <- prod(pValues[1:(kMax - 1)]^weightsFisher[1:(kMax - 1)]) result <- 1 - (criticalValues[kMax] / divisor)^(1 / weightsFisher[kMax]) if (result <= 0 || result >= 1) { warning("Calculation not possible: could not calculate conditional power for stage ", kMax, call. = FALSE) results$conditionalPower[g, kMax] <- NA_real_ } else { results$conditionalPower[g, kMax] <- 1 - stats::pnorm(.getQNorm(result) - standardizedEffect[g] * sqrt(nPlanned[kMax])) } } } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned results$nPlanned <- nPlanned results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$thetaH1 <- thetaH1 return(results) } # # Calculation of conditional power and likelihood values for plotting the graph # .getConditionalPowerLikelihoodSurvivalEnrichment <- function(..., stageResults, stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaRange, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) .associatedArgumentsAreDefined(nPlanned = nPlanned, thetaRange = thetaRange) design <- stageResults$.design kMax <- design$kMax gMax <- stageResults$getGMax() intersectionTest <- stageResults$intersectionTest thetaRange <- .assertIsValidThetaH1ForEnrichment(thetaH1 = thetaRange) if (length(thetaRange) == 1) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'thetaRange' (", .arrayToString(thetaRange), ") must be at least 2" ) } populations <- numeric(gMax * length(thetaRange)) effectValues <- numeric(gMax * length(thetaRange)) condPowerValues <- numeric(gMax * length(thetaRange)) likelihoodValues <- numeric(gMax * length(thetaRange)) stdErr <- 2 / sqrt(stageResults$.overallEvents[, stage]) results <- ConditionalPowerResultsEnrichmentSurvival( .design = design, .stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned ) j <- 1 for (i in seq(along = thetaRange)) { for (g in (1:gMax)) { populations[j] <- g effectValues[j] <- thetaRange[i] if (.isTrialDesignInverseNormal(design)) { condPowerValues[j] <- .getConditionalPowerSurvivalEnrichmentInverseNormal( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i], ... )$conditionalPower[g, kMax] } else if (.isTrialDesignFisher(design)) { condPowerValues[j] <- .getConditionalPowerSurvivalEnrichmentFisher( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i], iterations = iterations, seed = seed, ... )$conditionalPower[g, kMax] } likelihoodValues[j] <- stats::dnorm( log(thetaRange[i]), log(stageResults$effectSizes[g, stage]), stdErr[g] ) / stats::dnorm(0, 0, stdErr[g]) j <- j + 1 } } subtitle <- paste0( "Intersection test = ", intersectionTest, ", Stage = ", stage, ", # of remaining events = ", sum(nPlanned), ", allocation ratio = ", .formatSubTitleValue(allocationRatioPlanned, "allocationRatioPlanned") ) return(list( populations = populations, xValues = effectValues, condPowerValues = condPowerValues, likelihoodValues = likelihoodValues, main = C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, xlab = "Hazard ratio", ylab = C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, sub = subtitle )) } rpact/R/class_event_probabilities.R0000644000175000017500000003550714145656364017307 0ustar nileshnilesh## | ## | *Event probabilities classes* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' #' @name EventProbabilities #' #' @title #' Event Probabilities #' #' @description #' Class for the definition of event probabilities. #' #' @details #' \code{EventProbabilities} is a class for the definition of event probabilities. #' #' @importFrom methods new #' #' @include f_core_constants.R #' @include class_core_parameter_set.R #' @include class_time.R #' #' @keywords internal #' EventProbabilities <- setRefClass("EventProbabilities", contains = "ParameterSet", fields = list( .piecewiseSurvivalTime = "PiecewiseSurvivalTime", .accrualTime = "AccrualTime", .plotSettings = "PlotSettings", time = "numeric", accrualTime = "numeric", accrualIntensity = "numeric", kappa = "numeric", piecewiseSurvivalTime = "numeric", lambda1 = "numeric", lambda2 = "numeric", allocationRatioPlanned = "numeric", hazardRatio = "numeric", dropoutRate1 = "numeric", dropoutRate2 = "numeric", dropoutTime = "numeric", maxNumberOfSubjects = "numeric", overallEventProbabilities = "numeric", eventProbabilities1 = "numeric", eventProbabilities2 = "numeric" ), methods = list( initialize = function(...) { callSuper(...) .plotSettings <<- PlotSettings() .parameterNames <<- C_PARAMETER_NAMES .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS }, getPlotSettings = function() { return(.plotSettings) }, show = function(showType = 1, digits = NA_integer_) { .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { 'Method for automatically printing event probabilities objects' .resetCat() if (showType == 2) { callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { .cat("Event probabilities at given time:\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getGeneratedParameters(), "Time and output", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) .cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) .cat("\n", consoleOutputEnabled = consoleOutputEnabled) } } ) ) #' #' @name NumberOfSubjects #' #' @title #' Number Of Subjects #' #' @description #' Class for the definition of number of subjects results. #' #' @details #' \code{NumberOfSubjects} is a class for the definition of number of subjects results. #' #' @importFrom methods new #' #' @include f_core_constants.R #' @include class_core_parameter_set.R #' @include class_time.R #' #' @keywords internal #' NumberOfSubjects <- setRefClass("NumberOfSubjects", contains = "ParameterSet", fields = list( .accrualTime = "AccrualTime", .plotSettings = "PlotSettings", time = "numeric", accrualTime = "numeric", accrualIntensity = "numeric", maxNumberOfSubjects = "numeric", numberOfSubjects = "numeric" ), methods = list( initialize = function(...) { callSuper(...) .plotSettings <<- PlotSettings() .parameterNames <<- C_PARAMETER_NAMES .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS }, getPlotSettings = function() { return(.plotSettings) }, show = function(showType = 1, digits = NA_integer_) { .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { 'Method for automatically printing number of subjects objects' .resetCat() if (showType == 2) { callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { .cat("Number of recruited subjects at given time:\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getGeneratedParameters(), "Time and output", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) .cat("\n", consoleOutputEnabled = consoleOutputEnabled) } } ) ) #' #' @title #' Event Probabilities Plotting #' #' @description #' Plots an object that inherits from class \code{\link{EventProbabilities}}. #' #' @details #' Generic function to plot an event probabilities object. #' #' @param x The object that inherits from \code{\link{EventProbabilities}}. #' @param y An optional object that inherits from \code{\link{NumberOfSubjects}}. #' @inheritParams param_allocationRatioPlanned #' @param main The main title. #' @param xlab The x-axis label. #' @param ylab The y-axis label. #' @param type The plot type (default = 1). Note that at the moment only one type is available. #' @param legendTitle The legend title, default is \code{""}. #' @inheritParams param_palette #' @inheritParams param_plotPointsEnabled #' @inheritParams param_showSource #' @inheritParams param_plotSettings #' @inheritParams param_legendPosition #' @inheritParams param_three_dots_plot #' #' @details #' Generic function to plot a parameter set. #' #' @template return_object_ggplot #' #' @export #' plot.EventProbabilities <- function(x, y, ..., allocationRatioPlanned = x$allocationRatioPlanned, main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, legendTitle = NA_character_, palette = "Set1", plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, plotSettings = NULL) { fCall = match.call(expand.dots = FALSE) xObjectName <- deparse(fCall$x) yObjectName <- NA_character_ .assertGgplotIsInstalled() .assertIsValidLegendPosition(legendPosition) .assertIsValidAllocationRatioPlanned(allocationRatioPlanned, 2L) #.assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) numberOfSubjectsObject <- NULL if (!missing(y) && inherits(y, "NumberOfSubjects")) { numberOfSubjectsObject <- y yObjectName <- deparse(fCall$y) } maxNumberOfSubjects <- 1 maxNumberOfSubjects1 <- 1 maxNumberOfSubjects2 <- 1 maxNumberOfSubjectsToUse <- NA_integer_ if (!is.null(numberOfSubjectsObject)) { maxNumberOfSubjectsToUse <- numberOfSubjectsObject$maxNumberOfSubjects } if (is.na(maxNumberOfSubjectsToUse)) { maxNumberOfSubjectsToUse <- x$maxNumberOfSubjects } else if (!is.na(x$maxNumberOfSubjects) && x$maxNumberOfSubjects != maxNumberOfSubjectsToUse) { stop("'x' (EventProbabilities) and 'y' (NumberOfSubjects) must have the same 'maxNumberOfSubjects' defined") } if (!is.na(maxNumberOfSubjectsToUse)) { maxNumberOfSubjects <- maxNumberOfSubjectsToUse maxNumberOfSubjects1 <- .getNumberOfSubjects1(maxNumberOfSubjects, allocationRatioPlanned) maxNumberOfSubjects2 <- .getNumberOfSubjects2(maxNumberOfSubjects, allocationRatioPlanned) } if (is.na(maxNumberOfSubjectsToUse)) { mainDefault <- "Event Probabilities" } else { mainDefault <- ifelse(!is.null(numberOfSubjectsObject), "Number of subjects and expected number of events", "Expected number of events") } main <- ifelse(is.na(main), mainDefault, main) if (!is.null(numberOfSubjectsObject)) { ylabDefault <- "Number of subjects/events" } else { ylabDefault <- ifelse(is.na(maxNumberOfSubjectsToUse), "Event probabilities", "Expected number of events") } ylab <- ifelse(is.na(ylab), ylabDefault, ylab) data <- data.frame( xValues = c(x$time, x$time, x$time), yValues = c( x$overallEventProbabilities * maxNumberOfSubjects, # overall x$eventProbabilities1 * maxNumberOfSubjects1, # treatment x$eventProbabilities2 * maxNumberOfSubjects2 # control ), categories = c( rep("Overall", length(x$time)), rep("Treatment", length(x$time)), rep("Control", length(x$time)) ) ) data$categories <- factor(data$categories, levels = c("Overall", "Treatment", "Control")) if (!is.null(numberOfSubjectsObject)) { data <- rbind(data, data.frame( xValues = numberOfSubjectsObject$time, yValues = numberOfSubjectsObject$numberOfSubjects, categories = "Number of subjects" ) ) } if (is.na(legendPosition)) { legendPosition <- C_POSITION_LEFT_TOP } if (is.na(legendTitle)) { legendTitle <- "" } srcCmd <- .showPlotSourceInformation(objectName = xObjectName, xParameterName = "time", yParameterNames = c("overallEventProbabilities", "eventProbabilities1", "eventProbabilities2"), type = type, showSource = showSource) if (!is.na(yObjectName)) { srcCmd2 <- .showPlotSourceInformation(objectName = yObjectName, xParameterName = "time", yParameterNames = "numberOfSubjects", type = type, showSource = showSource) if (is.list(srcCmd)) { if (!is.null(srcCmd2[["y"]])) { if (identical(x[["time"]], y[["time"]])) { srcCmd$y <- c(srcCmd$y, srcCmd2$y) } else { srcCmd$x2 <- srcCmd2[["x"]] srcCmd$y2 <- srcCmd2$y } } } else { srcCmd <- c(srcCmd, srcCmd2) } } if (!is.null(srcCmd)) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(srcCmd)) } return(srcCmd) } if (is.null(plotSettings)) { plotSettings <- x$.plotSettings } return(.plotDataFrame(data, mainTitle = main, xlab = xlab, ylab = ylab, xAxisLabel = "Time", yAxisLabel1 = NA_character_, yAxisLabel2 = NA_character_, palette = palette, plotPointsEnabled = plotPointsEnabled, legendTitle = legendTitle, legendPosition = legendPosition, scalingFactor1 = 1, scalingFactor2 = 1, addPowerAndAverageSampleNumber = FALSE, mirrorModeEnabled = FALSE, ratioEnabled = FALSE, plotSettings = plotSettings, sided = 1, ...)) } #' #' @title #' Number Of Subjects Plotting #' #' @description #' Plots an object that inherits from class \code{\link{NumberOfSubjects}}. #' #' @details #' Generic function to plot an "number of subjects" object. #' #' @param x The object that inherits from \code{\link{NumberOfSubjects}}. #' @param y An optional object that inherits from \code{\link{EventProbabilities}}. #' @param allocationRatioPlanned The planned allocation ratio \code{n1 / n2} for a two treatment groups #' design, default is \code{1}. Will be ignored if \code{y} is undefined. #' @param main The main title. #' @param xlab The x-axis label. #' @param ylab The y-axis label. #' @param type The plot type (default = 1). Note that at the moment only one type is available. #' @param legendTitle The legend title, default is \code{""}. #' @inheritParams param_palette #' @inheritParams param_plotPointsEnabled #' @inheritParams param_showSource #' @inheritParams param_plotSettings #' @inheritParams param_legendPosition #' @inheritParams param_three_dots_plot #' #' @details #' Generic function to plot a parameter set. #' #' @template return_object_ggplot #' #' @export #' plot.NumberOfSubjects <- function(x, y, ..., allocationRatioPlanned = NA_real_, main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, legendTitle = NA_character_, palette = "Set1", plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, plotSettings = NULL) { fCall = match.call(expand.dots = FALSE) objectName <- deparse(fCall$x) #.assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) if (!missing(y) && inherits(y, "EventProbabilities")) { return(plot.EventProbabilities(x = y, y = x, allocationRatioPlanned = ifelse(is.na(allocationRatioPlanned), y$allocationRatioPlanned, allocationRatioPlanned), main = main, xlab = xlab, ylab = ylab, type = type, legendTitle = legendTitle, palette = palette, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, showSource = showSource, plotSettings = plotSettings, ...)) } if (!is.na(allocationRatioPlanned)) { warning("'allocationRatioPlanned' (", allocationRatioPlanned, ") will be ignored because 'y' is undefined (for more information see ?plot.NumberOfSubjects)", call. = FALSE) } .assertGgplotIsInstalled() .assertIsValidLegendPosition(legendPosition) main <- ifelse(is.na(main), "Number of Subjects", main) ylab <- ifelse(is.na(ylab), "Number of subjects", ylab) data <- data.frame( xValues = x$time, yValues = x$numberOfSubjects, categories = "Number of subjects" ) if (is.na(legendPosition)) { legendPosition <- -1 } if (is.na(legendTitle)) { legendTitle <- "" } srcCmd <- .showPlotSourceInformation(objectName = objectName, xParameterName = "time", yParameterNames = "numberOfSubjects", type = type, showSource = showSource) if (!is.null(srcCmd)) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(srcCmd)) } return(srcCmd) } if (is.null(plotSettings)) { plotSettings <- x$.plotSettings } return(.plotDataFrame(data, mainTitle = main, xlab = xlab, ylab = ylab, xAxisLabel = "Time", yAxisLabel1 = NA_character_, yAxisLabel2 = NA_character_, palette = palette, plotPointsEnabled = plotPointsEnabled, legendTitle = legendTitle, legendPosition = legendPosition, scalingFactor1 = 1, scalingFactor2 = 1, addPowerAndAverageSampleNumber = FALSE, mirrorModeEnabled = FALSE, ratioEnabled = FALSE, plotSettings = plotSettings, sided = 1, ...)) }rpact/R/f_analysis_enrichment_rates.R0000644000175000017500000015465414165522434017630 0ustar nileshnilesh## | ## | *Analysis of rates in enrichment designs with adaptive test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5684 $ ## | Last changed: $Date: 2022-01-05 12:27:24 +0100 (Mi, 05 Jan 2022) $ ## | Last changed by: $Author: wassmer $ ## | .calcRatesTestStatistics <- function(dataInput, subset, stage, thetaH0, stratifiedAnalysis, normalApproximation, directionUpper) { n <- rep(NA_real_, 2) on <- rep(NA_real_, 2) e <- rep(NA_real_, 2) oe <- rep(NA_real_, 2) testStatistics <- NA_real_ separatePValues <- NA_real_ if (!all(is.na(dataInput$getSampleSizes(stage = stage, subset = subset)))) { for (i in 1:2) { # calculation of sample size and events for overall data on[i] <- sum(dataInput$getOverallSampleSizes(stage = stage, subset = subset, group = i), na.rm = TRUE) oe[i] <- sum(dataInput$getOverallEvents(stage = stage, subset = subset, group = i), na.rm = TRUE) } if (stratifiedAnalysis) { actEv <- dataInput$getEvents(stage = stage, subset = subset, group = 1) ctrEv <- dataInput$getEvents(stage = stage, subset = subset, group = 2) actN <- dataInput$getSampleSize(stage = stage, subset = subset, group = 1) ctrN <- dataInput$getSampleSize(stage = stage, subset = subset, group = 2) weights <- actN * ctrN / (actN + ctrN) if (thetaH0 == 0) { if (sum(actEv + ctrEv, na.rm = TRUE) == 0 || sum(actEv + ctrEv, na.rm = TRUE) == sum(actN + ctrN, na.rm = TRUE)) { testStatistics <- 0 } else { rateH0 <- (actEv + ctrEv) / (actN + ctrN) testStatistics <- sum((actEv / actN - ctrEv / ctrN - thetaH0) * weights, na.rm = TRUE) / sqrt(sum(rateH0 * (1 - rateH0) * weights, na.rm = TRUE)) } } else { actMl <- rep(NA_real_, length(subset)) ctrMl <- rep(NA_real_, length(subset)) for (g in (1:length(subset))) { y <- .getFarringtonManningValues( rate1 = actEv[g] / actN[g], rate2 = ctrEv[g] / ctrN[g], theta = thetaH0, allocation = actN[g] / ctrN[g], method = "diff" ) actMl[g] <- y$ml1 ctrMl[g] <- y$ml2 } testStatistics <- sum((actEv / actN - ctrEv / ctrN - thetaH0) * weights, na.rm = TRUE) / sqrt(sum((actMl * (1 - actMl) / actN + ctrMl * (1 - ctrMl) / ctrN) * weights^2, na.rm = TRUE)) } if (directionUpper) { separatePValues <- 1 - stats::pnorm(testStatistics) } else { separatePValues <- stats::pnorm(testStatistics) } } # non-stratified analysis else { for (i in 1:2) { n[i] <- sum(dataInput$getSampleSizes(stage = stage, subset = subset, group = i), na.rm = TRUE) e[i] <- sum(dataInput$getEvents(stage = stage, subset = subset, group = i), na.rm = TRUE) } if (normalApproximation) { if (thetaH0 == 0) { if (!is.na(e[1])) { if ((e[1] + e[2] == 0) || (e[1] + e[2] == n[1] + n[2])) { testStatistics <- 0 } else { rateH0 <- (e[1] + e[2]) / (n[1] + n[2]) testStatistics <- (e[1] / n[1] - e[2] / n[2] - thetaH0) / sqrt(rateH0 * (1 - rateH0) * (1 / n[1] + 1 / n[2])) } } else { testStatistics <- NA_real_ } } else { y <- .getFarringtonManningValues( rate1 = e[1] / n[1], rate2 = e[2] / n[2], theta = thetaH0, allocation = n[1] / n[2], method = "diff" ) testStatistics <- (e[1] / n[1] - e[2] / n[2] - thetaH0) / sqrt(y$ml1 * (1 - y$ml1) / n[1] + y$ml2 * (1 - y$ml2) / n[2]) } if (directionUpper) { separatePValues <- 1 - stats::pnorm(testStatistics) } else { separatePValues <- stats::pnorm(testStatistics) } } else { if (thetaH0 != 0) { stop( C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "'thetaH0' (", thetaH0, ") must be 0 to perform Fisher's exact test" ) } if (directionUpper) { separatePValues <- stats::phyper(e[1] - 1, e[1] + e[2], n[1] + n[2] - e[1] - e[2], n[1], lower.tail = FALSE ) } else { separatePValues <- stats::phyper(e[1], e[1] + e[2], n[1] + n[2] - e[1] - e[2], n[1], lower.tail = TRUE ) } if (directionUpper) { testStatistics <- .getOneMinusQNorm(separatePValues) } else { testStatistics <- -.getOneMinusQNorm(separatePValues) } } } } if ("R" %in% subset && is.na(dataInput$getSampleSizes(stage = stage, subset = "R", group = 1)) || ("S1" %in% subset) && is.na(dataInput$getSampleSizes(stage = stage, subset = "S1", group = 1)) || ("S2" %in% subset) && is.na(dataInput$getSampleSizes(stage = stage, subset = "S2", group = 1)) || ("S3" %in% subset) && is.na(dataInput$getSampleSizes(stage = stage, subset = "S3", group = 1)) || ("S4" %in% subset) && is.na(dataInput$getSampleSizes(stage = stage, subset = "S4", group = 1)) ) { n <- rep(NA_real_, 2) e <- rep(NA_real_, 2) on <- rep(NA_real_, 2) oe <- rep(NA_real_, 2) separatePValues <- NA_real_ testStatistics <- NA_real_ } return(list( populationNs = n, populationEvents = e, overallRates1 = oe[1] / on[1], overallSampleSizes1 = on[1], overallRates2 = oe[2] / on[2], overallSampleSizes2 = on[2], separatePValues = separatePValues, testStatistics = testStatistics )) } .getStageResultsRatesEnrichment <- function(..., design, dataInput, thetaH0 = C_THETA_H0_RATES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, calculateSingleStepAdjusted = FALSE, userFunctionCallEnabled = FALSE) { .assertIsTrialDesign(design) .assertIsDatasetRates(dataInput) .assertIsValidThetaH0DataInput(thetaH0, dataInput) .assertIsValidDirectionUpper(directionUpper, design$sided) .assertIsSingleLogical(normalApproximation, "normalApproximation") .assertIsValidIntersectionTestEnrichment(design, intersectionTest) .warnInCaseOfUnknownArguments( functionName = ".getStageResultsRatesEnrichment", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) kMax <- design$kMax if (dataInput$isStratified()) { gMax <- log(length(levels(factor(dataInput$subsets))), 2) + 1 } else { gMax <- length(levels(factor(dataInput$subsets))) } .assertIsValidIntersectionTestEnrichment(design, intersectionTest) if ((gMax > 2) && intersectionTest == "SpiessensDebois") { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "gMax (", gMax, ") > 2: Spiessens & Debois intersection test test can only be used for one subset" ) } if (intersectionTest == "SpiessensDebois" && !normalApproximation) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "Spiessens & Debois test cannot be used with Fisher's ", "exact test (normalApproximation = FALSE)", call. = FALSE ) } if ((stratifiedAnalysis) && (!normalApproximation)) { stop( C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "Stratified version is not available for Fisher's exact test" ) } if (stratifiedAnalysis && !dataInput$isStratified()) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "Stratified analysis is only possible for stratified data input" ) } if (dataInput$isStratified() && (gMax > 4)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "gMax (", gMax, ") > 4: Stratified analysis not implemented" ) } stageResults <- StageResultsEnrichmentRates( design = design, dataInput = dataInput, thetaH0 = thetaH0, direction = ifelse(directionUpper, C_DIRECTION_UPPER, C_DIRECTION_LOWER), normalApproximation = normalApproximation, directionUpper = directionUpper, stratifiedAnalysis = stratifiedAnalysis, stage = stage ) .setValueAndParameterType(stageResults, "stratifiedAnalysis", stratifiedAnalysis, C_STRATIFIED_ANALYSIS_DEFAULT) .setValueAndParameterType(stageResults, "intersectionTest", intersectionTest, C_INTERSECTION_TEST_ENRICHMENT_DEFAULT) overallSampleSizes1 <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallSampleSizes2 <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallRates1 <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallRates2 <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallEvents <- rep(NA_real_, kMax) testStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallTestStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) separatePValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) dimnames(testStatistics) <- list(paste("population ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "")) dimnames(separatePValues) <- list(paste("population ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "")) subsets <- .createSubsetsByGMax(gMax = gMax, stratifiedInput = dataInput$isStratified(), subsetIdPrefix = "S") for (k in 1:stage) { for (population in (1:gMax)) { subset <- subsets[[population]] results <- .calcRatesTestStatistics( dataInput, subset, k, thetaH0, stratifiedAnalysis, normalApproximation, directionUpper ) testStatistics[population, k] <- results$testStatistics separatePValues[population, k] <- results$separatePValues overallSampleSizes1[population, k] <- results$overallSampleSizes1 overallSampleSizes2[population, k] <- results$overallSampleSizes2 overallRates1[population, k] <- results$overallRates1 overallRates2[population, k] <- results$overallRates2 } } stageResults$overallTestStatistics <- overallTestStatistics stageResults$overallPisTreatment <- overallRates1 stageResults$overallPisControl <- overallRates2 stageResults$.overallSampleSizes1 <- overallSampleSizes1 stageResults$.overallSampleSizes2 <- overallSampleSizes2 stageResults$testStatistics <- testStatistics stageResults$separatePValues <- separatePValues stageResults$effectSizes <- overallRates1 - overallRates2 stageResults$.setParameterType("effectSizes", C_PARAM_GENERATED) .setWeightsToStageResults(design, stageResults) if (!calculateSingleStepAdjusted) { return(stageResults) } # Calculation of single stage adjusted p-Values and overall test statistics # for determination of RCIs singleStepAdjustedPValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) combInverseNormal <- matrix(NA_real_, nrow = gMax, ncol = kMax) combFisher <- matrix(NA_real_, nrow = gMax, ncol = kMax) if (.isTrialDesignInverseNormal(design)) { weightsInverseNormal <- stageResults$weightsInverseNormal } else if (.isTrialDesignFisher(design)) { weightsFisher <- stageResults$weightsFisher } for (k in 1:stage) { selected <- sum(!is.na(separatePValues[, k])) for (population in 1:gMax) { if ((intersectionTest == "Bonferroni") || (intersectionTest == "Simes")) { singleStepAdjustedPValues[population, k] <- min(1, separatePValues[population, k] * selected) } else if (intersectionTest == "Sidak") { singleStepAdjustedPValues[population, k] <- 1 - (1 - separatePValues[population, k])^selected } else if (intersectionTest == "SpiessensDebois") { if (!is.na(testStatistics[population, k])) { df <- NA_real_ sigma <- 1 if (selected == 2) { if (dataInput$isStratified()) { sigma <- matrix(rep(sqrt(sum(dataInput$getSampleSizes(stage = k, subset = "S1")) / sum(dataInput$getSampleSizes(stage = k))), 4), nrow = 2) } else { sigma <- matrix(rep(sqrt(sum(dataInput$getSampleSizes(stage = k, subset = "S1")) / sum(dataInput$getSampleSizes(stage = k, subset = "F"))), 4), nrow = 2) } diag(sigma) <- 1 } singleStepAdjustedPValues[population, k] <- 1 - .getMultivariateDistribution( type = "normal", upper = ifelse(directionUpper, testStatistics[population, k], -testStatistics[population, k]), sigma = sigma, df = NA ) } } if (.isTrialDesignInverseNormal(design)) { combInverseNormal[population, k] <- (weightsInverseNormal[1:k] %*% .getOneMinusQNorm(singleStepAdjustedPValues[population, 1:k])) / sqrt(sum(weightsInverseNormal[1:k]^2)) } else if (.isTrialDesignFisher(design)) { combFisher[population, k] <- prod(singleStepAdjustedPValues[population, 1:k]^weightsFisher[1:k]) } } } stageResults$singleStepAdjustedPValues <- singleStepAdjustedPValues stageResults$.setParameterType("singleStepAdjustedPValues", C_PARAM_GENERATED) if (.isTrialDesignFisher(design)) { stageResults$combFisher <- combFisher stageResults$.setParameterType("combFisher", C_PARAM_GENERATED) } else if (.isTrialDesignInverseNormal(design)) { stageResults$combInverseNormal <- combInverseNormal stageResults$.setParameterType("combInverseNormal", C_PARAM_GENERATED) } return(stageResults) } .getAnalysisResultsRatesEnrichment <- function(..., design, dataInput) { if (.isTrialDesignInverseNormal(design)) { return(.getAnalysisResultsRatesInverseNormalEnrichment(design = design, dataInput = dataInput, ...)) } if (.isTrialDesignFisher(design)) { return(.getAnalysisResultsRatesFisherEnrichment(design = design, dataInput = dataInput, ...)) } .stopWithWrongDesignMessage(design) } .getAnalysisResultsRatesInverseNormalEnrichment <- function(..., design, dataInput, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, thetaH0 = C_THETA_H0_RATES_DEFAULT, piTreatments = NA_real_, piControls = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .assertIsTrialDesignInverseNormal(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsRatesInverseNormalEnrichment", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsEnrichmentInverseNormal(design = design, dataInput = dataInput) results <- .getAnalysisResultsRatesEnrichmentAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, thetaH0 = thetaH0, piTreatments = piTreatments, piControls = piControls, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance ) return(results) } .getAnalysisResultsRatesFisherEnrichment <- function(..., design, dataInput, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, thetaH0 = C_THETA_H0_RATES_DEFAULT, piTreatments = NA_real_, piControls = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsRatesFisherEnrichment", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsEnrichmentFisher(design = design, dataInput = dataInput) results <- .getAnalysisResultsRatesEnrichmentAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, thetaH0 = thetaH0, piTreatments = piTreatments, piControls = piControls, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance, iterations = iterations, seed = seed ) return(results) } .getAnalysisResultsRatesEnrichmentAll <- function(..., results, design, dataInput, intersectionTest, stage, directionUpper, normalApproximation, stratifiedAnalysis, thetaH0, piTreatments, piControls, nPlanned, allocationRatioPlanned, tolerance, iterations, seed) { startTime <- Sys.time() stageResults <- .getStageResultsRatesEnrichment( design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis ) results$.setStageResults(stageResults) .logProgress("Stage results calculated", startTime = startTime) gMax <- stageResults$getGMax() piControls <- .assertIsValidPiControlForEnrichment(piControls, stageResults, stage, results = results) piTreatments <- .assertIsValidPiTreatmentsForEnrichment(piTreatments, stageResults, stage, results = results) .setValueAndParameterType(results, "intersectionTest", intersectionTest, C_INTERSECTION_TEST_ENRICHMENT_DEFAULT) .setValueAndParameterType(results, "directionUpper", directionUpper, C_DIRECTION_UPPER_DEFAULT) .setValueAndParameterType(results, "normalApproximation", normalApproximation, C_NORMAL_APPROXIMATION_RATES_DEFAULT) .setValueAndParameterType(results, "stratifiedAnalysis", stratifiedAnalysis, C_STRATIFIED_ANALYSIS_DEFAULT) .setValueAndParameterType(results, "thetaH0", thetaH0, C_THETA_H0_RATES_DEFAULT) .setConditionalPowerArguments(results, dataInput, nPlanned, allocationRatioPlanned) .setNPlannedAndPi(results, nPlanned, "piControls", piControls, piTreatments) if (results$.getParameterType("piControls") %in% c(C_PARAM_TYPE_UNKNOWN, C_PARAM_NOT_APPLICABLE)) { .setValueAndParameterType( results, "piControls", matrix(piControls, ncol = 1), matrix(rep(NA_real_, gMax), ncol = 1) ) } else { results$piControls <- matrix(piControls, ncol = 1) } if (results$.getParameterType("piTreatments") %in% c(C_PARAM_TYPE_UNKNOWN, C_PARAM_NOT_APPLICABLE)) { .setValueAndParameterType( results, "piTreatments", matrix(piTreatments, ncol = 1), matrix(rep(NA_real_, gMax), ncol = 1) ) } else { if (is.matrix(piTreatments)) { results$piTreatments <- piTreatments } else { results$piTreatments <- matrix(piTreatments, ncol = 1) } } startTime <- Sys.time() results$.closedTestResults <- getClosedCombinationTestResults(stageResults = stageResults) .logProgress("Closed test calculated", startTime = startTime) if (design$kMax > 1) { # conditional power startTime <- Sys.time() if (.isTrialDesignFisher(design)) { conditionalPowerResults <- .getConditionalPowerRatesEnrichment( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, piTreatments = piTreatments, piControls = piControls, iterations = iterations, seed = seed ) if (conditionalPowerResults$simulated) { results$conditionalPowerSimulated <- conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalPowerSimulated", C_PARAM_GENERATED) } else { results$conditionalPower <- conditionalPowerResults$conditionalPower results$conditionalPowerSimulated <- matrix(numeric(0)) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$.setParameterType("conditionalPowerSimulated", C_PARAM_NOT_APPLICABLE) } } else { conditionalPowerResults <- .getConditionalPowerRatesEnrichment( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, piTreatments = piTreatments, piControls = piControls ) results$conditionalPower <- conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_GENERATED) } results$.conditionalPowerResults <- conditionalPowerResults .logProgress("Conditional power calculated", startTime = startTime) # CRP - conditional rejection probabilities startTime <- Sys.time() results$conditionalRejectionProbabilities <- .getConditionalRejectionProbabilitiesEnrichment( stageResults = stageResults, stage = stage ) results$.setParameterType("conditionalRejectionProbabilities", C_PARAM_GENERATED) .logProgress("Conditional rejection probabilities (CRP) calculated", startTime = startTime) } else { results$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalPowerSimulated", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalRejectionProbabilities", C_PARAM_NOT_APPLICABLE) } # RCI - repeated confidence interval repeatedConfidenceIntervals <- .getRepeatedConfidenceIntervalsRatesEnrichment( design = design, dataInput = dataInput, stratifiedAnalysis = stratifiedAnalysis, intersectionTest = intersectionTest, stage = stage, normalApproximation = normalApproximation, tolerance = tolerance ) results$repeatedConfidenceIntervalLowerBounds <- matrix(rep(NA_real_, gMax * design$kMax), nrow = gMax, ncol = design$kMax) results$repeatedConfidenceIntervalUpperBounds <- results$repeatedConfidenceIntervalLowerBounds for (k in 1:design$kMax) { for (population in 1:gMax) { results$repeatedConfidenceIntervalLowerBounds[population, k] <- repeatedConfidenceIntervals[population, 1, k] results$repeatedConfidenceIntervalUpperBounds[population, k] <- repeatedConfidenceIntervals[population, 2, k] } } results$.setParameterType("repeatedConfidenceIntervalLowerBounds", C_PARAM_GENERATED) results$.setParameterType("repeatedConfidenceIntervalUpperBounds", C_PARAM_GENERATED) # repeated p-value results$repeatedPValues <- .getRepeatedPValuesEnrichment(stageResults = stageResults, tolerance = tolerance) results$.setParameterType("repeatedPValues", C_PARAM_GENERATED) return(results) } .getRootThetaRatesEnrichment <- function(..., design, dataInput, population, stage, directionUpper, normalApproximation, stratifiedAnalysis, intersectionTest, thetaLow, thetaUp, firstParameterName, secondValue, tolerance) { result <- .getOneDimensionalRoot( function(theta) { stageResults <- .getStageResultsRatesEnrichment( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, intersectionTest = intersectionTest, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, calculateSingleStepAdjusted = TRUE ) firstValue <- stageResults[[firstParameterName]][population, stage] if (.isTrialDesignGroupSequential(design)) { firstValue <- .getOneMinusQNorm(firstValue) } return(firstValue - secondValue) }, lower = thetaLow, upper = thetaUp, tolerance = tolerance, callingFunctionInformation = ".getRootThetaRatesEnrichment" ) return(result) } .getRepeatedConfidenceIntervalsRatesEnrichmentAll <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, firstParameterName) { .assertIsValidIntersectionTestEnrichment(design, intersectionTest) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) stageResults <- .getStageResultsRatesEnrichment( design = design, dataInput = dataInput, stage = stage, thetaH0 = 0, directionUpper = directionUpper, intersectionTest = intersectionTest, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, calculateSingleStepAdjusted = FALSE ) gMax <- stageResults$getGMax() repeatedConfidenceIntervals <- array(NA_real_, dim = c(gMax, 2, design$kMax)) # Repeated onfidence intervals when using combination tests if (.isTrialDesignFisher(design)) { bounds <- design$alpha0Vec border <- C_ALPHA_0_VEC_DEFAULT criticalValues <- design$criticalValues conditionFunction <- .isFirstValueSmallerThanSecondValue } else if (.isTrialDesignInverseNormal(design)) { bounds <- design$futilityBounds border <- C_FUTILITY_BOUNDS_DEFAULT criticalValues <- design$criticalValues criticalValues[is.infinite(criticalValues) & criticalValues > 0] <- C_QNORM_MAXIMUM criticalValues[is.infinite(criticalValues) & criticalValues < 0] <- C_QNORM_MINIMUM conditionFunction <- .isFirstValueGreaterThanSecondValue } # necessary for adjustment for binding futility boundaries futilityCorr <- rep(NA_real_, design$kMax) stages <- (1:stage) for (k in stages) { startTime <- Sys.time() for (g in 1:gMax) { if (!is.na(stageResults$testStatistics[g, k])) { thetaLow <- -1 + tolerance thetaUp <- 1 - tolerance # finding upper and lower RCI limits through root function repeatedConfidenceIntervals[g, 1, k] <- .getRootThetaRatesEnrichment( design = design, dataInput = dataInput, population = g, stage = k, directionUpper = TRUE, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, thetaLow = thetaLow, thetaUp = thetaUp, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance ) repeatedConfidenceIntervals[g, 2, k] <- .getRootThetaRatesEnrichment( design = design, dataInput = dataInput, population = g, stage = k, directionUpper = FALSE, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, thetaLow = thetaLow, thetaUp = thetaUp, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance ) # adjustment for binding futility bounds if (k > 1 && conditionFunction(bounds[k - 1], border) & design$bindingFutility) { parameterName <- ifelse(.isTrialDesignFisher(design), "singleStepAdjustedPValues", firstParameterName ) futilityCorr[k] <- .getRootThetaRatesEnrichment( design = design, dataInput = dataInput, population = g, stage = k - 1, directionUpper = directionUpper, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, thetaLow = thetaLow, thetaUp = thetaUp, intersectionTest = intersectionTest, firstParameterName = parameterName, secondValue = bounds[k - 1], tolerance = tolerance ) if (directionUpper) { repeatedConfidenceIntervals[g, 1, k] <- min( min(futilityCorr[2:k]), repeatedConfidenceIntervals[g, 1, k] ) } else { repeatedConfidenceIntervals[g, 2, k] <- max( max(futilityCorr[2:k]), repeatedConfidenceIntervals[g, 2, k] ) } } if (!is.na(repeatedConfidenceIntervals[g, 1, k]) && !is.na(repeatedConfidenceIntervals[g, 2, k]) && repeatedConfidenceIntervals[g, 1, k] > repeatedConfidenceIntervals[g, 2, k]) { repeatedConfidenceIntervals[g, , k] <- rep(NA_real_, 2) } } } .logProgress("Repeated confidence intervals for stage %s calculated", startTime = startTime, k) } return(repeatedConfidenceIntervals) } # # RCIs based on inverse normal combination test # .getRepeatedConfidenceIntervalsRatesEnrichmentInverseNormal <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { if (!normalApproximation) { message("Repeated confidence intervals will be calculated under the normal approximation") normalApproximation <- TRUE } .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsRatesEnrichmentInverseNormal", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) return(.getRepeatedConfidenceIntervalsRatesEnrichmentAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, directionUpper = directionUpper, intersectionTest = intersectionTest, tolerance = tolerance, firstParameterName = "combInverseNormal", ... )) } # # RCIs based on Fisher's combination test # .getRepeatedConfidenceIntervalsRatesEnrichmentFisher <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, stratifiedAnalysis = C_STRATIFIED_ANALYSIS_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, intersectionTest = C_INTERSECTION_TEST_ENRICHMENT_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { if (!normalApproximation) { message("Repeated confidence intervals will be calculated under the normal approximation") normalApproximation <- TRUE } .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsRatesEnrichmentFisher", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) return(.getRepeatedConfidenceIntervalsRatesEnrichmentAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, stratifiedAnalysis = stratifiedAnalysis, directionUpper = directionUpper, intersectionTest = intersectionTest, tolerance = tolerance, firstParameterName = "combFisher", ... )) } # # Calculation of repeated confidence intervals (RCIs) for Rates # .getRepeatedConfidenceIntervalsRatesEnrichment <- function(..., design) { if (.isTrialDesignInverseNormal(design)) { return(.getRepeatedConfidenceIntervalsRatesEnrichmentInverseNormal(design = design, ...)) } if (.isTrialDesignFisher(design)) { return(.getRepeatedConfidenceIntervalsRatesEnrichmentFisher(design = design, ...)) } .stopWithWrongDesignMessage(design) } # # Calculation of conditional power for Rates # .getConditionalPowerRatesEnrichment <- function(..., stageResults, stage = stageResults$stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, piTreatments = NA_real_, piControls = NA_real_, useAdjustment = TRUE, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { design <- stageResults$.design gMax <- stageResults$getGMax() kMax <- design$kMax piTreatmentsH1 <- .getOptionalArgument("piTreatmentsH1", ...) if (!is.null(piTreatmentsH1) && !is.na(piTreatmentsH1)) { if (!is.na(piTreatments)) { warning(sQuote("piTreatments"), " will be ignored because ", sQuote("piTreatmentsH1"), " is defined", call. = FALSE ) } piTreatments <- piTreatmentsH1 } if (is.matrix(piTreatments)) { piTreatments <- as.vector(piTreatments) } piControlH1 <- .getOptionalArgument("piControlH1", ...) if (!is.null(piControlH1) && !is.na(piControlH1)) { if (!is.na(piControl)) { warning(sQuote("piControl"), " will be ignored because ", sQuote("piControlH1"), " is defined", call. = FALSE ) } piControl <- piControlH1 } results <- ConditionalPowerResultsEnrichmentRates( .design = design, .stageResults = stageResults, piControls = piControls, piTreatments = piTreatments, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned ) if (any(is.na(nPlanned))) { return(results) } .assertIsValidStage(stage, kMax) if (stage == kMax) { .logDebug( "Conditional power will be calculated only for subsequent stages ", "(stage = ", stage, ", kMax = ", kMax, ")" ) return(results) } if (!.isValidNPlanned(nPlanned = nPlanned, kMax = kMax, stage = stage)) { return(results) } .assertIsValidNPlanned(nPlanned, kMax, stage) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) results$.setParameterType("nPlanned", C_PARAM_USER_DEFINED) results$.setParameterType( "allocationRatioPlanned", ifelse(allocationRatioPlanned == C_ALLOCATION_RATIO_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED) ) piControls <- .assertIsValidPiControlForEnrichment(piControls, stageResults, stage, results = results) piTreatments <- .assertIsValidPiTreatmentsForEnrichment(piTreatments, stageResults, stage, results = results) if ((length(piTreatments) != 1) && (length(piTreatments) != gMax)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sprintf(paste0( "length of 'piTreatments' (%s) ", "must be equal to 'gMax' (%s) or 1" ), .arrayToString(piTreatments), gMax) ) } if ((length(piControls) != 1) && (length(piControls) != gMax)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sprintf(paste0( "length of 'piControls' (%s) ", "must be equal to 'gMax' (%s) or 1" ), .arrayToString(piControls), gMax) ) } if (.isTrialDesignInverseNormal(design)) { return(.getConditionalPowerRatesEnrichmentInverseNormal( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, piControls = piControls, piTreatments = piTreatments, ... )) } else if (.isTrialDesignFisher(design)) { return(.getConditionalPowerRatesEnrichmentFisher( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, useAdjustment = useAdjustment, piControls = piControls, piTreatments = piTreatments, iterations = iterations, seed = seed, ... )) } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of TrialDesignInverseNormal or TrialDesignFisher" ) } # # Calculation of conditional power based on inverse normal method # .getConditionalPowerRatesEnrichmentInverseNormal <- function(..., results, design, stageResults, stage, allocationRatioPlanned, nPlanned, piTreatments, piControls) { .assertIsTrialDesignInverseNormal(design) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerRatesEnrichmentInverseNormal", ignore = c("piTreatmentsH1", "piControlH1"), ... ) kMax <- design$kMax gMax <- stageResults$getGMax() weights <- .getWeightsInverseNormal(design) informationRates <- design$informationRates nPlanned <- c(rep(NA_real_, stage), nPlanned) condError <- .getConditionalRejectionProbabilitiesEnrichment(design = design, stageResults = stageResults)[, stage] ml <- (allocationRatioPlanned * piTreatments + piControls) / (1 + allocationRatioPlanned) adjustment <- .getOneMinusQNorm(condError) * (1 - sqrt(ml * (1 - ml) * (1 + allocationRatioPlanned)) / sqrt(piTreatments * (1 - piTreatments) + allocationRatioPlanned * piControls * (1 - piControls))) * (1 + allocationRatioPlanned) / sqrt(allocationRatioPlanned * sum(nPlanned[(stage + 1):kMax])) adjustment[condError < 1e-12] <- 0 .setValueAndParameterType( results, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT ) results$.setParameterType("piControls", C_PARAM_DEFAULT_VALUE) if (length(piTreatments) == 1) { piTreatments <- rep(piTreatments, gMax) results$.setParameterType("piTreatments", C_PARAM_GENERATED) } else { results$.setParameterType("piTreatments", C_PARAM_DEFAULT_VALUE) } if (stageResults$directionUpper) { standardizedEffect <- (piTreatments - piControls - stageResults$thetaH0) / sqrt(piTreatments * (1 - piTreatments) + allocationRatioPlanned * piControls * (1 - piControls)) * sqrt(1 + allocationRatioPlanned) + adjustment } else { standardizedEffect <- -(piTreatments - piControls - stageResults$thetaH0) / sqrt(piTreatments * (1 - piTreatments) + allocationRatioPlanned * piControls * (1 - piControls)) * sqrt(1 + allocationRatioPlanned) + adjustment } nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned ctr <- .performClosedCombinationTest(stageResults = stageResults) criticalValues <- design$criticalValues for (g in 1:gMax) { if (!is.na(ctr$separatePValues[g, stage])) { # shifted decision region for use in getGroupSeqProbs # Inverse Normal Method shiftedDecisionRegionUpper <- criticalValues[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stage], na.rm = TRUE) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - standardizedEffect[g] * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) if (stage == kMax - 1) { shiftedFutilityBounds <- c() } else { shiftedFutilityBounds <- design$futilityBounds[(stage + 1):(kMax - 1)] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):(kMax - 1)]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stage], na.rm = TRUE) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - standardizedEffect[g] * cumsum(sqrt(nPlanned[(stage + 1):(kMax - 1)]) * weights[(stage + 1):(kMax - 1)]) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) } # scaled information for use in getGroupSeqProbs scaledInformation <- (informationRates[(stage + 1):kMax] - informationRates[stage]) / (1 - informationRates[stage]) decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, shiftedDecisionRegionUpper ), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = scaledInformation ) results$conditionalPower[g, (stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ]) } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned results$nPlanned <- nPlanned results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$piTreatments <- piTreatments results$piControls <- piControls return(results) } # # Calculation of conditional power based on Fisher's combination test # .getConditionalPowerRatesEnrichmentFisher <- function(..., results, design, stageResults, stage, allocationRatioPlanned, nPlanned, piTreatments, piControls, useAdjustment = TRUE, iterations, seed) { .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerRatesEnrichmentFisher", ignore = c("piTreatmentsH1", "piControlH1"), ... ) kMax <- design$kMax gMax <- stageResults$getGMax() criticalValues <- design$criticalValues weightsFisher <- .getWeightsFisher(design) results$iterations <- as.integer(iterations) results$.setParameterType("iterations", C_PARAM_USER_DEFINED) results$.setParameterType("seed", ifelse(is.na(seed), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) results$seed <- .setSeed(seed) results$simulated <- FALSE results$.setParameterType("simulated", C_PARAM_DEFAULT_VALUE) nPlanned <- c(rep(NA_real_, stage), nPlanned) if (useAdjustment) { condError <- .getConditionalRejectionProbabilitiesEnrichment( design = design, stageResults = stageResults, iterations = iterations, seed = seed )[, stage] ml <- (allocationRatioPlanned * piTreatments + piControls) / (1 + allocationRatioPlanned) adjustment <- .getOneMinusQNorm(condError) * (1 - sqrt(ml * (1 - ml) * (1 + allocationRatioPlanned)) / sqrt(piTreatments * (1 - piTreatments) + allocationRatioPlanned * piControls * (1 - piControls))) * (1 + allocationRatioPlanned) / sqrt(allocationRatioPlanned * sum(nPlanned[(stage + 1):kMax])) adjustment[condError < 1e-12] <- 0 } else { adjustment <- 0 } .setValueAndParameterType(results, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT) if (length(piTreatments) == 1) { piTreatments <- rep(piTreatments, gMax) results$.setParameterType("piTreatments", C_PARAM_GENERATED) } else { results$.setParameterType("piTreatments", C_PARAM_DEFAULT_VALUE) } if (stageResults$directionUpper) { standardizedEffect <- (piTreatments - piControls) / sqrt(piTreatments * (1 - piTreatments) + allocationRatioPlanned * piControls * (1 - piControls)) * sqrt(1 + allocationRatioPlanned) + adjustment } else { standardizedEffect <- -(piTreatments - piControls - stageResults$thetaH0) / sqrt(piTreatments * (1 - piTreatments) + allocationRatioPlanned * piControls * (1 - piControls)) * sqrt(1 + allocationRatioPlanned) + adjustment } nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned ctr <- .performClosedCombinationTest(stageResults = stageResults) for (g in 1:gMax) { if (!is.na(ctr$separatePValues[g, stage])) { if (gMax == 1) { pValues <- ctr$adjustedStageWisePValues[ctr$indices[, g] == 1, ][1:stage] } else { pValues <- ctr$adjustedStageWisePValues[ctr$indices[, g] == 1, ][which.max( ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stage] ), 1:stage] } if (stage < kMax - 1) { for (k in (stage + 1):kMax) { reject <- 0 for (i in 1:iterations) { reject <- reject + .getRejectValueConditionalPowerFisher( kMax = kMax, alpha0Vec = design$alpha0Vec, criticalValues = criticalValues, weightsFisher = weightsFisher, pValues = pValues, currentKMax = k, thetaH1 = standardizedEffect[g], stage = stage, nPlanned = nPlanned ) } results$conditionalPower[g, k] <- reject / iterations } results$simulated <- TRUE results$.setParameterType("simulated", C_PARAM_GENERATED) } else if (stage == kMax - 1) { divisor <- prod(pValues[1:(kMax - 1)]^weightsFisher[1:(kMax - 1)]) result <- 1 - (criticalValues[kMax] / divisor)^(1 / weightsFisher[kMax]) if (result <= 0 || result >= 1) { warning("Calculation not possible: could not calculate conditional power for stage ", kMax, call. = FALSE ) results$conditionalPower[g, kMax] <- NA_real_ } else { results$conditionalPower[g, kMax] <- 1 - stats::pnorm(.getQNorm(result) - standardizedEffect[g] * sqrt(nPlanned[kMax])) } } } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned results$nPlanned <- nPlanned results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$piTreatments <- piTreatments results$piControls <- piControls return(results) } # # Calculation of conditional power and likelihood values for plotting the graph # .getConditionalPowerLikelihoodRatesEnrichment <- function(..., stageResults, stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, piTreatmentRange, piControls = NA_real_, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .associatedArgumentsAreDefined(nPlanned = nPlanned, piTreatmentRange = piTreatmentRange) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) design <- stageResults$.design kMax <- design$kMax gMax <- stageResults$getGMax() intersectionTest <- stageResults$intersectionTest piControls <- .assertIsValidPiControlForEnrichment(piControls, stageResults, stage) if (length(piControls) == 1) { piControls <- rep(piControls, gMax) } piTreatmentRange <- .assertIsValidPiTreatmentRange(piTreatmentRange = piTreatmentRange) populations <- numeric(gMax * length(piTreatmentRange)) effectValues <- numeric(gMax * length(piTreatmentRange)) condPowerValues <- numeric(gMax * length(piTreatmentRange)) likelihoodValues <- numeric(gMax * length(piTreatmentRange)) stdErr <- sqrt(stageResults$overallPisTreatment[, stage] * (1 - stageResults$overallPisTreatment[, stage])) / sqrt(stageResults$.overallSampleSizes2[, stage]) results <- ConditionalPowerResultsEnrichmentRates( .design = design, .stageResults = stageResults, piControls = piControls, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned ) j <- 1 for (i in seq(along = piTreatmentRange)) { for (g in (1:gMax)) { populations[j] <- g effectValues[j] <- piTreatmentRange[i] if (.isTrialDesignInverseNormal(design)) { condPowerValues[j] <- .getConditionalPowerRatesEnrichmentInverseNormal( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, piControls = piControls, piTreatments = piTreatmentRange[i] )$conditionalPower[g, kMax] } else if (.isTrialDesignFisher(design)) { condPowerValues[j] <- .getConditionalPowerRatesEnrichmentFisher( results = results, design = design, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, useAdjustment = FALSE, piControls = piControls, piTreatments = piTreatmentRange[i], iterations = iterations, seed = seed )$conditionalPower[g, kMax] } likelihoodValues[j] <- stats::dnorm(piTreatmentRange[i], stageResults$overallPisTreatment[g, stage], stdErr[g]) / stats::dnorm(0, 0, stdErr[g]) j <- j + 1 } } subtitle <- paste0( "Intersection test = ", intersectionTest, ", stage = ", stage, ", # of remaining subjects = ", sum(nPlanned), ", control rate = ", .formatSubTitleValue(piControls, "piControls"), ", allocation ratio = ", .formatSubTitleValue(allocationRatioPlanned, "allocationRatioPlanned") ) return(list( populations = populations, xValues = effectValues, condPowerValues = condPowerValues, likelihoodValues = likelihoodValues, main = C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, xlab = "Treatment rate", ylab = C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, sub = subtitle )) } rpact/R/f_analysis_utilities.R0000644000175000017500000010517414145656364016312 0ustar nileshnilesh## | ## | *Analysis of multi-arm designs with adaptive test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include f_core_utilities.R NULL .getGMaxFromAnalysisResult <- function(results) { return(nrow(results$.stageResults$testStatistics)) } .setNPlanned <- function(results, nPlanned) { design <- results$.design if (design$kMax == 1) { if (.isConditionalPowerEnabled(nPlanned)) { warning("'nPlanned' (", .arrayToString(nPlanned), ") ", "will be ignored because design is fixed", call. = FALSE) } results$.setParameterType("nPlanned", C_PARAM_NOT_APPLICABLE) } .setValueAndParameterType(results, "nPlanned", nPlanned, NA_real_) while (length(results$nPlanned) < design$kMax) { results$nPlanned <- c(NA_real_, results$nPlanned) } if (all(is.na(results$nPlanned))) { results$.setParameterType("nPlanned", C_PARAM_NOT_APPLICABLE) } } .isConditionalPowerEnabled <- function(nPlanned) { return(!is.null(nPlanned) && length(nPlanned) > 0 && !all(is.na(nPlanned))) } .warnInCaseOfUnusedConditionalPowerArgument <- function(results, nPlanned, paramName, paramValues) { if (!.isConditionalPowerEnabled(nPlanned)) { if (length(paramValues) > 0 && !all(is.na(paramValues)) && results$.getParameterType(paramName) != C_PARAM_GENERATED) { warning("'", paramName, "' (", .arrayToString(paramValues), ") ", "will be ignored because 'nPlanned' is not defined", call. = FALSE) } return(invisible()) } if (results$.design$kMax == 1) { if (length(paramValues) > 0 && !all(is.na(paramValues)) && results$.getParameterType(paramName) != C_PARAM_GENERATED) { warning("'", paramName, "' (", .arrayToString(paramValues), ") ", "will be ignored because design is fixed", call. = FALSE) } return(invisible()) } } .setNPlannedAndThetaH1 <- function(results, nPlanned, thetaH1) { .setNPlanned(results, nPlanned) .warnInCaseOfUnusedConditionalPowerArgument(results, nPlanned, "thetaH1", thetaH1) if (!is.matrix(results$thetaH1)) { if (results$.getParameterType("thetaH1") %in% c(C_PARAM_TYPE_UNKNOWN, C_PARAM_NOT_APPLICABLE)) { .setValueAndParameterType(results, "thetaH1", thetaH1, NA_real_) } else { results$thetaH1 <- thetaH1 if (results$.getParameterType("thetaH1") == C_PARAM_TYPE_UNKNOWN) { results$.setParameterType("thetaH1", C_PARAM_USER_DEFINED) } } } else { if (results$.getParameterType("thetaH1") %in% c(C_PARAM_TYPE_UNKNOWN, C_PARAM_NOT_APPLICABLE)) { .setValueAndParameterType(results, "thetaH1", value = matrix(thetaH1, ncol = 1), defaultValue = matrix(rep(NA_real_, .getGMaxFromAnalysisResult(results)), ncol = 1)) } else { results$thetaH1 <- matrix(thetaH1, ncol = 1) if (results$.getParameterType("thetaH1") == C_PARAM_TYPE_UNKNOWN) { results$.setParameterType("thetaH1", C_PARAM_USER_DEFINED) } } } } .setNPlannedAndThetaH1AndAssumedStDev <- function(results, nPlanned, thetaH1, assumedStDev) { .setNPlannedAndThetaH1(results, nPlanned, thetaH1) .warnInCaseOfUnusedConditionalPowerArgument(results, nPlanned, "assumedStDev", assumedStDev) if (results$.getParameterType("assumedStDev") %in% c(C_PARAM_TYPE_UNKNOWN, C_PARAM_NOT_APPLICABLE)) { .setValueAndParameterType(results, "assumedStDev", assumedStDev, NA_real_) } else { results$assumedStDev <- assumedStDev if (results$.getParameterType("assumedStDev") == C_PARAM_TYPE_UNKNOWN) { results$.setParameterType("assumedStDev", C_PARAM_USER_DEFINED) } } } .setNPlannedAndThetaH1AndAssumedStDevs <- function(results, nPlanned, thetaH1, assumedStDevs) { .setNPlannedAndThetaH1(results, nPlanned, thetaH1) .warnInCaseOfUnusedConditionalPowerArgument(results, nPlanned, "assumedStDevs", assumedStDevs) if (results$.getParameterType("assumedStDevs") %in% c(C_PARAM_TYPE_UNKNOWN, C_PARAM_NOT_APPLICABLE)) { .setValueAndParameterType(results, "assumedStDevs", value = matrix(assumedStDevs, ncol = 1), defaultValue = matrix(rep(NA_real_, .getGMaxFromAnalysisResult(results)), ncol = 1)) } else { results$assumedStDevs <- matrix(assumedStDevs, ncol = 1) if (results$.getParameterType("assumedStDevs") == C_PARAM_TYPE_UNKNOWN) { results$.setParameterType("assumedStDevs", C_PARAM_USER_DEFINED) } } } .setNPlannedAndPi <- function(results, nPlanned, piControlName, piControlValues, piTreatments) { .setNPlanned(results, nPlanned) .warnInCaseOfUnusedConditionalPowerArgument(results, nPlanned, piControlName, piControlValues) .warnInCaseOfUnusedConditionalPowerArgument(results, nPlanned, "piTreatments", piTreatments) if (results$.getParameterType(piControlName) %in% c(C_PARAM_TYPE_UNKNOWN, C_PARAM_NOT_APPLICABLE)) { .setValueAndParameterType(results, piControlName, matrix(piControlValues, ncol = 1), matrix(rep(NA_real_, .getGMaxFromAnalysisResult(results)), ncol = 1)) } else { results[[piControlName]] <- matrix(piControlValues, ncol = 1) if (results$.getParameterType(piControlName) == C_PARAM_TYPE_UNKNOWN) { results$.setParameterType(piControlName, C_PARAM_USER_DEFINED) } } if (results$.getParameterType("piTreatments") == C_PARAM_TYPE_UNKNOWN) { .setValueAndParameterType(results, "piTreatments", matrix(piTreatments, ncol = 1), matrix(rep(NA_real_, .getGMaxFromAnalysisResult(results)), ncol = 1)) } else { results$piTreatments <- matrix(piTreatments, ncol = 1) if (results$.getParameterType("piTreatments") == C_PARAM_TYPE_UNKNOWN) { results$.setParameterType("piTreatments", C_PARAM_USER_DEFINED) } } } .getSortedSubsets <- function(subsets) { return(subsets[with(data.frame(subsets = subsets, index = as.integer(sub("\\D", "", subsets))), order(index))]) } .getAllAvailableSubsets <- function(numbers, ..., sort = TRUE, digits = NA_integer_) { if (length(numbers) == 0) { return(character(0)) } results <- paste0(numbers, collapse = "") for (n in numbers) { results <- c(results, .getAllAvailableSubsets(numbers[numbers != n], sort = sort)) } if (!is.na(digits)) { results <- results[nchar(results) == digits] } if (!sort) { return(unique(results)) } return(.getSortedSubsets(unique(results))) } .createSubsetsByGMax <- function(gMax, ..., stratifiedInput = TRUE, subsetIdPrefix = "S", restId = ifelse(stratifiedInput, "R", "F"), all = TRUE) { .assertIsSingleInteger(gMax, "gMax", validateType = FALSE) .assertIsInClosedInterval(gMax, "gMax", lower = 1, upper = 10) if (gMax == 1) { subsetName <- paste0(subsetIdPrefix, 1) subsetName <- ifelse(stratifiedInput, subsetName, "F") if (!all) { return(subsetName) } return(list(subsetName)) } numbers <- 1:(gMax - 1) subsets <- list() if (stratifiedInput) { availableSubsets <- paste0(subsetIdPrefix, .getAllAvailableSubsets(numbers)) } else { availableSubsets <- paste0(subsetIdPrefix, numbers) } for (i in numbers) { subset <- availableSubsets[grepl(i, availableSubsets)] subsets[[length(subsets) + 1]] <- subset } if (stratifiedInput) { subsets[[length(subsets) + 1]] <- c(availableSubsets, restId) } else { subsets[[length(subsets) + 1]] <- restId } if (!all) { if (!stratifiedInput) { return(unlist(subsets)) } return(subsets[[gMax]]) } return(subsets) } .arraysAreEqual <- function(a1, a2) { if (length(a1) != length(a2)) { return(FALSE) } l <- length(a1) if (l > 0) { a1 <- sort(a1) a2 <- sort(a2) if (sum(a1 == a2) < l) { return(FALSE) } } return(TRUE) } .getNumberOfGroupsFromArgumentNames <- function(argNames) { numbers <- gsub("\\D", "", argNames) numbers <- numbers[numbers != ""] return(ifelse(length(numbers) == 0, 1, max(as.numeric(numbers)))) } .getGroupNumberFromArgumentName <- function(argName) { n <- gsub("\\D", "", argName) return(ifelse(n == "", 1, as.numeric(n))) } .isControlGroupArgument <- function(argName, numberOfGroups) { if (numberOfGroups <= 2) { return(FALSE) } return(ifelse(numberOfGroups == 1, FALSE, .getGroupNumberFromArgumentName(argName) == numberOfGroups)) } .naOmitBackward <- function(x) { indices <- which(is.na(x)) if (length(indices) == 0) { return(x) } if (length(x) == 1 || !is.na(x[length(x)])) { return(x) } if (length(indices) == 1) { return(x[1:(length(x) - 1)]) } indexBefore <- NA_real_ for (i in length(indices):1) { index <- indices[i] if (!is.na(indexBefore) && index != indexBefore - 1) { return(x[1:(indexBefore - 1)]) } indexBefore <- index } if (!is.na(indexBefore)) { return(x[1:(indexBefore - 1)]) } return(x) } .getNumberOfStagesFromArguments <- function(args, argNames) { numberOfStages <- 1 for (argName in argNames) { argValues <- args[[argName]] n <- length(.naOmitBackward(argValues)) if (n > numberOfStages) { numberOfStages <- n } } return(numberOfStages) } .getNumberOfSubsetsFromArguments <- function(args, argNames) { numberOfSubsets <- 1 for (argName in argNames) { argValues <- args[[argName]] n <- length(na.omit(argValues)) if (n > numberOfSubsets) { numberOfSubsets <- n } } return(numberOfSubsets) } .assertIsValidTreatmentArmArgumentDefined <- function(args, argNames, numberOfGroups, numberOfStages) { tratmentArgNames <- argNames[!grepl(paste0(".*\\D{1}", numberOfGroups, "$"), argNames)] for (argName in tratmentArgNames) { argValues <- args[[argName]] if (!is.null(argValues) && length(.naOmitBackward(argValues)) == numberOfStages) { return(invisible()) } } stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "at least for one treatment arm the values for ", numberOfStages, " stages must be defined ", "because the control arm defines ", numberOfStages, " stages") } .createDataFrame <- function(...) { args <- list(...) argNames <- .getArgumentNames(...) if (length(args) == 0 || length(argNames) == 0) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "data.frame or data vectors expected") } multiArmEnabled <- any(grep("3", argNames)) numberOfGroups <- .getNumberOfGroupsFromArgumentNames(argNames) numberOfStages <- .getNumberOfStagesFromArguments(args, argNames) survivalDataEnabled <- .isDataObjectSurvival(...) enrichmentEnabled <- .isDataObjectEnrichment(...) numberOfSubsets <- 1 if (enrichmentEnabled) { numberOfSubsets <- .getNumberOfSubsetsFromArguments(args, argNames) } if (multiArmEnabled) { .assertIsValidTreatmentArmArgumentDefined(args, argNames, numberOfGroups, numberOfStages) } numberOfValues <- length(args[[1]]) naIndicesBefore <- NULL if (!survivalDataEnabled && multiArmEnabled) { naIndicesBefore <- list() } for (argName in argNames) { argValues <- args[[argName]] if (is.null(argValues) || length(argValues) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argName, "' is not a valid numeric vector") } if (is.na(argValues[1])) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argName, "' is NA at first stage; a valid numeric value must be specified at stage 1") } if (length(argValues) != numberOfValues) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "all data vectors must have the same length: '", argName, "' (", length(argValues), ") differs from '", argNames[1], "' (", numberOfValues, ")") } if (.equalsRegexpIgnoreCase(argName, "^stages?$")) { if (length(stats::na.omit(argValues)) != length(argValues)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "NA's not allowed for '", argName, "'; stages must be defined completely") } definedStages <- sort(intersect(unique(argValues), 1:numberOfValues)) if (length(definedStages) < numberOfValues) { if (length(definedStages) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "no valid stages are defined; ", "stages must be defined completely (", .arrayToString(1:numberOfValues), ")") } if (!enrichmentEnabled) { msg <- ifelse(length(definedStages) == 1, paste0("only stage ", definedStages, " is defined"), paste0("only stages ", .arrayToString(definedStages), " are defined")) stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, msg, "; stages must be defined completely") } } } if (!survivalDataEnabled && .isControlGroupArgument(argName, numberOfGroups) && length(na.omit(argValues)) < numberOfStages) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "control group '", argName, "' (", .arrayToString(argValues, digits = 2), ") must be defined for all stages") } naIndices <- which(is.na(argValues)) if (length(naIndices) > 0) { stageIndex <- naIndices[length(naIndices)] if (stageIndex != numberOfValues) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argName, "' contains a NA at stage ", stageIndex, " followed by a value for a higher stage; NA's must be the last values") } } if (length(naIndices) > 1 && !enrichmentEnabled) { indexBefore <- naIndices[length(naIndices)] for (i in (length(naIndices) - 1):1) { index <- naIndices[i] if (indexBefore - index > 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argName, "' contains alternating values and NA's; ", "NA's must be the last values") } indexBefore <- index } } if (!enrichmentEnabled) { if (!multiArmEnabled && !survivalDataEnabled) { if (!is.null(naIndicesBefore) && !.equalsRegexpIgnoreCase(argName, "^stages?$")) { if (!.arraysAreEqual(naIndicesBefore, naIndices)) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "inconsistent NA definition; ", "if NA's exist, then they are mandatory for each group at the same stage") } } naIndicesBefore <- naIndices } else { groupNumber <- .getGroupNumberFromArgumentName(argName) if (!is.null(naIndicesBefore[[as.character(groupNumber)]]) && !.equalsRegexpIgnoreCase(argName, "^stages?$") && !.isControlGroupArgument(argName, numberOfGroups)) { if (!.arraysAreEqual(naIndicesBefore[[as.character(groupNumber)]], naIndices)) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "values of treatment ", groupNumber, " not correctly specified; ", "if NA's exist, then they are mandatory for each parameter at the same stage") } } if (!.isControlGroupArgument(argName, numberOfGroups)) { naIndicesBefore[[as.character(groupNumber)]] <- naIndices } } } if (sum(is.infinite(argValues)) > 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all data values must be finite; ", "'", argName, "' contains infinite values") } if (!any(grepl(paste0("^", sub("\\d*$","", argName), "$"), C_KEY_WORDS_SUBSETS)) && !is.numeric(argValues)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all data vectors must be numeric ('", argName, "' is ", class(argValues), ")") } if (length(argValues) > C_KMAX_UPPER_BOUND * numberOfSubsets) { stop(C_EXCEPTION_TYPE_ARGUMENT_LENGTH_OUT_OF_BOUNDS, "'", argName, "' is out of bounds [1, ", C_KMAX_UPPER_BOUND, "]") } } if (!enrichmentEnabled) { for (groupNumber in 1:numberOfGroups) { groupVars <- argNames[grepl(paste0("\\D", groupNumber, "$"), argNames)] naIndicesBefore <- NULL for (argName in groupVars) { argValues <- args[[argName]] naIndices <- which(is.na(argValues)) if (!is.null(naIndicesBefore) && !.equalsRegexpIgnoreCase(argName, "^stages?$")) { if (!.arraysAreEqual(naIndicesBefore, naIndices)) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "inconsistent NA definition for group ", groupNumber, "; ", "if NA's exist, then they are mandatory for each group at the same stage") } } naIndicesBefore <- naIndices } } } dataFrame <- as.data.frame(args) if (length(intersect(tolower(names(dataFrame)), c("stage", "stages"))) == 0) { dataFrame$stages <- 1:nrow(dataFrame) } return(dataFrame) } .getDataFrameFromArgs <- function(...) { args <- list(...) if (length(args) == 0) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "cannot initialize dataset because no data are defined") } dataFrame <- NULL dataFrameCounter <- 0 for (arg in args) { if (is.data.frame(arg)) { dataFrameCounter <- dataFrameCounter + 1 if (is.null(dataFrame)) { dataFrame <- arg } } } if (dataFrameCounter > 1) { warning("Found ", dataFrameCounter, ", data.frame arguments; ", "only the first data.frame will be used for the initialization of the dataset", call. = FALSE) } return(dataFrame) } .getArgumentNames <- function(...) { dataFrame <- .getDataFrameFromArgs(...) if (!is.null(dataFrame)) { return(names(dataFrame)) } args <- list(...) if (length(args) == 0) { return(character(0)) } return(names(args)) } .assertIsValidDatasetArgument <- function(...) { argNames <- .getArgumentNames(...) if (length(argNames) == 0) { return(TRUE) } argNamesLower <- tolower(argNames) dataObjectkeyWords <- tolower(C_KEY_WORDS) multiArmKeywords <- tolower(c( C_KEY_WORDS_SUBSETS, C_KEY_WORDS_EVENTS, C_KEY_WORDS_OVERALL_EVENTS, C_KEY_WORDS_SAMPLE_SIZES, C_KEY_WORDS_OVERALL_SAMPLE_SIZES, C_KEY_WORDS_MEANS, C_KEY_WORDS_OVERALL_MEANS, C_KEY_WORDS_ST_DEVS, C_KEY_WORDS_OVERALL_ST_DEVS, C_KEY_WORDS_ALLOCATION_RATIOS, C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, C_KEY_WORDS_LOG_RANKS, C_KEY_WORDS_OVERALL_LOG_RANKS )) enrichmentKeywords <- tolower(c( C_KEY_WORDS_EXPECTED_EVENTS, C_KEY_WORDS_VARIANCE_EVENTS, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) unknownArgs <- setdiff(argNamesLower, dataObjectkeyWords) unknownArgsChecked <- unknownArgs unknownArgs <- c() for (unknownArg in unknownArgsChecked) { unknown <- TRUE for (multiArmKeyword in multiArmKeywords) { if (grepl(paste0(multiArmKeyword, "\\d{1,4}"), unknownArg)) { unknown <- FALSE } } for (enrichmentKeyword in enrichmentKeywords) { if (grepl(enrichmentKeyword, unknownArg)) { unknown <- FALSE } } if (unknown) { unknownArgs <- c(unknownArgs, unknownArg) } } if (length(unknownArgs) > 0) { for (i in 1:length(unknownArgs)) { unknownArgs[i] <- argNames[argNamesLower == unknownArgs[i]][1] } if (length(unknownArgs) == 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the argument '", unknownArgs, "' is not a valid dataset argument") } else { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the arguments ", .arrayToString(unknownArgs, encapsulate = TRUE), " are no valid dataset arguments") } } invisible(TRUE) } .isDataObject <- function(..., dataObjectkeyWords) { .assertIsValidDatasetArgument(...) argNames <- .getArgumentNames(...) if (length(argNames) == 0) { return(FALSE) } argNames <- tolower(argNames) matching <- intersect(argNames, tolower(dataObjectkeyWords)) return(length(matching) > 0) } .isDataObjectEnrichment <- function(...) { return(.isDataObject(..., dataObjectkeyWords = c(C_KEY_WORDS_SUBSETS, paste0(C_KEY_WORDS_SUBSETS, "1")))) } .isDataObjectMeans <- function(...) { return(.isDataObject(..., dataObjectkeyWords = c( C_KEY_WORDS_MEANS, C_KEY_WORDS_ST_DEVS, C_KEY_WORDS_MEANS_1, C_KEY_WORDS_ST_DEVS_1, C_KEY_WORDS_MEANS_2, C_KEY_WORDS_ST_DEVS_2, C_KEY_WORDS_OVERALL_MEANS, C_KEY_WORDS_OVERALL_ST_DEVS, C_KEY_WORDS_OVERALL_MEANS_1, C_KEY_WORDS_OVERALL_ST_DEVS_1, C_KEY_WORDS_OVERALL_MEANS_2, C_KEY_WORDS_OVERALL_ST_DEVS_2))) } .isDataObjectRates <- function(...) { dataObjectkeyWordsExpected <- c(C_KEY_WORDS_EVENTS, C_KEY_WORDS_OVERALL_EVENTS) dataObjectkeyWordsForbidden <- c( C_KEY_WORDS_OVERALL_LOG_RANKS, C_KEY_WORDS_LOG_RANKS, C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, C_KEY_WORDS_ALLOCATION_RATIOS, C_KEY_WORDS_EXPECTED_EVENTS, C_KEY_WORDS_VARIANCE_EVENTS, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS) dataObjectkeyWordsExpected <- c(dataObjectkeyWordsExpected, paste0(dataObjectkeyWordsExpected, c(1, 2))) dataObjectkeyWordsForbidden <- c(dataObjectkeyWordsForbidden, paste0(dataObjectkeyWordsForbidden, c(1, 2))) return(.isDataObject(..., dataObjectkeyWords = dataObjectkeyWordsExpected) && !.isDataObject(..., dataObjectkeyWords = dataObjectkeyWordsForbidden)) } .isDataObjectSurvival <- function(...) { dataObjectkeyWords <- c(C_KEY_WORDS_OVERALL_LOG_RANKS, C_KEY_WORDS_LOG_RANKS, C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, C_KEY_WORDS_ALLOCATION_RATIOS) dataObjectkeyWords <- c(dataObjectkeyWords, paste0(dataObjectkeyWords, c(1, 2))) return(.isDataObject(..., dataObjectkeyWords = dataObjectkeyWords)) } .isDataObjectNonStratifiedEnrichmentSurvival <- function(...) { dataObjectkeyWords <- c( C_KEY_WORDS_EXPECTED_EVENTS, C_KEY_WORDS_VARIANCE_EVENTS, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS ) return(.isDataObject(..., dataObjectkeyWords = dataObjectkeyWords)) } #' #' @title #' Get Wide Format #' #' @description #' Returns the specified dataset as a \code{\link[base]{data.frame}} in so-called wide format. #' #' @details #' In the wide format (unstacked), the data are presented with each different data variable in a separate column, i.e., #' the different groups are in separate columns. #' #' @seealso #' \code{\link{getLongFormat}} for returning the dataset as a \code{\link[base]{data.frame}} in long format. #' #' @return A \code{\link[base]{data.frame}} will be returned. #' #' @keywords internal #' #' @export #' getWideFormat <- function(dataInput) { .assertIsDataset(dataInput) paramNames <- names(dataInput) paramNames <- paramNames[!(paramNames %in% c("groups"))] numberOfSubsets <- dataInput$getNumberOfSubsets() numberOfGroups <- dataInput$getNumberOfGroups(survivalCorrectionEnabled = FALSE) if (numberOfSubsets <= 1) { numberOfStages <- dataInput$getNumberOfStages() df <- data.frame(stages = 1:numberOfStages) } else { numberOfStages <- length(dataInput$subsets) / numberOfGroups / numberOfSubsets df <- data.frame(stages = rep(1:numberOfStages, numberOfSubsets)) } for (paramName in paramNames) { if (numberOfGroups == 1) { df[[paramName]] <- dataInput[[paramName]] } else { for (group in 1:numberOfGroups) { if (paramName %in% c("stages", "subsets")) { varName <- paramName } else { varName <- paste0(paramName, group) } df[[varName]] <- dataInput[[paramName]][dataInput$groups == group] } } } return(df) } .getNumberOfStages = function(dataFrame, naOmitEnabled = TRUE) { if (naOmitEnabled) { colNames <- colnames(dataFrame) validColNames <- character(0) for (colName in colNames) { colValues <- dataFrame[, colName] if (length(colValues) > 0 && !all(is.na(colValues))) { validColNames <- c(validColNames, colName) } } subData <- stats::na.omit(dataFrame[, validColNames]) numberOfStages <- length(unique(as.character(subData$stage))) if (numberOfStages == 0) { print(dataFrame[, validColNames]) stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'dataFrame' seems to contain an invalid column") } return(numberOfStages) } return(length(levels(dataFrame$stage))) } .getWideFormat <- function(dataFrame) { if (!is.data.frame(dataFrame)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataFrame' must be a data.frame (is ", class(dataFrame), ")") } paramNames <- names(dataFrame) paramNames <- paramNames[!(paramNames %in% c("stage", "group", "subset"))] numberOfSubsets <- ifelse(is.factor(dataFrame$subset), length(levels(dataFrame$subset)), length(unique(na.omit(dataFrame$subset)))) numberOfGroups <- ifelse(is.factor(dataFrame$group), length(levels(dataFrame$group)), length(unique(na.omit(dataFrame$group)))) if (numberOfSubsets <= 1) { df <- data.frame(stage = 1:.getNumberOfStages(dataFrame)) } else { df <- data.frame(stage = 1:(length(dataFrame$subset) / numberOfGroups)) } for (paramName in paramNames) { if (numberOfGroups == 1) { df[[paramName]] <- dataFrame[[paramName]] } else { for (group in 1:numberOfGroups) { varName <- paste0(paramName, group) values <- dataFrame[[paramName]][dataFrame$group == group] df[[varName]] <- values } } } if (numberOfSubsets > 1) { stages <- dataFrame$stage[dataFrame$group == 1] df$stage <- stages#sort(rep(stages, multiplier)) subsets <- dataFrame$subset[dataFrame$group == 1] if (nrow(df) != length(subsets)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "something went wrong: ", nrow(df) , " != ", length(subsets)) } df$subset <- subsets df <- .moveColumn(df, "subset", "stage") # df <- df[with(data.frame(subset = df$subset, index = as.integer(sub("\\D", "", df$subset))), order(index)), ] } return(df) } #' #' @title #' Get Long Format #' #' @description #' Returns the specified dataset as a \code{\link[base]{data.frame}} in so-called long format. #' #' @details #' In the long format (narrow, stacked), the data are presented with one column containing #' all the values and another column listing the context of the value, i.e., #' the data for the different groups are in one column and the dataset contains an additional "group" column. #' #' @seealso #' \code{\link{getWideFormat}} for returning the dataset as a \code{\link[base]{data.frame}} in wide format. #' #' @return A \code{\link[base]{data.frame}} will be returned. #' #' @keywords internal #' #' @export #' getLongFormat <- function(dataInput) { .assertIsDataset(dataInput) return(as.data.frame(dataInput, niceColumnNamesEnabled = FALSE)) } .setConditionalPowerArguments <- function(results, dataInput, nPlanned, allocationRatioPlanned) { .assertIsAnalysisResults(results) .setNPlanned(results, nPlanned) numberOfGroups <- dataInput$getNumberOfGroups() .assertIsValidAllocationRatioPlanned(allocationRatioPlanned, numberOfGroups) if (!.isConditionalPowerEnabled(nPlanned) || numberOfGroups == 1) { if (numberOfGroups == 1) { if (length(allocationRatioPlanned) == 1 && !identical(allocationRatioPlanned, 1)) { warning("'allocationRatioPlanned' (", allocationRatioPlanned, ") ", "will be ignored because the specified data has only one group", call. = FALSE) } } else if (!identical(allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT)) { warning("'allocationRatioPlanned' (", allocationRatioPlanned, ") ", "will be ignored because 'nPlanned' is not defined", call. = FALSE) } results$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) return(invisible(results)) } .setValueAndParameterType(results, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT) return(invisible(results)) } .getRecalculatedInformationRates <- function(dataInput, maxInformation, stage = NA_integer_) { .assertIsSingleInteger(stage, "stage", naAllowed = TRUE, validateType = FALSE) stageFromData <- dataInput$getNumberOfStages() if (is.null(stage) || is.na(stage) || stage > stageFromData) { stage <- stageFromData } informationRates <- rep(NA_real_, stage) absoluteInformations <- rep(NA_real_, stage) if (.isDatasetMeans(dataInput) || .isDatasetRates(dataInput)) { for (k in 1:stage) { sampleSizes <- dataInput$getOverallSampleSizes(stage = k) absoluteInformations[k] <- sum(sampleSizes, na.rm = TRUE) informationRates[k] <- absoluteInformations[k] / maxInformation } } else if (.isDatasetSurvival(dataInput)) { for (k in 1:stage) { events <- dataInput$getOverallEvents(stage = k) absoluteInformations[k] <- sum(events, na.rm = TRUE) informationRates[k] <- absoluteInformations[k] / maxInformation } } else { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'dataInput' class ", class(dataInput), " is not supported") } return(list(informationRates = informationRates, absoluteInformations = absoluteInformations, stage = stage)) } #' @title #' Get Observed Information Rates #' #' @description #' Recalculates the observed information rates from the specified dataset. #' #' @param dataInput The dataset for which the information rates shall be recalculated. #' @inheritParams param_maxInformation #' @inheritParams param_informationEpsilon #' @inheritParams param_stage #' @inheritParams param_three_dots #' #' @details #' For means and rates the maximum information is the maximum number of subjects #' or the relative proportion if \code{informationEpsilon} < 1; #' for survival data it is the maximum number of events #' or the relative proportion if \code{informationEpsilon} < 1. #' #' @seealso #' \itemize{ #' \item \code{\link{getAnalysisResults}} for using \code{getObservedInformationRates} implicit, #' \item https://www.rpact.com/vignettes/rpact_boundary_update_example #' } #' #' @examples #' # Absolute information epsilon: #' # decision rule 45 >= 46 - 1, i.e., under-running #' data <- getDataset ( #' overallN = c(22, 45), #' overallEvents = c(11, 28)) #' getObservedInformationRates (data, #' maxInformation = 46, informationEpsilon = 1) #' #' # Relative information epsilon: #' # last information rate = 45/46 = 0.9783, #' # is > 1 - 0.03 = 0.97, i.e., under-running #' data <- getDataset ( #' overallN = c(22, 45), #' overallEvents = c(11, 28)) #' getObservedInformationRates (data, #' maxInformation = 46, informationEpsilon = 0.03) #' #' @export #' getObservedInformationRates <- function(dataInput, ..., maxInformation = NULL, informationEpsilon = NULL, stage = NA_integer_) { .assertIsDataset(dataInput) .assertIsSingleInteger(maxInformation, "maxInformation", validateType = FALSE) information <- .getRecalculatedInformationRates(dataInput, maxInformation, stage = stage) informationRates <- information$informationRates absoluteInformations <- information$absoluteInformations stage <- information$stage status <- "interim-stage" showObservedInformationRatesMessage <- .getOptionalArgument("showObservedInformationRatesMessage", ...) if (is.null(showObservedInformationRatesMessage) || !is.logical(showObservedInformationRatesMessage)) { showObservedInformationRatesMessage <- TRUE } # Updates at the final analysis in case the observed information at the final analysis # is larger ("over-running") or smaller ("under-running") than the planned maximum information if (informationRates[length(informationRates)] < 1) { underRunningEnabled <- FALSE if (!is.null(informationEpsilon)) { .assertIsSingleNumber(informationEpsilon, "informationEpsilon") .assertIsInOpenInterval(informationEpsilon, "informationEpsilon", lower = 0, upper = maxInformation) lastInformationRate <- informationRates[length(informationRates)] lastInformationNumber <- absoluteInformations[length(absoluteInformations)] if (informationEpsilon < 1) { if (lastInformationRate >= (1 - informationEpsilon)) { message("Under-running: relative information epsilon ", round(informationEpsilon, 4), " is applicable; ", "use observed information ", lastInformationNumber, " instead of planned information ", maxInformation) information <- .getRecalculatedInformationRates( dataInput, lastInformationNumber, stage = stage) informationRates <- information$informationRates absoluteInformations <- information$absoluteInformations stage <- information$stage underRunningEnabled <- TRUE maxInformation <- lastInformationNumber showObservedInformationRatesMessage <- FALSE } } else { if ((lastInformationNumber + informationEpsilon) >= maxInformation) { message("Under-running: absolute information epsilon ", round(informationEpsilon, 1), " is applicable; ", "use observed information ", lastInformationNumber, " instead of planned information ", maxInformation) maxInformation <- lastInformationNumber information <- .getRecalculatedInformationRates( dataInput, lastInformationNumber, stage = stage) informationRates <- information$informationRates absoluteInformations <- information$absoluteInformations stage <- information$stage underRunningEnabled <- TRUE showObservedInformationRatesMessage <- FALSE } } } if (!underRunningEnabled) { informationRates <- c(informationRates, 1) } else { status <- "under-running" } } else { lastInformationNumber <- absoluteInformations[length(absoluteInformations)] if (lastInformationNumber > maxInformation) { information <- .getRecalculatedInformationRates( dataInput, lastInformationNumber, stage = stage) informationRates <- information$informationRates absoluteInformations <- information$absoluteInformations stage <- information$stage message("Over-running: observed information ", lastInformationNumber, " at stage ", length(absoluteInformations), " is larger than the maximum planned information ", maxInformation, "; information rates will be recalculated") status <- "over-running" maxInformation <- lastInformationNumber showObservedInformationRatesMessage <- FALSE } } if (any(informationRates > 1)) { warning("The observed information at stage ", .arrayToString(which(informationRates > 1)), " is over-running, ", "i.e., the information rate (", .arrayToString(informationRates[informationRates > 1]), ") ", "is larger than the planned maximum information rate (1)", call. = FALSE) } informationRates[informationRates > 1] <- 1 end <- min(which(informationRates == 1)) informationRates <- informationRates[1:end] if (showObservedInformationRatesMessage) { message("The observed information rates for 'maxInformation' = ", maxInformation, " at stage ", stage, " are: ", .arrayToString(informationRates)) } if (status == "interim-stage" && informationRates[length(informationRates)] == 1 && stage == length(informationRates)) { status <- "final-stage" } return(list( absoluteInformations = absoluteInformations, maxInformation = maxInformation, informationEpsilon = informationEpsilon, informationRates = informationRates, status = status)) } rpact/R/data.R0000644000175000017500000001334114155670335012765 0ustar nileshnilesh## | ## | *Data* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5652 $ ## | Last changed: $Date: 2021-12-13 17:12:12 +0100 (Mo, 13 Dez 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' One-Arm Dataset of Means #' #' A dataset containing the sample sizes, means, and standard deviations of one group. #' Use \code{getDataset(dataMeans)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. #' #' @format A \code{\link[base]{data.frame}} object. #' "dataMeans" #' One-Arm Dataset of Rates #' #' A dataset containing the sample sizes and events of one group. #' Use \code{getDataset(dataRates)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. #' #' @format A \code{\link[base]{data.frame}} object. #' "dataRates" #' One-Arm Dataset of Survival Data #' #' A dataset containing the log-rank statistics, events, and allocation ratios of one group. #' Use \code{getDataset(dataSurvival)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. #' #' @format A \code{\link[base]{data.frame}} object. #' "dataSurvival" ## Mulit-arm #' Multi-Arm Dataset of Means #' #' A dataset containing the sample sizes, means, and standard deviations of four groups. #' Use \code{getDataset(dataMultiArmMeans)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. #' #' @format A \code{\link[base]{data.frame}} object. #' "dataMultiArmMeans" #' Multi-Arm Dataset of Rates #' #' A dataset containing the sample sizes and events of three groups. #' Use \code{getDataset(dataMultiArmRates)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. #' #' @format A \code{\link[base]{data.frame}} object. #' "dataMultiArmRates" #' Multi-Arm Dataset of Survival Data #' #' A dataset containing the log-rank statistics, events, and allocation ratios of three groups. #' Use \code{getDataset(dataMultiArmSurvival)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. #' #' @format A \code{\link[base]{data.frame}} object. #' "dataMultiArmSurvival" ## Enrichment #' Enrichment Dataset of Means #' #' A dataset containing the sample sizes, means, and standard deviations of two groups. #' Use \code{getDataset(dataEnrichmentMeans)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. #' #' @format A \code{\link[base]{data.frame}} object. #' "dataEnrichmentMeans" #' Enrichment Dataset of Rates #' #' A dataset containing the sample sizes and events of two groups. #' Use \code{getDataset(dataEnrichmentRates)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. #' #' @format A \code{\link[base]{data.frame}} object. #' "dataEnrichmentRates" #' Enrichment Dataset of Survival Data #' #' A dataset containing the log-rank statistics, events, and allocation ratios of two groups. #' Use \code{getDataset(dataEnrichmentSurvival)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. #' #' @format A \code{\link[base]{data.frame}} object. #' "dataEnrichmentSurvival" ## Enrichment Stratified #' Stratified Enrichment Dataset of Means #' #' A dataset containing the sample sizes, means, and standard deviations of two groups. #' Use \code{getDataset(dataEnrichmentMeansStratified)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. #' #' @format A \code{\link[base]{data.frame}} object. #' "dataEnrichmentMeansStratified" #' Stratified Enrichment Dataset of Rates #' #' A dataset containing the sample sizes and events of two groups. #' Use \code{getDataset(dataEnrichmentRatesStratified)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. #' #' @format A \code{\link[base]{data.frame}} object. #' "dataEnrichmentRatesStratified" #' Stratified Enrichment Dataset of Survival Data #' #' A dataset containing the log-rank statistics, events, and allocation ratios of two groups. #' Use \code{getDataset(dataEnrichmentSurvivalStratified)} to create a dataset object that can be processed by \code{\link{getAnalysisResults}}. #' #' @format A \code{\link[base]{data.frame}} object. #' "dataEnrichmentSurvivalStratified" #' #' @title #' Raw Dataset Of A Two Arm Continuous Outcome With Covariates #' #' @description #' An artificial dataset that was randomly generated #' with simulated normal data. The data set has six variables: #' #' 1. Subject id #' 2. Stage number #' 3. Group name #' 4. An example outcome in that we are interested in #' 5. The first covariate *gender* #' 6. The second covariate *covariate* #' #' @details #' See the vignette "Two-arm analysis for continuous data with covariates from raw data" #' to learn how to #' #' * import raw data from a csv file, #' * calculate estimated adjusted (marginal) means (EMMs, least-squares means) for a linear model, and #' * perform two-arm interim analyses with these data. #' #' You can use \code{rawDataTwoArmNormal} to reproduce the examples in the vignette. #' #' @format A \code{\link[base]{data.frame}} object. #' "rawDataTwoArmNormal" rpact/R/f_analysis_base_means.R0000644000175000017500000024541514153345060016362 0ustar nileshnilesh## | ## | *Analysis of means with group sequential and combination test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5615 $ ## | Last changed: $Date: 2021-12-06 09:29:15 +0100 (Mo, 06 Dez 2021) $ ## | Last changed by: $Author: wassmer $ ## | .getAnalysisResultsMeans <- function(..., design, dataInput) { if (.isTrialDesignGroupSequential(design)) { return(.getAnalysisResultsMeansGroupSequential( design = design, dataInput = dataInput, ... )) } if (.isTrialDesignInverseNormal(design)) { return(.getAnalysisResultsMeansInverseNormal( design = design, dataInput = dataInput, ... )) } if (.isTrialDesignFisher(design)) { return(.getAnalysisResultsMeansFisher( design = design, dataInput = dataInput, ... )) } .stopWithWrongDesignMessage(design) } .getAnalysisResultsMeansInverseNormal <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, equalVariances = C_EQUAL_VARIANCES_DEFAULT, thetaH0 = C_THETA_H0_MEANS_DEFAULT, thetaH1 = NA_real_, nPlanned = NA_real_, assumedStDev = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, parallelComputingEnabled = FALSE) { .assertIsTrialDesignInverseNormal(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsMeansInverseNormal", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsInverseNormal(design = design, dataInput = dataInput) .getAnalysisResultsMeansAll( results = results, design = design, dataInput = dataInput, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances, thetaH0 = thetaH0, thetaH1 = thetaH1, nPlanned = nPlanned, assumedStDev = assumedStDev, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance, parallelComputingEnabled = parallelComputingEnabled ) return(results) } .getAnalysisResultsMeansGroupSequential <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, equalVariances = C_EQUAL_VARIANCES_DEFAULT, thetaH0 = C_THETA_H0_MEANS_DEFAULT, thetaH1 = NA_real_, nPlanned = NA_real_, assumedStDev = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, parallelComputingEnabled = FALSE) { .assertIsTrialDesignGroupSequential(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsMeansGroupSequential", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsGroupSequential(design = design, dataInput = dataInput) .getAnalysisResultsMeansAll( results = results, design = design, dataInput = dataInput, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances, thetaH0 = thetaH0, thetaH1 = thetaH1, nPlanned = nPlanned, assumedStDev = assumedStDev, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance, parallelComputingEnabled = parallelComputingEnabled ) return(results) } .getAnalysisResultsMeansFisher <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, equalVariances = C_EQUAL_VARIANCES_DEFAULT, thetaH0 = C_THETA_H0_MEANS_DEFAULT, thetaH1 = NA_real_, nPlanned = NA_real_, assumedStDev = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_, parallelComputingEnabled = FALSE) { .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsMeansFisher", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsFisher(design = design, dataInput = dataInput) .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) .getAnalysisResultsMeansAll( results = results, design = design, dataInput = dataInput, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances, thetaH0 = thetaH0, thetaH1 = thetaH1, nPlanned = nPlanned, assumedStDev = assumedStDev, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance, iterations = iterations, seed = seed, parallelComputingEnabled = parallelComputingEnabled ) return(results) } # # The following parameters will be taken from 'design': # stages, informationRates, criticalValues, futilityBounds, alphaSpent, stageLevels # .getAnalysisResultsMeansAll <- function(..., results, design, dataInput, stage, directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances, thetaH0, thetaH1, assumedStDev, nPlanned, allocationRatioPlanned, tolerance, iterations, seed, parallelComputingEnabled = FALSE) { startTime <- Sys.time() .assertIsValidTolerance(tolerance) stageResults <- .getStageResultsMeans( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances ) results$.setStageResults(stageResults) .logProgress("Stage results calculated", startTime = startTime) assumedStDev <- .assertIsValidAssumedStDev(assumedStDev, stageResults, stage, results = results) thetaH1 <- .assertIsValidThetaH1(thetaH1, stageResults, stage, results = results) .setValueAndParameterType(results, "thetaH0", thetaH0, C_THETA_H0_MEANS_DEFAULT) .setValueAndParameterType(results, "directionUpper", directionUpper, C_DIRECTION_UPPER_DEFAULT) .setValueAndParameterType( results, "normalApproximation", normalApproximation, C_NORMAL_APPROXIMATION_MEANS_DEFAULT ) if (stageResults$isTwoSampleDataset()) { .setValueAndParameterType(results, "equalVariances", equalVariances, C_EQUAL_VARIANCES_DEFAULT) } else { results$.setParameterType("equalVariances", C_PARAM_NOT_APPLICABLE) } .setConditionalPowerArguments(results, dataInput, nPlanned, allocationRatioPlanned) .setNPlannedAndThetaH1AndAssumedStDev(results, nPlanned, thetaH1, assumedStDev) # test actions results$testActions <- getTestActions(stageResults = stageResults) results$.setParameterType("testActions", C_PARAM_GENERATED) if (design$kMax > 1) { # conditional power startTime <- Sys.time() if (.isTrialDesignFisher(design)) { results$.conditionalPowerResults <- .getConditionalPowerMeans( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, assumedStDev = assumedStDev, thetaH1 = thetaH1, iterations = iterations, seed = seed ) if (results$.conditionalPowerResults$simulated) { results$conditionalPowerSimulated <- results$.conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalPowerSimulated", C_PARAM_GENERATED) results$.setParameterType("seed", results$.conditionalPowerResults$.getParameterType("seed")) results$seed <- results$.conditionalPowerResults$seed results$.setParameterType( "iterations", results$.conditionalPowerResults$.getParameterType("iterations") ) results$iterations <- results$.conditionalPowerResults$iterations } else { results$conditionalPower <- results$.conditionalPowerResults$conditionalPower results$conditionalPowerSimulated <- numeric(0) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$.setParameterType("conditionalPowerSimulated", C_PARAM_NOT_APPLICABLE) } } else { results$.conditionalPowerResults <- .getConditionalPowerMeans( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, assumedStDev = assumedStDev, thetaH1 = thetaH1 ) results$conditionalPower <- results$.conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_GENERATED) } .logProgress("Conditional power calculated", startTime = startTime) # CRP - conditional rejection probabilities startTime <- Sys.time() if (.isTrialDesignFisher(design) && isTRUE(.getOptionalArgument("simulateCRP", ...))) { results$.setParameterType("seed", ifelse(is.na(seed), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) seed <- results$.conditionalPowerResults$seed crp <- getConditionalRejectionProbabilities( stageResults = stageResults, iterations = iterations, seed = seed ) results$conditionalRejectionProbabilities <- crp$crpFisherSimulated paramTypeSeed <- results$.conditionalPowerResults$.getParameterType("seed") if (paramTypeSeed != C_PARAM_TYPE_UNKNOWN) { results$.setParameterType("seed", paramTypeSeed) } results$seed <- seed } else { results$conditionalRejectionProbabilities <- getConditionalRejectionProbabilities(stageResults = stageResults) } results$.setParameterType("conditionalRejectionProbabilities", C_PARAM_GENERATED) .logProgress("Conditional rejection probabilities (CRP) calculated", startTime = startTime) } if (parallelComputingEnabled && .createParallelComputingCluster()) { startTime <- Sys.time() .parallelComputingCaseNumbers <<- c(1, 2) .parallelComputingArguments <<- list( results = results, design = design, dataInput = dataInput, stage = stage, normalApproximation = normalApproximation, equalVariances = equalVariances, tolerance = tolerance, stageResults = stageResults ) parallel::clusterExport( .parallelComputingCluster, c( ".getAnalysisResultsMeansParallelComputing", ".parallelComputingCaseNumbers", ".parallelComputingArguments" ) ) parallelComputingResults <- .runAnalysisResultsMeansParallelComputing() results$repeatedConfidenceIntervalLowerBounds <- parallelComputingResults[[1]]$repeatedConfidenceIntervalLowerBounds results$repeatedConfidenceIntervalUpperBounds <- parallelComputingResults[[1]]$repeatedConfidenceIntervalUpperBounds results$repeatedPValues <- parallelComputingResults[[2]]$repeatedPValues .logProgress("Repeated confidence interval and repeated p-values calculated", startTime = startTime ) } else { # RCI - repeated confidence interval startTime <- Sys.time() repeatedConfidenceIntervals <- .getRepeatedConfidenceIntervalsMeans( design = design, dataInput = dataInput, stage = stage, normalApproximation = normalApproximation, equalVariances = equalVariances, tolerance = tolerance ) results$repeatedConfidenceIntervalLowerBounds <- repeatedConfidenceIntervals[1, ] results$repeatedConfidenceIntervalUpperBounds <- repeatedConfidenceIntervals[2, ] .logProgress("Repeated confidence interval calculated", startTime = startTime) # repeated p-value startTime <- Sys.time() results$repeatedPValues <- getRepeatedPValues( stageResults = stageResults, tolerance = tolerance ) .logProgress("Repeated p-values calculated", startTime = startTime) } results$.setParameterType("repeatedConfidenceIntervalLowerBounds", C_PARAM_GENERATED) results$.setParameterType("repeatedConfidenceIntervalUpperBounds", C_PARAM_GENERATED) results$.setParameterType("repeatedPValues", C_PARAM_GENERATED) if (design$kMax > 1) { startTime <- Sys.time() # final p-value finalPValue <- getFinalPValue(stageResults) results$finalPValues <- .getVectorWithFinalValueAtFinalStage( kMax = design$kMax, finalValue = finalPValue$pFinal, finalStage = finalPValue$finalStage ) results$finalStage <- finalPValue$finalStage results$.setParameterType("finalPValues", C_PARAM_GENERATED) results$.setParameterType("finalStage", C_PARAM_GENERATED) .logProgress("Final p-value calculated", startTime = startTime) # final confidence interval & median unbiased estimate startTime <- Sys.time() finalConfidenceIntervals <- .getFinalConfidenceIntervalMeans( design = design, dataInput = dataInput, thetaH0 = thetaH0, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances, tolerance = tolerance ) if (!is.null(finalConfidenceIntervals)) { finalStage <- finalConfidenceIntervals$finalStage results$finalConfidenceIntervalLowerBounds <- .getVectorWithFinalValueAtFinalStage( kMax = design$kMax, finalValue = finalConfidenceIntervals$finalConfidenceInterval[1], finalStage = finalStage ) results$finalConfidenceIntervalUpperBounds <- .getVectorWithFinalValueAtFinalStage( kMax = design$kMax, finalValue = finalConfidenceIntervals$finalConfidenceInterval[2], finalStage = finalStage ) results$medianUnbiasedEstimates <- .getVectorWithFinalValueAtFinalStage( kMax = design$kMax, finalValue = finalConfidenceIntervals$medianUnbiased, finalStage = finalStage ) results$.setParameterType("finalConfidenceIntervalLowerBounds", C_PARAM_GENERATED) results$.setParameterType("finalConfidenceIntervalUpperBounds", C_PARAM_GENERATED) results$.setParameterType("medianUnbiasedEstimates", C_PARAM_GENERATED) .logProgress("Final confidence interval calculated", startTime = startTime) } } return(results) } .runAnalysisResultsMeansParallelComputing <- function() { results <- parallel::parLapply( .parallelComputingCluster, .parallelComputingCaseNumbers, function(i) { .getAnalysisResultsMeansParallelComputing(i, .parallelComputingArguments) } ) return(results) } # @title # Get Analysis Results Means Parallel Computing # # @description # Internal usage for parallel computing only. # # @details # Cluster based parallel computing requires exported functions. # # @keywords internal # #' @export .getAnalysisResultsMeansParallelComputing <- function(caseNumber, arguments) { results <- arguments$results design <- arguments$design dataInput <- arguments$dataInput stage <- arguments$stage normalApproximation <- arguments$normalApproximation equalVariances <- arguments$equalVariances tolerance <- arguments$tolerance stageResults <- arguments$stageResults # RCI - repeated confidence interval if (caseNumber == 1) { repeatedConfidenceIntervals <- .getRepeatedConfidenceIntervalsMeans( design = design, dataInput = dataInput, stage = stage, normalApproximation = normalApproximation, equalVariances = equalVariances, tolerance = tolerance ) return(list( repeatedConfidenceIntervalLowerBounds = repeatedConfidenceIntervals[1, ], repeatedConfidenceIntervalUpperBounds = repeatedConfidenceIntervals[2, ] )) } # repeated p-value else if (caseNumber == 2) { return(list(repeatedPValues = getRepeatedPValues( design = design, stageResults = stageResults, stage = stage, tolerance = tolerance ))) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'caseNumber' (", caseNumber, ") must be 1 or 2") } .getStageResultsMeans <- function(..., design, dataInput, thetaH0 = C_THETA_H0_MEANS_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, equalVariances = C_EQUAL_VARIANCES_DEFAULT, stage = NA_integer_, userFunctionCallEnabled = FALSE) { .assertIsDatasetMeans(dataInput = dataInput) .assertIsValidThetaH0DataInput(thetaH0, dataInput) .assertIsValidDirectionUpper(directionUpper, design$sided, userFunctionCallEnabled = userFunctionCallEnabled ) .assertIsSingleLogical(normalApproximation, "normalApproximation") .assertIsSingleLogical(equalVariances, "equalVariances") .warnInCaseOfUnknownArguments( functionName = "getStageResultsMeans", ignore = .getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), ... ) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design, stage = stage ) effectSizes <- rep(NA_real_, design$kMax) if (dataInput$getNumberOfGroups() == 1) { overallTestStatistics <- c((dataInput$getOverallMeansUpTo(stage) - thetaH0) / dataInput$getOverallStDevsUpTo(stage) * sqrt(dataInput$getOverallSampleSizesUpTo(stage)), rep(NA_real_, design$kMax - stage)) if (normalApproximation) { overallPValues <- 1 - stats::pnorm(overallTestStatistics) } else { overallPValues <- 1 - stats::pt( overallTestStatistics, dataInput$getOverallSampleSizesUpTo(stage) - 1 ) } effectSizes[1:stage] <- dataInput$getOverallMeansUpTo(stage) } if (dataInput$getNumberOfGroups() == 2) { # common variance overallStDevs <- rep(NA_real_, design$kMax) for (k in 1:stage) { overallStDevs[k] <- sqrt(((sum(dataInput$getSampleSizesUpTo(k, 1)) - 1) * dataInput$getOverallStDev(k)^2 + (sum(dataInput$getSampleSizesUpTo(k, 2)) - 1) * dataInput$getOverallStDev(k, 2)^2) / (sum(dataInput$getSampleSizesUpTo(k, 1)) + sum(dataInput$getSampleSizesUpTo(k, 2)) - 2)) } overallSampleSizes1 <- dataInput$getOverallSampleSizesUpTo(stage) overallSampleSizes2 <- dataInput$getOverallSampleSizesUpTo(stage, 2) if (equalVariances) { overallTestStatistics <- c( (dataInput$getOverallMeansUpTo(stage) - dataInput$getOverallMeansUpTo(stage, 2) - thetaH0) / overallStDevs[1:stage] / sqrt(1 / overallSampleSizes1 + 1 / overallSampleSizes2), rep(NA_real_, design$kMax - stage) ) } else { overallTestStatistics <- c( (dataInput$getOverallMeansUpTo(stage) - dataInput$getOverallMeansUpTo(stage, 2) - thetaH0) / (sqrt(dataInput$getOverallStDevsUpTo(stage)^2 / overallSampleSizes1 + dataInput$getOverallStDevsUpTo(stage, 2)^2 / overallSampleSizes2)), rep(NA_real_, design$kMax - stage) ) } if (normalApproximation) { overallPValues <- 1 - stats::pnorm(overallTestStatistics) } else { if (equalVariances) { overallPValues <- 1 - stats::pt( overallTestStatistics, overallSampleSizes1 + overallSampleSizes2 - 2 ) } else { u <- dataInput$getOverallStDevsUpTo(stage)^2 / overallSampleSizes1 / (dataInput$getOverallStDevsUpTo(stage)^2 / overallSampleSizes1 + dataInput$getOverallStDevsUpTo(stage, 2)^2 / overallSampleSizes2) overallPValues <- 1 - stats::pt( overallTestStatistics, 1 / (u^2 / (overallSampleSizes1 - 1) + (1 - u)^2 / (overallSampleSizes2 - 1)) ) } } effectSizes[1:stage] <- dataInput$getOverallMeansUpTo(stage) - dataInput$getOverallMeansUpTo(stage, 2) } if (!directionUpper) { overallPValues <- 1 - overallPValues } # calculation of stage-wise test statistics and combination tests testStatistics <- rep(NA_real_, design$kMax) pValues <- rep(NA_real_, design$kMax) combInverseNormal <- rep(NA_real_, design$kMax) combFisher <- rep(NA_real_, design$kMax) weightsInverseNormal <- .getWeightsInverseNormal(design) weightsFisher <- .getWeightsFisher(design) for (k in 1:stage) { if (dataInput$getNumberOfGroups() == 1) { # stage-wise test statistics testStatistics[k] <- (dataInput$getMean(k) - thetaH0) / dataInput$getStDev(k) * sqrt(dataInput$getSampleSize(k)) if (normalApproximation) { # stage-wise p-values pValues[k] <- 1 - stats::pnorm(testStatistics[k]) } else { pValues[k] <- 1 - stats::pt(testStatistics[k], dataInput$getSampleSize(k) - 1) } } if (dataInput$getNumberOfGroups() == 2) { # stage-wise test statistics if (equalVariances) { testStatistics[k] <- (dataInput$getMean(k, 1) - dataInput$getMean(k, 2) - thetaH0) / sqrt(((dataInput$getSampleSize(k, 1) - 1) * dataInput$getStDev(k, 1)^2 + (dataInput$getSampleSize(k, 2) - 1) * dataInput$getStDev(k, 2)^2) / (dataInput$getSampleSize(k, 1) + dataInput$getSampleSize(k, 2) - 2)) / sqrt(1 / dataInput$getSampleSize(k, 1) + 1 / dataInput$getSampleSize(k, 2)) } else { testStatistics[k] <- (dataInput$getMean(k, 1) - dataInput$getMean(k, 2) - thetaH0) / sqrt(dataInput$getStDev(k, 1)^2 / dataInput$getSampleSize(k, 1) + dataInput$getStDev(k, 2)^2 / dataInput$getSampleSize(k, 2)) } if (normalApproximation) { # stage-wise p-values pValues[k] <- 1 - stats::pnorm(testStatistics[k]) } else { if (equalVariances) { pValues[k] <- 1 - stats::pt( testStatistics[k], dataInput$getSampleSize(k, 1) + dataInput$getSampleSize(k, 2) - 2 ) } else { u <- dataInput$getStDev(k, 1)^2 / dataInput$getSampleSize(k, 1) / (dataInput$getStDev(k, 1)^2 / dataInput$getSampleSize(k, 1) + dataInput$getStDev(k, 2)^2 / dataInput$getSampleSize(k, 2)) pValues[k] <- 1 - stats::pt( testStatistics[k], 1 / (u^2 / (dataInput$getSampleSize(k, 1) - 1) + (1 - u)^2 / (dataInput$getSampleSize(k, 2) - 1)) ) } } } if (!directionUpper) { pValues[k] <- 1 - pValues[k] } # inverse normal test combInverseNormal[k] <- (weightsInverseNormal[1:k] %*% .getOneMinusQNorm(pValues[1:k])) / sqrt(sum(weightsInverseNormal[1:k]^2)) # Fisher combination test combFisher[k] <- prod(pValues[1:k]^weightsFisher[1:k]) } if (dataInput$getNumberOfGroups() == 1) { stageResults <- StageResultsMeans( design = design, dataInput = dataInput, stage = as.integer(stage), overallTestStatistics = .fillWithNAs(overallTestStatistics, design$kMax), overallPValues = .fillWithNAs(overallPValues, design$kMax), overallMeans = .trimAnalysisMeansResultObjectAndFillWithNAs( dataInput$getOverallMeans(), design$kMax ), overallStDevs = .trimAnalysisMeansResultObjectAndFillWithNAs( dataInput$getOverallStDevs(), design$kMax ), overallSampleSizes = .fillWithNAs(dataInput$getOverallSampleSizesUpTo(stage), design$kMax), testStatistics = testStatistics, effectSizes = effectSizes, pValues = pValues, combInverseNormal = combInverseNormal, combFisher = combFisher, weightsFisher = weightsFisher, weightsInverseNormal = weightsInverseNormal, thetaH0 = thetaH0, direction = ifelse(directionUpper, C_DIRECTION_UPPER, C_DIRECTION_LOWER), normalApproximation = normalApproximation, equalVariances = equalVariances ) } else if (dataInput$getNumberOfGroups() == 2) { stageResults <- StageResultsMeans( design = design, dataInput = dataInput, stage = as.integer(stage), overallTestStatistics = .fillWithNAs(overallTestStatistics, design$kMax), overallPValues = .fillWithNAs(overallPValues, design$kMax), overallMeans1 = .trimAnalysisMeansResultObjectAndFillWithNAs( dataInput$getOverallMeans(group = 1), design$kMax ), overallMeans2 = .trimAnalysisMeansResultObjectAndFillWithNAs( dataInput$getOverallMeans(group = 2), design$kMax ), overallStDevs1 = .trimAnalysisMeansResultObjectAndFillWithNAs( dataInput$getOverallStDevs(group = 1), design$kMax ), overallStDevs2 = .trimAnalysisMeansResultObjectAndFillWithNAs( dataInput$getOverallStDevs(group = 2), design$kMax ), overallStDevs = overallStDevs, # common variance overallSampleSizes1 = .fillWithNAs(dataInput$getOverallSampleSizesUpTo(stage), design$kMax), overallSampleSizes2 = .fillWithNAs(dataInput$getOverallSampleSizesUpTo(stage, 2), design$kMax), effectSizes = effectSizes, testStatistics = testStatistics, pValues = pValues, combInverseNormal = combInverseNormal, combFisher = combFisher, weightsFisher = weightsFisher, weightsInverseNormal = weightsInverseNormal, thetaH0 = thetaH0, direction = ifelse(directionUpper, C_DIRECTION_UPPER, C_DIRECTION_LOWER), normalApproximation = normalApproximation, equalVariances = equalVariances ) } if (.isTrialDesignFisher(design)) { stageResults$.setParameterType("combFisher", C_PARAM_GENERATED) stageResults$.setParameterType("weightsFisher", C_PARAM_GENERATED) } else if (.isTrialDesignInverseNormal(design)) { stageResults$.setParameterType("combInverseNormal", C_PARAM_GENERATED) stageResults$.setParameterType("weightsInverseNormal", C_PARAM_GENERATED) } return(stageResults) } .trimAnalysisMeansResultObjectAndFillWithNAs <- function(x, kMax) { return(.fillWithNAs(.trimAnalysisMeansResultObject(x, kMax), kMax)) } .trimAnalysisMeansResultObject <- function(x, kMax) { if (is.matrix(x)) { if (ncol(x) <= kMax) { return(x) } return(x[, 1:kMax]) } if (length(x) <= kMax) { return(x) } return(x[1:kMax]) } # # Calculation of lower and upper limits of repeated confidence intervals (RCIs) for Means # .getRepeatedConfidenceIntervalsMeans <- function(design, ...) { if (.isTrialDesignGroupSequential(design)) { return(.getRepeatedConfidenceIntervalsMeansGroupSequential(design = design, ...)) } if (.isTrialDesignInverseNormal(design)) { return(.getRepeatedConfidenceIntervalsMeansInverseNormal(design = design, ...)) } if (.isTrialDesignFisher(design)) { return(.getRepeatedConfidenceIntervalsMeansFisher(design = design, ...)) } .stopWithWrongDesignMessage(design) } .getRootThetaMeans <- function(..., design, dataInput, stage, directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances, thetaLow, thetaUp, firstParameterName, secondValue, tolerance, callingFunctionInformation = NA_character_) { result <- .getOneDimensionalRoot( function(theta) { stageResults <- .getStageResultsMeans( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances ) firstValue <- stageResults[[firstParameterName]][stage] if (.isTrialDesignGroupSequential(design)) { firstValue <- .getOneMinusQNorm(firstValue) } return(firstValue - secondValue) }, lower = thetaLow, upper = thetaUp, tolerance = tolerance, callingFunctionInformation = callingFunctionInformation ) return(result) } .getUpperLowerThetaMeans <- function(..., design, dataInput, theta, stage, directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances, conditionFunction, firstParameterName, secondValue) { stageResults <- .getStageResultsMeans( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances ) firstValue <- stageResults[[firstParameterName]][stage] if (.isTrialDesignGroupSequential(design)) { firstValue <- .getOneMinusQNorm(firstValue) } maxSearchIterations <- 50 while (conditionFunction(secondValue, firstValue)) { theta <- 2 * theta stageResults <- .getStageResultsMeans( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances ) firstValue <- stageResults[[firstParameterName]][stage] if (.isTrialDesignGroupSequential(design)) { firstValue <- .getOneMinusQNorm(firstValue) } maxSearchIterations <- maxSearchIterations - 1 if (maxSearchIterations < 0) { stop(sprintf( paste0( "Failed to find theta (k = %s, firstValue = %s, ", "secondValue = %s, levels(firstValue) = %s, theta = %s)" ), stage, stageResults[[firstParameterName]][stage], secondValue, firstValue, theta )) } } return(theta) } .getRepeatedConfidenceIntervalsMeansAll <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, equalVariances = C_EQUAL_VARIANCES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, firstParameterName) { stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) futilityCorr <- rep(NA_real_, design$kMax) # necessary for adjustment for binding futility boundaries criticalValues <- design$criticalValues criticalValues[is.infinite(criticalValues) & criticalValues > 0] <- C_QNORM_MAXIMUM criticalValues[is.infinite(criticalValues) & criticalValues < 0] <- C_QNORM_MINIMUM if (.isTrialDesignFisher(design)) { bounds <- design$alpha0Vec border <- C_ALPHA_0_VEC_DEFAULT conditionFunction <- .isFirstValueSmallerThanSecondValue } else { bounds <- design$futilityBounds border <- C_FUTILITY_BOUNDS_DEFAULT conditionFunction <- .isFirstValueGreaterThanSecondValue } repeatedConfidenceIntervals <- matrix(NA_real_, nrow = 2, ncol = design$kMax) for (k in 1:stage) { startTime <- Sys.time() # finding maximum upper and minimum lower bounds for RCIs thetaLow <- .getUpperLowerThetaMeans( design = design, dataInput = dataInput, theta = -1, stage = k, directionUpper = TRUE, normalApproximation = normalApproximation, equalVariances = equalVariances, conditionFunction = conditionFunction, firstParameterName = firstParameterName, secondValue = criticalValues[k] ) thetaUp <- .getUpperLowerThetaMeans( design = design, dataInput = dataInput, theta = 1, stage = k, directionUpper = FALSE, normalApproximation = normalApproximation, equalVariances = equalVariances, conditionFunction = conditionFunction, firstParameterName = firstParameterName, secondValue = criticalValues[k] ) # finding upper and lower RCI limits through root function repeatedConfidenceIntervals[1, k] <- .getRootThetaMeans( design = design, dataInput = dataInput, stage = k, directionUpper = TRUE, normalApproximation = normalApproximation, equalVariances = equalVariances, thetaLow = thetaLow, thetaUp = thetaUp, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance, callingFunctionInformation = paste0("Repeated confidence interval [1, ", k, "]") ) repeatedConfidenceIntervals[2, k] <- .getRootThetaMeans( design = design, dataInput = dataInput, stage = k, directionUpper = FALSE, normalApproximation = normalApproximation, equalVariances = equalVariances, thetaLow = thetaLow, thetaUp = thetaUp, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance, callingFunctionInformation = paste0("Repeated confidence interval [1, ", k, "]") ) # adjustment for binding futility bounds if (k > 1 && conditionFunction(bounds[k - 1], border) & design$bindingFutility) { parameterName <- ifelse(.isTrialDesignFisher(design), "pValues", firstParameterName) # Calculate new lower and upper bounds if (directionUpper) { thetaLow <- .getUpperLowerThetaMeans( design = design, dataInput = dataInput, theta = -1, stage = k - 1, directionUpper = TRUE, normalApproximation = normalApproximation, equalVariances = equalVariances, conditionFunction = conditionFunction, firstParameterName = parameterName, secondValue = bounds[k - 1] ) } else { thetaUp <- .getUpperLowerThetaMeans( design = design, dataInput = dataInput, theta = 1, stage = k - 1, directionUpper = FALSE, normalApproximation = normalApproximation, equalVariances = equalVariances, conditionFunction = conditionFunction, firstParameterName = parameterName, secondValue = bounds[k - 1] ) } futilityCorr[k] <- .getRootThetaMeans( design = design, dataInput = dataInput, stage = k - 1, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances, thetaLow = thetaLow, thetaUp = thetaUp, firstParameterName = parameterName, secondValue = bounds[k - 1], tolerance = tolerance, callingFunctionInformation = paste0("Repeated confidence interval, futility correction [", k, "]") ) if (directionUpper) { repeatedConfidenceIntervals[1, k] <- min(min(futilityCorr[2:k]), repeatedConfidenceIntervals[1, k]) } else { repeatedConfidenceIntervals[2, k] <- max(max(futilityCorr[2:k]), repeatedConfidenceIntervals[2, k]) } } if (!is.na(repeatedConfidenceIntervals[1, k]) && !is.na(repeatedConfidenceIntervals[2, k]) && repeatedConfidenceIntervals[1, k] > repeatedConfidenceIntervals[2, k]) { repeatedConfidenceIntervals[, k] <- rep(NA_real_, 2) } .logProgress("Repeated confidence interval of stage %s calculated", startTime = startTime, k) } return(repeatedConfidenceIntervals) } # # RCIs based on group sequential combination test # .getRepeatedConfidenceIntervalsMeansGroupSequential <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, equalVariances = C_EQUAL_VARIANCES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsMeansGroupSequential", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) return(.getRepeatedConfidenceIntervalsMeansAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, equalVariances = equalVariances, directionUpper = directionUpper, tolerance = tolerance, firstParameterName = "overallPValues", ... )) } # # RCIs based on inverse normal combination test # .getRepeatedConfidenceIntervalsMeansInverseNormal <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, equalVariances = C_EQUAL_VARIANCES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsMeansInverseNormal", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) return(.getRepeatedConfidenceIntervalsMeansAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, equalVariances = equalVariances, directionUpper = directionUpper, tolerance = tolerance, firstParameterName = "combInverseNormal", ... )) } # # RCIs based on Fisher's combination test # .getRepeatedConfidenceIntervalsMeansFisher <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, equalVariances = C_EQUAL_VARIANCES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsMeansFisher", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) return(.getRepeatedConfidenceIntervalsMeansAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, equalVariances = equalVariances, directionUpper = directionUpper, tolerance = tolerance, firstParameterName = "combFisher", ... )) } # # Calculation of conditional power based on group sequential method # .getConditionalPowerMeansGroupSequential <- function(..., stageResults, stage = stageResults$stage, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, nPlanned = NA_real_, thetaH1 = NA_real_, assumedStDev = NA_real_) { design <- stageResults$.design .assertIsTrialDesignGroupSequential(design) .assertIsValidStage(stage, design$kMax) assumedStDev <- .assertIsValidAssumedStDev(assumedStDev, stageResults, stage) thetaH1 <- .assertIsValidThetaH1(thetaH1, stageResults, stage) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerMeansGroupSequential", ignore = c("stage", "design", "stageResultsName", "grid", "stDevH1"), ... ) kMax <- design$kMax conditionalPower <- rep(NA_real_, kMax) weights <- stageResults$weightsInverseNormal informationRates <- design$informationRates nPlanned <- c(rep(NA, stage), nPlanned) if (stage == kMax) { .logDebug( "Conditional power will be calculated only for subsequent stages ", "(stage = ", stage, ", kMax = ", design$kMax, ")" ) return(list( nPlanned = nPlanned, conditionalPower = conditionalPower )) } criticalValues <- design$criticalValues if (stageResults$isTwoSampleDataset()) { .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned } if (stageResults$direction == "upper") { thetaH1 <- (thetaH1 - stageResults$thetaH0) / assumedStDev } else { thetaH1 <- -(thetaH1 - stageResults$thetaH0) / assumedStDev } # shifted decision region for use in getGroupSeqProbs # Group Sequential Method shiftedDecisionRegionUpper <- criticalValues[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - .getOneMinusQNorm(stageResults$overallPValues[stage]) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - thetaH1 * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) if (design$sided == 2) { shiftedDecisionRegionLower <- -criticalValues[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - c(weights[1:stage] %*% .getOneMinusQNorm(stageResults$pValues[1:stage])) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - thetaH1 * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) } if (stage == kMax - 1) { shiftedFutilityBounds <- c() } else { shiftedFutilityBounds <- design$futilityBounds[(stage + 1):(kMax - 1)] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):(kMax - 1)]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - .getOneMinusQNorm(stageResults$overallPValues[stage]) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - thetaH1 * cumsum(sqrt(nPlanned[(stage + 1):(kMax - 1)]) * weights[(stage + 1):(kMax - 1)]) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) } # scaled information for use in getGroupSeqProbs scaledInformation <- (informationRates[(stage + 1):kMax] - informationRates[stage]) / (1 - informationRates[stage]) if (design$sided == 2) { decisionMatrix <- matrix(c(shiftedDecisionRegionLower, shiftedDecisionRegionUpper), nrow = 2, byrow = TRUE) } else { decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, shiftedDecisionRegionUpper ), nrow = 2, byrow = TRUE) } probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = scaledInformation ) if (design$twoSidedPower) { conditionalPower[(stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ] + probs[1, ]) } else { conditionalPower[(stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ]) } if (stageResults$isTwoSampleDataset()) { nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned } return(list( nPlanned = nPlanned, conditionalPower = conditionalPower )) } # # Calculation of conditional power based on inverse normal method # .getConditionalPowerMeansInverseNormal <- function(..., stageResults, stage = stageResults$stage, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, nPlanned = NA_real_, thetaH1 = NA_real_, assumedStDev = NA_real_) { design <- stageResults$.design .assertIsTrialDesignInverseNormal(design) .assertIsValidStage(stage, design$kMax) assumedStDev <- .assertIsValidAssumedStDev(assumedStDev, stageResults, stage) thetaH1 <- .assertIsValidThetaH1(thetaH1, stageResults, stage) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerMeansInverseNormal", ignore = c("stage", "design", "stageResultsName", "grid", "stDevH1"), ... ) kMax <- design$kMax conditionalPower <- rep(NA_real_, kMax) weights <- stageResults$weightsInverseNormal informationRates <- design$informationRates nPlanned <- c(rep(NA_real_, stage), nPlanned) if (stage == kMax) { .logDebug( "Conditional power will be calculated only for subsequent stages ", "(stage = ", stage, ", kMax = ", design$kMax, ")" ) return(list( nPlanned = nPlanned, conditionalPower = conditionalPower )) } criticalValuesInverseNormal <- design$criticalValues if (stageResults$isTwoSampleDataset()) { .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned } if (stageResults$direction == "upper") { thetaH1 <- (thetaH1 - stageResults$thetaH0) / assumedStDev } else { thetaH1 <- -(thetaH1 - stageResults$thetaH0) / assumedStDev } # shifted decision region for use in getGroupSeqProbs # Inverse Normal Method shiftedDecisionRegionUpper <- criticalValuesInverseNormal[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - c(weights[1:stage] %*% .getOneMinusQNorm(stageResults$pValues[1:stage])) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - thetaH1 * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) if (design$sided == 2) { shiftedDecisionRegionLower <- -criticalValuesInverseNormal[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - c(weights[1:stage] %*% .getOneMinusQNorm(stageResults$pValues[1:stage])) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - thetaH1 * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) } if (stage == kMax - 1) { shiftedFutilityBounds <- c() } else { shiftedFutilityBounds <- design$futilityBounds[(stage + 1):(kMax - 1)] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):(kMax - 1)]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - c(weights[1:stage] %*% .getOneMinusQNorm(stageResults$pValues[1:stage])) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - thetaH1 * cumsum(sqrt(nPlanned[(stage + 1):(kMax - 1)]) * weights[(stage + 1):(kMax - 1)]) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) } # scaled information for use in getGroupSeqProbs scaledInformation <- (informationRates[(stage + 1):kMax] - informationRates[stage]) / (1 - informationRates[stage]) if (design$sided == 2) { decisionMatrix <- matrix(c(shiftedDecisionRegionLower, shiftedDecisionRegionUpper), nrow = 2, byrow = TRUE) } else { decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, shiftedDecisionRegionUpper ), nrow = 2, byrow = TRUE) } probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = scaledInformation ) if (design$twoSidedPower) { conditionalPower[(stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ] + probs[1, ]) } else { conditionalPower[(stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ]) } if (stageResults$isTwoSampleDataset()) { nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned } return(list( nPlanned = nPlanned, conditionalPower = conditionalPower )) } # # Calculation of conditional power based on Fisher combination test # .getConditionalPowerMeansFisher <- function(..., stageResults, stage = stageResults$stage, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, nPlanned = NA_real_, thetaH1 = NA_real_, assumedStDev = NA_real_, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { design <- stageResults$.design .assertIsTrialDesignFisher(design) .assertIsValidStage(stage, design$kMax) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) assumedStDev <- .assertIsValidAssumedStDev(assumedStDev, stageResults, stage) thetaH1 <- .assertIsValidThetaH1(thetaH1, stageResults, stage) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerMeansFisher", ignore = c("stage", "design", "stageResultsName", "grid", "stDevH1"), ... ) kMax <- design$kMax conditionalPower <- rep(NA_real_, kMax) seed <- .setSeed(seed) simulated <- FALSE .assertIsValidNPlanned(nPlanned, kMax, stage) nPlanned <- c(rep(NA_real_, stage), nPlanned) if (stageResults$isTwoSampleDataset()) { .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval( allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM ) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned } if (stageResults$direction == "upper") { thetaH1 <- (thetaH1 - stageResults$thetaH0) / assumedStDev } else { thetaH1 <- -(thetaH1 - stageResults$thetaH0) / assumedStDev } criticalValues <- design$criticalValues weightsFisher <- stageResults$weightsFisher pValues <- stageResults$pValues if (stage < kMax - 1) { for (k in (stage + 1):kMax) { reject <- 0 for (i in 1:iterations) { reject <- reject + .getRejectValueConditionalPowerFisher( kMax = kMax, alpha0Vec = design$alpha0Vec, criticalValues = criticalValues, weightsFisher = weightsFisher, pValues = pValues, currentKMax = k, thetaH1 = thetaH1, stage = stage, nPlanned = nPlanned ) } conditionalPower[k] <- reject / iterations } simulated <- TRUE } else if (stage == kMax - 1) { divisor <- prod(pValues[1:(kMax - 1)]^weightsFisher[1:(kMax - 1)]) result <- 1 - (criticalValues[kMax] / divisor)^(1 / weightsFisher[kMax]) if (result <= 0 || result >= 1) { warning("Calculation not possible: could not calculate ", "conditional power for stage ", kMax, call. = FALSE ) conditionalPower[kMax] <- NA_real_ } else { conditionalPower[kMax] <- 1 - stats::pnorm(.getQNorm(result) - thetaH1 * sqrt(nPlanned[kMax])) } } if (stageResults$isTwoSampleDataset()) { nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned } return(list( nPlanned = nPlanned, conditionalPower = conditionalPower, iterations = as.integer(iterations), seed = seed, simulated = simulated )) } .getConditionalPowerMeans <- function(..., stageResults, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaH1 = NA_real_, assumedStDev = NA_real_) { stDevH1 <- .getOptionalArgument("stDevH1", ...) if (!is.null(stDevH1) && !is.na(stDevH1)) { if (!is.na(assumedStDev)) { warning(sQuote("assumedStDev"), " will be ignored because ", sQuote("stDevH1"), " is defined", call. = FALSE ) } assumedStDev <- stDevH1 } .assertIsSingleNumber(thetaH1, "thetaH1", naAllowed = TRUE) .assertIsSingleNumber(assumedStDev, "assumedStDev", naAllowed = TRUE) design <- stageResults$.design results <- ConditionalPowerResultsMeans( .stageResults = stageResults, .design = design, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, assumedStDev = assumedStDev ) if (any(is.na(nPlanned))) { return(results) } if (!.isValidNPlanned(nPlanned = nPlanned, kMax = design$kMax, stage = stageResults$stage)) { return(results) } if (.isTrialDesignGroupSequential(design)) { cp <- .getConditionalPowerMeansGroupSequential( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, assumedStDev = assumedStDev, ... ) } else if (.isTrialDesignInverseNormal(design)) { cp <- .getConditionalPowerMeansInverseNormal( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, assumedStDev = assumedStDev, ... ) } else if (.isTrialDesignFisher(design)) { cp <- .getConditionalPowerMeansFisher( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, assumedStDev = assumedStDev, ... ) results$iterations <- cp$iterations results$seed <- cp$seed results$simulated <- cp$simulated if (results$simulated) { results$.setParameterType( "iterations", ifelse(is.null(.getOptionalArgument("iterations", ...)), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED ) ) results$.setParameterType( "seed", ifelse(is.null(.getOptionalArgument("seed", ...)), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED ) ) } } else { .stopWithWrongDesignMessage(design) } results$nPlanned <- cp$nPlanned results$conditionalPower <- cp$conditionalPower results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$.setParameterType( "allocationRatioPlanned", ifelse(allocationRatioPlanned == C_ALLOCATION_RATIO_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED) ) results$.setParameterType("thetaH1", ifelse(is.na(thetaH1), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) results$.setParameterType("assumedStDev", ifelse(is.na(assumedStDev), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) return(results) } .getConditionalPowerPlotMeans <- function(..., stageResults, stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaRange, assumedStDev = NA_real_) { .associatedArgumentsAreDefined(nPlanned = nPlanned, thetaRange = thetaRange) .assertIsValidAllocationRatioPlanned( allocationRatioPlanned, stageResults$getDataInput()$getNumberOfGroups() ) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerPlotMeans", ignore = c("iterations", "seed", "stageResultsName", "grid"), ... ) assumedStDev <- .assertIsValidAssumedStDev(assumedStDev, stageResults, stage) thetaRange <- .assertIsValidThetaRange(thetaRange = thetaRange) condPowerValues <- rep(NA, length(thetaRange)) likelihoodValues <- rep(NA, length(thetaRange)) if (stageResults$isOneSampleDataset()) { stdErr <- stageResults$overallStDevs[stage] / sqrt(stageResults$overallSampleSizes[stage]) } else if (stageResults$isTwoSampleDataset()) { stdErr <- stageResults$overallStDevs[stage] * sqrt(1 / stageResults$overallSampleSizes1[stage] + 1 / stageResults$overallSampleSizes2[stage]) } design <- stageResults$.design warningMessages <- c() withCallingHandlers( for (i in seq(along.with = thetaRange)) { if (.isTrialDesignGroupSequential(design)) { condPowerValues[i] <- .getConditionalPowerMeansGroupSequential( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i], assumedStDev = assumedStDev )$conditionalPower[design$kMax] } else if (.isTrialDesignInverseNormal(design)) { condPowerValues[i] <- .getConditionalPowerMeansInverseNormal( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i], assumedStDev = assumedStDev )$conditionalPower[design$kMax] } else if (.isTrialDesignFisher(design)) { condPowerValues[i] <- .getConditionalPowerMeansFisher( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i], assumedStDev = assumedStDev )$conditionalPower[design$kMax] } likelihoodValues[i] <- stats::dnorm( thetaRange[i], stageResults$effectSizes[stage], stdErr ) / stats::dnorm(0, 0, stdErr) }, warning = function(w) { m <- w$message if (!(m %in% warningMessages)) { warningMessages <<- c(warningMessages, m) } invokeRestart("muffleWarning") }, error = function(e) { e } ) if (length(warningMessages) > 0) { for (m in warningMessages) { warning(m, call. = FALSE) } } if (stageResults$isOneSampleDataset()) { subtitle <- paste0( "Stage = ", stage, ", # of remaining subjects = ", sum(nPlanned), ", sd = ", .formatSubTitleValue(assumedStDev, "assumedStDev") ) } else { subtitle <- paste0( "Stage = ", stage, ", # of remaining subjects = ", sum(nPlanned), ", sd = ", .formatSubTitleValue(assumedStDev, "assumedStDev"), ", allocation ratio = ", .formatSubTitleValue(allocationRatioPlanned, "allocationRatioPlanned") ) } return(list( xValues = thetaRange, condPowerValues = condPowerValues, likelihoodValues = likelihoodValues, main = C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, xlab = "Effect size", ylab = C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, sub = subtitle )) } # # Calculation of final confidence interval # based on group sequential test without SSR (general case). # .getFinalConfidenceIntervalMeansGroupSequential <- function(..., design, dataInput, stage, thetaH0 = C_THETA_H0_MEANS_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, equalVariances = C_EQUAL_VARIANCES_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { stageResults <- .getStageResultsMeans( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances ) finalConfidenceIntervalGeneral <- rep(NA_real_, 2) medianUnbiasedGeneral <- NA_real_ stageGroupSeq <- .getStageGroupSeq(design = design, stageResults = stageResults, stage = stage) finalStage <- min(stageGroupSeq, design$kMax) # early stopping or at end of study if (stageGroupSeq < design$kMax || stage == design$kMax) { if (stageGroupSeq == 1) { finalConfidenceIntervalGeneral[1] <- .getOneMinusQNorm(stageResults$overallPValues[1]) - .getOneMinusQNorm(design$alpha / design$sided) finalConfidenceIntervalGeneral[2] <- .getOneMinusQNorm(stageResults$overallPValues[1]) + .getOneMinusQNorm(design$alpha / design$sided) medianUnbiasedGeneral <- .getOneMinusQNorm(stageResults$overallPValues[1]) if (dataInput$getNumberOfGroups() == 1) { finalConfidenceIntervalGeneral <- finalConfidenceIntervalGeneral / sqrt(stageResults$overallSampleSizes[1]) medianUnbiasedGeneral <- medianUnbiasedGeneral / sqrt(stageResults$overallSampleSizes[1]) } else { finalConfidenceIntervalGeneral <- finalConfidenceIntervalGeneral * sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) medianUnbiasedGeneral <- medianUnbiasedGeneral * sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) } } else { finalConfidenceIntervalGeneral[1] <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "overallPValues", case = "finalConfidenceIntervalGeneralLower" ) finalConfidenceIntervalGeneral[2] <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "overallPValues", case = "finalConfidenceIntervalGeneralUpper" ) medianUnbiasedGeneral <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "overallPValues", case = "medianUnbiasedGeneral" ) } } if (is.na(finalConfidenceIntervalGeneral[1]) && (stageGroupSeq > 1)) { finalStage <- NA_integer_ } finalConfidenceInterval <- rep(NA_real_, 2) medianUnbiased <- NA_real_ if (!is.na(finalStage)) { # Retransformation if (dataInput$getNumberOfGroups() == 1) { stdErr <- stageResults$overallStDevs[finalStage] / sqrt(stageResults$overallSampleSizes[finalStage]) } else { stdErr <- stageResults$overallStDevs[finalStage] * sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) } directionUpperSign <- ifelse(directionUpper, 1, -1) if (stageGroupSeq == 1) { finalConfidenceInterval[1] <- stageResults$effectSizes[1] - .getOneMinusQNorm(design$alpha / design$sided) * stdErr finalConfidenceInterval[2] <- stageResults$effectSizes[1] + .getOneMinusQNorm(design$alpha / design$sided) * stdErr medianUnbiased <- stageResults$effectSizes[1] } else { finalConfidenceInterval[1] <- finalConfidenceIntervalGeneral[1] * stageResults$overallStDevs[finalStage] + directionUpperSign * thetaH0 finalConfidenceInterval[2] <- finalConfidenceIntervalGeneral[2] * stageResults$overallStDevs[finalStage] + directionUpperSign * thetaH0 medianUnbiased <- medianUnbiasedGeneral * stageResults$overallStDevs[finalStage] + directionUpperSign * thetaH0 } } if (!directionUpper) { medianUnbiasedGeneral <- -medianUnbiasedGeneral finalConfidenceIntervalGeneral <- -finalConfidenceIntervalGeneral if (stageGroupSeq > 1) { medianUnbiased <- -medianUnbiased finalConfidenceInterval <- -finalConfidenceInterval } } return(list( finalStage = finalStage, medianUnbiasedGeneral = medianUnbiasedGeneral, finalConfidenceIntervalGeneral = sort(finalConfidenceIntervalGeneral), medianUnbiased = medianUnbiased, finalConfidenceInterval = sort(finalConfidenceInterval) )) } # # Calculation of final confidence interval # based on inverse normal method, only theoretically shown to be valid for kMax <= 2 or no SSR. # .getFinalConfidenceIntervalMeansInverseNormal <- function(..., design, dataInput, stage, thetaH0 = C_THETA_H0_MEANS_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, equalVariances = C_EQUAL_VARIANCES_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { stageResults <- .getStageResultsMeans( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances ) finalConfidenceIntervalGeneral <- rep(NA_real_, 2) medianUnbiasedGeneral <- NA_real_ stageInvNormal <- .getStageInverseNormal(design = design, stageResults = stageResults, stage = stage) finalStage <- min(stageInvNormal, design$kMax) # early stopping or at end of study if (stageInvNormal < design$kMax || stage == design$kMax) { if (stageInvNormal == 1) { finalConfidenceIntervalGeneral[1] <- stageResults$combInverseNormal[1] - .getOneMinusQNorm(design$alpha / design$sided) finalConfidenceIntervalGeneral[2] <- stageResults$combInverseNormal[1] + .getOneMinusQNorm(design$alpha / design$sided) medianUnbiasedGeneral <- stageResults$combInverseNormal[1] if (dataInput$getNumberOfGroups() == 1) { finalConfidenceIntervalGeneral <- finalConfidenceIntervalGeneral / sqrt(stageResults$overallSampleSizes[1]) medianUnbiasedGeneral <- medianUnbiasedGeneral / sqrt(stageResults$overallSampleSizes[1]) } else { finalConfidenceIntervalGeneral <- finalConfidenceIntervalGeneral * sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) medianUnbiasedGeneral <- medianUnbiasedGeneral * sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) } } else { if ((design$kMax > 2) && !.isNoEarlyEfficacy(design)){ message( "Calculation of final confidence interval performed for kMax = ", design$kMax, " (for kMax > 2, it is theoretically shown that it is valid only ", "if no sample size change was performed)" ) } finalConfidenceIntervalGeneral[1] <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "combInverseNormal", case = "finalConfidenceIntervalGeneralLower" ) finalConfidenceIntervalGeneral[2] <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "combInverseNormal", case = "finalConfidenceIntervalGeneralUpper" ) medianUnbiasedGeneral <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "combInverseNormal", case = "medianUnbiasedGeneral" ) } } if (is.na(finalConfidenceIntervalGeneral[1]) && (stageInvNormal > 1)) { finalStage <- NA_integer_ } finalConfidenceInterval <- rep(NA_real_, 2) medianUnbiased <- NA_real_ if (!is.na(finalStage)) { # Retransformation if (dataInput$getNumberOfGroups() == 1) { stderr <- stageResults$overallStDevs[finalStage] / sqrt(stageResults$overallSampleSizes[finalStage]) } else { stderr <- stageResults$overallStDevs[finalStage] * sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) } directionUpperSign <- ifelse(directionUpper, 1, -1) if (stageInvNormal == 1) { finalConfidenceInterval[1] <- stageResults$effectSizes[1] - .getOneMinusQNorm(design$alpha / design$sided) * stderr finalConfidenceInterval[2] <- stageResults$effectSizes[1] + .getOneMinusQNorm(design$alpha / design$sided) * stderr medianUnbiased <- stageResults$effectSizes[1] } else { finalConfidenceInterval[1] <- finalConfidenceIntervalGeneral[1] * stageResults$overallStDevs[finalStage] + directionUpperSign * thetaH0 finalConfidenceInterval[2] <- finalConfidenceIntervalGeneral[2] * stageResults$overallStDevs[finalStage] + directionUpperSign * thetaH0 medianUnbiased <- medianUnbiasedGeneral * stageResults$overallStDevs[finalStage] + directionUpperSign * thetaH0 } } if (!directionUpper) { medianUnbiasedGeneral <- -medianUnbiasedGeneral finalConfidenceIntervalGeneral <- -finalConfidenceIntervalGeneral if (stageInvNormal > 1) { medianUnbiased <- -medianUnbiased finalConfidenceInterval <- -finalConfidenceInterval } } return(list( finalStage = finalStage, medianUnbiasedGeneral = medianUnbiasedGeneral, finalConfidenceIntervalGeneral = sort(finalConfidenceIntervalGeneral), medianUnbiased = medianUnbiased, finalConfidenceInterval = sort(finalConfidenceInterval) )) } .getQFunctionResultBasedOnDataInput <- function(..., design, dataInput, theta, stage, infRate, directionUpper, normalApproximation, equalVariances) { if (dataInput$getNumberOfGroups() == 1) { stageResults <- .getStageResultsMeans( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, normalApproximation = normalApproximation ) } if (dataInput$getNumberOfGroups() == 2) { stageResults <- .getStageResultsMeans( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances ) } return(.getQFunctionResult( design = design, stageResults = stageResults, theta = theta, infRate = infRate )) } # # Calculation of final confidence interval # based on Fisher combination test, only valid for kMax <= 2. # .getFinalConfidenceIntervalMeansFisher <- function(..., design, dataInput, stage, thetaH0 = C_THETA_H0_MEANS_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, equalVariances = C_EQUAL_VARIANCES_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { stageResults <- .getStageResultsMeans( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances ) stageFisher <- .getStageFisher(design = design, stageResults = stageResults, stage = stage) finalStage <- min(stageFisher, design$kMax) finalConfidenceInterval <- rep(NA_real_, 2) medianUnbiased <- NA_real_ # early stopping or at end of study if (stageFisher < design$kMax || stage == design$kMax) { if (dataInput$getNumberOfGroups() == 1) { infRate <- sqrt(stageResults$overallSampleSizes[1]) stderr <- stageResults$overallStDevs[finalStage] / sqrt(stageResults$overallSampleSizes[finalStage]) } else { infRate <- 1 / sqrt(1 / stageResults$overallSampleSizes1[1] + 1 / stageResults$overallSampleSizes2[1]) stderr <- stageResults$overallStDevs[finalStage] * sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) } if (stageFisher == 1) { finalConfidenceInterval[1] <- stageResults$effectSizes[1] - .getOneMinusQNorm(design$alpha / design$sided) * stderr finalConfidenceInterval[2] <- stageResults$effectSizes[1] + .getOneMinusQNorm(design$alpha / design$sided) * stderr medianUnbiased <- stageResults$effectSizes[1] } else { maxSearchIterations <- 50 if (design$kMax >= 1) { message( "Calculation of final confidence interval for Fisher's ", "design not implemented yet" ) return(list( finalStage = NA_integer_, medianUnbiased = NA_real_, finalConfidenceInterval = rep(NA_real_, design$kMax) )) } thetaLow <- -1 .getQFunctionResult( design = design, stageResults = stageResults, theta = thetaLow, infRate = infRate ) iteration <- 0 while (iteration <= maxSearchIterations && .getQFunctionResultBasedOnDataInput( design = design, dataInput = dataInput, theta = thetaLow, stage = finalStage, infRate = infRate, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances ) > design$alpha / design$sided) { thetaLow <- 2 * thetaLow iteration <- iteration + 1 if (iteration == maxSearchIterations) { thetaLow <- -1 } } thetaUp <- 1 iteration <- 0 while (iteration <= maxSearchIterations && .getQFunctionResultBasedOnDataInput( design = design, dataInput = dataInput, theta = thetaUp, stage = finalStage, infRate = infRate, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances ) < 1 - design$alpha / design$sided) { thetaUp <- 2 * thetaUp iteration <- iteration + 1 if (iteration == maxSearchIterations) { thetaUp <- 1 } } finalConfidenceInterval[1] <- .getOneDimensionalRoot( function(theta) { return(.getQFunctionResultBasedOnDataInput( design = design, dataInput = dataInput, theta = theta, stage = finalStage, infRate = infRate, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances ) - design$alpha / design$sided) }, lower = thetaLow, upper = thetaUp, tolerance = tolerance, callingFunctionInformation = "Final confidence interval Fisher [1]" ) finalConfidenceInterval[2] <- .getOneDimensionalRoot( function(theta) { return(.getQFunctionResultBasedOnDataInput( design = design, dataInput = dataInput, theta = theta, stage = finalStage, infRate = infRate, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances ) - 1 + design$alpha / design$sided) }, lower = thetaLow, upper = thetaUp, tolerance = tolerance, callingFunctionInformation = "Final confidence interval Fisher [2]" ) medianUnbiased <- .getOneDimensionalRoot( function(theta) { return(.getQFunctionResultBasedOnDataInput( design = design, dataInput = dataInput, theta = theta, stage = finalStage, infRate = infRate, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances ) - 0.5) }, lower = thetaLow, upper = thetaUp, tolerance = tolerance, callingFunctionInformation = "Final confidence interval Fisher, median unbiased" ) } if (is.na(finalConfidenceInterval[1])) { finalStage <- NA_integer_ } } return(list( finalStage = finalStage, medianUnbiased = medianUnbiased, finalConfidenceInterval = finalConfidenceInterval )) } .getFinalConfidenceIntervalMeans <- function(..., design, dataInput, thetaH0 = NA_real_, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, equalVariances = C_EQUAL_VARIANCES_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .assertIsValidThetaH0DataInput(thetaH0, dataInput) .warnInCaseOfUnknownArguments( functionName = "getFinalConfidenceIntervalMeans", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) if (design$kMax == 1) { return(list( finalStage = NA_integer_, medianUnbiasedGeneral = NA_real_, finalConfidenceIntervalGeneral = c(NA_real_, NA_real_), medianUnbiased = NA_real_, finalConfidenceInterval = c(NA_real_) )) } if (is.na(thetaH0)) { thetaH0 <- C_THETA_H0_MEANS_DEFAULT } if (.isTrialDesignGroupSequential(design)) { return(.getFinalConfidenceIntervalMeansGroupSequential( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances, tolerance = tolerance )) } if (.isTrialDesignInverseNormal(design)) { return(.getFinalConfidenceIntervalMeansInverseNormal( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances, tolerance = tolerance )) } if (.isTrialDesignFisher(design)) { return(.getFinalConfidenceIntervalMeansFisher( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation, equalVariances = equalVariances, tolerance = tolerance )) } .stopWithWrongDesignMessage(design) } rpact/R/class_summary.R0000644000175000017500000045003414165526033014736 0ustar nileshnilesh## | ## | *Summary classes and functions* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5684 $ ## | Last changed: $Date: 2022-01-05 12:27:24 +0100 (Mi, 05 Jan 2022) $ ## | Last changed by: $Author: wassmer $ ## | SummaryItem <- setRefClass("SummaryItem", fields = list( title = "character", values = "character", legendEntry = "list" ), methods = list( initialize = function(title = NA_character_, values = NA_character_, ...) { callSuper(title = title, values = values, ...) if (!is.null(legendEntry) && length(legendEntry) > 0) { if (is.null(names(legendEntry))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("legendEntry"), " must be a named list") } for (l in legendEntry) { if (length(l) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("legendEntry"), " must be not empty") } } } }, show = function() { cat(title, "=", values, "\n") }, toList = function() { result <- list() result[[title]] <- values } ) ) #' #' @title #' Summary Factory Plotting #' #' @param x The summary factory object. #' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). #' @inheritParams param_three_dots_plot #' #' @description #' Plots a summary factory. #' #' @details #' Generic function to plot all kinds of summary factories. #' #' @template return_object_ggplot #' #' @export #' plot.SummaryFactory <- function(x, y, ...) { plot(x$object) } #' @name SummaryFactory #' #' @title #' Summary Factory #' #' @description #' Basic class for summaries #' #' @keywords internal #' #' @importFrom methods new #' SummaryFactory <- setRefClass("SummaryFactory", contains = "ParameterSet", fields = list( object = "ParameterSet", title = "character", header = "character", summaryItems = "list", intervalFormat = "character", justify = "character", output = "character" ), methods = list( initialize = function(..., intervalFormat = "[%s; %s]", output = "all") { callSuper(..., intervalFormat = intervalFormat, output = output) summaryItems <<- list() justify <<- getOption("rpact.summary.justify", "right") }, show = function(showType = 1, digits = NA_integer_) { .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { if (output %in% c("all", "title")) { if (is.null(title) || length(title) == 0) { title <<- .createSummaryTitleObject(object) } if (!is.null(title) && length(title) == 1 && trimws(title) != "") { .cat(title, "\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled ) } } if (output %in% c("all", "overview")) { if (is.null(header) || length(header) == 0) { header <<- .createSummaryHeaderObject(object, .self, digits) } if (!is.null(header) && length(header) == 1 && trimws(header) != "") { .cat(header, "\n\n", consoleOutputEnabled = consoleOutputEnabled ) } } if (!(output %in% c("all", "body"))) { return(invisible()) } legendEntries <- c() legendEntriesUnique <- c() summaryItemNames <- c() for (summaryItem in summaryItems) { if (!is.null(summaryItem$title) && length(summaryItem$title) == 1 && !is.na(summaryItem$title)) { summaryItemNames <- c(summaryItemNames, summaryItem$title) } if (length(summaryItem$legendEntry) > 0) { a <- sort(names(summaryItem$legendEntry)) for (aa in a) { if (!(aa %in% legendEntriesUnique)) { legendEntriesUnique <- c(legendEntriesUnique, aa) b <- summaryItem$legendEntry[[aa]] legendEntries <- c(legendEntries, paste0(" ", aa, ": ", b)) } } } } summaryItemNames <- paste0(format(summaryItemNames), " ") na <- ifelse(.isDataset(object), "NA", NA_character_) tableColumns <- 0 maxValueWidth <- 1 if (length(summaryItems) > 0) { for (i in 1:length(summaryItems)) { validValues <- na.omit(summaryItems[[i]]$values) if (length(validValues) > 0) { w <- max(nchar(validValues)) maxValueWidth <- max(maxValueWidth, w) tableColumns <- max(tableColumns, 1 + length(validValues)) } } spaceString <- paste0(rep(" ", maxValueWidth + 1), collapse = "") for (i in 1:length(summaryItems)) { itemTitle <- summaryItems[[i]]$title if (!is.null(itemTitle) && length(itemTitle) == 1 && !is.na(itemTitle)) { summaryItemName <- summaryItemNames[i] values <- summaryItems[[i]]$values values <- trimws(values) indices <- !grepl("(\\])$", values) values[indices] <- paste0(values[indices], " ") values <- format(c(spaceString, values), justify = justify)[2:(length(values) + 1)] .cat(summaryItemName, values, "\n", tableColumns = tableColumns, consoleOutputEnabled = consoleOutputEnabled, na = na ) if (!consoleOutputEnabled && trimws(summaryItemName) == "Stage") { .cat(rep("----- ", tableColumns), "\n", tableColumns = tableColumns, consoleOutputEnabled = consoleOutputEnabled, na = na ) } } } } if (length(legendEntries) > 0) { .cat("\n", consoleOutputEnabled = consoleOutputEnabled) .cat("Legend:\n", consoleOutputEnabled = consoleOutputEnabled) if (!consoleOutputEnabled) { .cat("\n", consoleOutputEnabled = consoleOutputEnabled) } for (legendEntry in legendEntries) { .cat(legendEntry, "\n", consoleOutputEnabled = consoleOutputEnabled) } .cat("\n", consoleOutputEnabled = consoleOutputEnabled) } }, addItem = function(title, values, legendEntry = list()) { if (!is.character(values)) { values <- as.character(values) } tryCatch( { addSummaryItem(SummaryItem(title = title, values = values, legendEntry = legendEntry)) }, error = function(e) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to add summary item '", title, "' = ", .arrayToString(values), " (class: ", class(values), "): ", e$message ) } ) }, addSummaryItem = function(summaryItem) { if (!inherits(summaryItem, "SummaryItem")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'summaryItem' must be an instance of class 'SummaryItem' (was '", class(summaryItem), "')" ) } summaryItems <<- c(summaryItems, summaryItem) }, .getFormattedParameterValue = function(valuesToShow, valuesToShow2) { naText <- getOption("rpact.summary.na", "") if (length(valuesToShow) == length(valuesToShow2) && !all(is.na(valuesToShow2))) { for (variantIndex in 1:length(valuesToShow)) { value1 <- as.character(valuesToShow[variantIndex]) value2 <- as.character(valuesToShow2[variantIndex]) if (grepl("^ *NA *$", value1)) { value1 <- naText } if (grepl("^ *NA *$", value2)) { value2 <- naText } if (trimws(value1) == "" && trimws(value2) == "") { valuesToShow[variantIndex] <- naText } else { valuesToShow[variantIndex] <- sprintf(intervalFormat, value1, value2) } } } else { valuesToShow[is.na(valuesToShow) | trimws(valuesToShow) == "NA"] <- naText } return(valuesToShow) }, addParameter = function(parameterSet, ..., parameterName = NULL, values = NULL, parameterCaption, roundDigits = NA_integer_, ceilingEnabled = FALSE, cumsumEnabled = FALSE, twoSided = FALSE, transpose = FALSE, smoothedZeroFormat = FALSE, parameterCaptionSingle = parameterCaption, legendEntry = list(), enforceFirstCase = FALSE, formatRepeatedPValues = FALSE) { if (!is.null(parameterName) && length(parameterName) == 1 && inherits(parameterSet, "ParameterSet") && parameterSet$.getParameterType(parameterName) == C_PARAM_NOT_APPLICABLE) { if (.getLogicalEnvironmentVariable("RPACT_DEVELOPMENT_MODE")) { warning( "Failed to add parameter ", .arrayToString(parameterName), " (", .arrayToString(values), ") stored in ", class(parameterSet), " because the parameter has type C_PARAM_NOT_APPLICABLE" ) } return(invisible()) } parameterName1 <- parameterName[1] if (!is.null(parameterName1) && is.character(parameterName1) && is.null(values)) { values <- parameterSet[[parameterName1]] if (is.null(values)) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, class(parameterSet), " does not contain a field '", parameterName1, "'" ) } } parameterName2 <- NA_character_ values2 <- NA_real_ if (!is.null(parameterName) && length(parameterName) > 1) { parameterName2 <- parameterName[2] values2 <- parameterSet[[parameterName2]] parameterName <- parameterName[1] if (is.null(values2)) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, class(parameterSet), " does not contain a field '", parameterName2, "'" ) } } if (is.null(values) && is.null(parameterName1)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'parameterName' or 'values' must be defined") } if (transpose) { if (!is.matrix(values)) { values <- as.matrix(values) } else { values <- t(values) } } if (is.list(parameterSet) && is.matrix(values)) { parameterSet <- parameterSet[["parameterSet"]] if (is.null(parameterSet)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'parameterSet' must be added to list") } } parameterNames <- "" numberOfVariants <- 1 numberOfStages <- ifelse(is.matrix(values), ncol(values), length(values)) if (inherits(parameterSet, "ParameterSet")) { parameterNames <- parameterSet$.getVisibleFieldNamesOrdered() numberOfVariants <- .getMultidimensionalNumberOfVariants(parameterSet, parameterNames) numberOfStages <- parameterSet$.getMultidimensionalNumberOfStages(parameterNames) } stages <- parameterSet[["stages"]] if (is.null(stages) && !is.null(parameterSet[[".stageResults"]])) { stages <- parameterSet[[".stageResults"]][["stages"]] } if (is.null(stages) && inherits(parameterSet, "ClosedCombinationTestResults")) { stages <- parameterSet[[".design"]][["stages"]] } if (!is.null(stages) && length(stages) > 0) { numberOfStages <- max(na.omit(stages)) if (is.matrix(values) && nrow(values) > 0) { numberOfVariants <- nrow(values) } if (is.matrix(values) && ncol(values) > 0) { numberOfStages <- ncol(values) } } if (!is.null(parameterSet[[".piecewiseSurvivalTime"]]) && isTRUE(parameterSet[[".piecewiseSurvivalTime"]]$delayedResponseEnabled)) { numberOfVariants <- 1 } if (twoSided) { values <- 2 * values } caseCondition <- list( and1 = enforceFirstCase, and2 = inherits(parameterSet, "Dataset"), and3 = list( or1 = list( and1 = !transpose, and2 = numberOfVariants == 1 ), or2 = list( and1 = !is.matrix(values), and2 = (!transpose && ncol(values) == 1), and3 = (transpose && nrow(values) == 1) ), or3 = list( and1 = .isTrialDesign(parameterSet), and2 = (numberOfStages > 1 && numberOfStages == length(values)), and3 = length(values) != numberOfVariants, and4 = length(values) == 1, and5 = parameterName %in% c( "futilityBoundsEffectScale", "futilityBoundsEffectScaleLower", "futilityBoundsEffectScaleUpper", "futilityPerStage" ) ) ) ) if (.isConditionTrue(caseCondition, "or", showDebugMessages = FALSE)) { valuesToShow <- .getSummaryValuesFormatted( parameterSet, parameterName1, values, roundDigits = roundDigits, ceilingEnabled = ceilingEnabled, cumsumEnabled = cumsumEnabled, smoothedZeroFormat = smoothedZeroFormat, formatRepeatedPValues = formatRepeatedPValues ) if (parameterName1 %in% c("piControl", "overallPiControl", "overallPooledStDevs")) { valuesToShow <- .getInnerValues(valuesToShow, transpose = TRUE) } else { valuesToShow <- .getInnerValues(valuesToShow, transpose = transpose) } valuesToShow2 <- NA_real_ if (!all(is.na(values2))) { valuesToShow2 <- .getSummaryValuesFormatted(parameterSet, parameterName1, values2, roundDigits = roundDigits, ceilingEnabled = ceilingEnabled, cumsumEnabled = cumsumEnabled, smoothedZeroFormat = smoothedZeroFormat, formatRepeatedPValues = formatRepeatedPValues ) valuesToShow2 <- .getInnerValues(valuesToShow2, transpose = transpose) } valuesToShow <- .getFormattedParameterValue(valuesToShow, valuesToShow2) addItem(parameterCaptionSingle, valuesToShow, legendEntry) } else { if (!inherits(parameterSet, "ParameterSet")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "for varied values 'parameterSet' must be an instance of ", "class 'ParameterSet' (was '", class(parameterSet), "')" ) } transposed <- !transpose && grepl("MultiArm|Enrichment", class(parameterSet)) && (!is.matrix(values) || ncol(values) > 1) userDefinedEffectMatrix <- FALSE if (grepl("MultiArm|Enrichment", class(parameterSet)) || inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ConditionalPowerResults")) { if (grepl("SimulationResults(MultiArm|Enrichment)", class(parameterSet)) && parameterName %in% c( "rejectAtLeastOne", "earlyStop", "futilityPerStage", "successPerStage", "expectedNumberOfSubjects", "expectedNumberOfEvents", "singleNumberOfEventsPerStage", "numberOfActiveArms", "numberOfPopulations", "conditionalPowerAchieved" )) { transposed <- TRUE userDefinedEffectMatrix <- parameterSet$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED if (userDefinedEffectMatrix) { legendEntry[["[j]"]] <- "effect matrix row j (situation to consider)" } if (grepl("Survival", class(parameterSet)) && !grepl("Enrichment", class(parameterSet))) { legendEntry[["(i)"]] <- "results of treatment arm i vs. control arm" } if (grepl("SimulationResultsEnrichment", class(parameterSet))) { variedParameterName <- .getSummaryVariedParameterNameEnrichment(parameterSet) variedParameterValues <- parameterSet$effectList[[variedParameterName]] if (variedParameterName == "piTreatments") { variedParameterCaption <- "pi(treatment)" } else { variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] if (is.matrix(variedParameterValues) && ncol(variedParameterValues) == 1) { variedParameterCaption <- sub("s$", "", variedParameterCaption) } } if (is.matrix(variedParameterValues)) { numberOfVariants <- nrow(variedParameterValues) } else { numberOfVariants <- length(variedParameterValues) } } else { variedParameterName <- .getSummaryVariedParameterSimulationMultiArm(parameterSet) variedParameterValues <- parameterSet[[variedParameterName]] variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] numberOfVariants <- length(variedParameterValues) } variedParameterCaption <- tolower(variedParameterCaption) } else if (.isEnrichmentObject(parameterSet)) { transposed <- TRUE variedParameterCaption <- "populations" if (parameterName1 %in% c( "indices", "conditionalErrorRate", "secondStagePValues", "adjustedStageWisePValues", "overallAdjustedTestStatistics", "rejectedIntersections" )) { if (.isEnrichmentAnalysisResults(parameterSet)) { variedParameterValues <- parameterSet$.closedTestResults$.getHypothesisPopulationVariants() } else { variedParameterValues <- parameterSet$.getHypothesisPopulationVariants() } } else { variedParameterValues <- c(paste0("S", 1:(numberOfVariants - 1)), "F") } numberOfVariants <- length(variedParameterValues) legendEntry[["S[i]"]] <- "population i" legendEntry[["F"]] <- "full population" } else if (!inherits(parameterSet, "ClosedCombinationTestResults") || parameterName %in% c("rejected", "separatePValues")) { if (inherits(parameterSet, "AnalysisResultsConditionalDunnett") && (!is.matrix(values) || ncol(values) > 1)) { transposed <- TRUE } if (inherits(parameterSet, "ClosedCombinationTestResults") && parameterSet$.getParameterType("adjustedStageWisePValues") != "g" && parameterName == "separatePValues") { transposed <- TRUE } if (inherits(parameterSet, "ClosedCombinationTestResults") && parameterName %in% c("rejected")) { transposed <- TRUE } if (inherits(parameterSet, "ConditionalPowerResults") && parameterName %in% c("conditionalPower", "values")) { transposed <- TRUE } variedParameterCaption <- "arm" variedParameterValues <- 1:numberOfVariants legendEntry[["(i)"]] <- "results of treatment arm i vs. control arm" } else { transposed <- TRUE variedParameterCaption <- "arms" variedParameterValues <- parameterSet$.getHypothesisTreatmentArmVariants() numberOfVariants <- length(variedParameterValues) legendEntry[["(i, j, ...)"]] <- "comparison of treatment arms 'i, j, ...' vs. control arm" } } else { if (inherits(parameterSet, "Dataset")) { variedParameter <- "groups" } else { variedParameter <- parameterSet$.getVariedParameter(parameterNames, numberOfVariants) } if (length(variedParameter) == 0 || variedParameter == "") { warning( "Failed to get varied parameter from ", class(parameterSet), " (", length(parameterNames), " parameter names; numberOfVariants: ", numberOfVariants, ")" ) return(invisible()) } variedParameterCaption <- parameterSet$.getDataFrameColumnCaption(variedParameter, tableColumnNames = C_TABLE_COLUMN_NAMES, niceColumnNamesEnabled = TRUE ) variedParameterCaption <- tolower(variedParameterCaption) if (variedParameterCaption == "alternative") { legendEntry[["alt."]] <- "alternative" variedParameterCaption <- "alt." } else if (variedParameterCaption == "hazard ratio") { legendEntry[["HR"]] <- "hazard ratio" variedParameterCaption <- "HR" } else if (grepl("\\(1\\)$", variedParameterCaption)) { groups <- parameterSet[["groups"]] if (!is.null(groups) && length(groups) == 1 && groups == 1) { variedParameterCaption <- sub(" \\(1\\)$", "", variedParameterCaption) } } variedParameterValues <- round(parameterSet[[variedParameter]], 3) } for (variantIndex in 1:numberOfVariants) { colValues <- .getColumnValues(parameterName, values, variantIndex, transposed) colValues <- .getSummaryValuesFormatted(parameterSet, parameterName1, colValues, roundDigits = roundDigits, ceilingEnabled = ceilingEnabled, cumsumEnabled = cumsumEnabled, smoothedZeroFormat = smoothedZeroFormat, formatRepeatedPValues = formatRepeatedPValues ) colValues2 <- NA_real_ if (!all(is.na(values2))) { colValues2 <- .getColumnValues(parameterName, values2, variantIndex, transposed) colValues2 <- .getSummaryValuesFormatted(parameterSet, parameterName2, colValues2, roundDigits = roundDigits, ceilingEnabled = ceilingEnabled, cumsumEnabled = cumsumEnabled, smoothedZeroFormat = smoothedZeroFormat, formatRepeatedPValues = formatRepeatedPValues ) } colValues <- .getFormattedParameterValue(valuesToShow = colValues, valuesToShow2 = colValues2) if (numberOfVariants == 1) { addItem(parameterCaption, colValues, legendEntry) } else if (.isEnrichmentObject(parameterSet)) { addItem(paste0( parameterCaption, " ", variedParameterValues[variantIndex] ), colValues, legendEntry) } else if ( (grepl("MultiArm|Enrichment", class(parameterSet)) && !grepl("Simulation", class(parameterSet))) || inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ConditionalPowerResults")) { spacePrefix <- ifelse(parameterCaption %in% c("pi", "lambda", "median"), "", " ") addItem(paste0( parameterCaption, spacePrefix, "(", variedParameterValues[variantIndex], ")" ), colValues, legendEntry) } else if (userDefinedEffectMatrix) { addItem(paste0(parameterCaption, " [", variantIndex, "]"), colValues, legendEntry) } else { if (is.matrix(variedParameterValues) && ncol(variedParameterValues) > 1) { variedParameterValuesFormatted <- .arrayToString(variedParameterValues[variantIndex, ], vectorLookAndFeelEnabled = TRUE) } else { variedParameterValuesFormatted <- variedParameterValues[variantIndex] } addItem( paste0( parameterCaption, ", ", variedParameterCaption, " = ", variedParameterValuesFormatted ), colValues, legendEntry ) } } } }, .isEnrichmentObject = function(parameterSet) { return( .isEnrichmentAnalysisResults(parameterSet) || .isEnrichmentStageResults(parameterSet) || .isEnrichmentConditionalPowerResults(parameterSet) || (inherits(parameterSet, "ClosedCombinationTestResults") && isTRUE(parameterSet$.enrichment)) ) }, .getInnerValues = function(values, transpose = FALSE) { if (!is.matrix(values)) { return(values) } if (nrow(values) == 1 && ncol(values) == 1) { return(values[1, 1]) } if (transpose) { return(values[1, ]) } return(values[, 1]) }, .getColumnValues = function(parameterName, values, variantIndex, transposed = FALSE) { tryCatch( { if (transposed) { if (!is.matrix(values)) { return(values) } if (nrow(values) == 0) { return("") } if (nrow(values) == 1 && ncol(values) == 1) { colValues <- values[1, 1] } else if (nrow(values) == 1) { colValues <- values[1, variantIndex] } else if (ncol(values) == 1) { colValues <- values[variantIndex, 1] } else { colValues <- values[variantIndex, ] } return(colValues) } if (length(values) <= 1 && !is.matrix(values)) { colValues <- values } else if (is.matrix(values)) { if (nrow(values) == 1 && ncol(values) == 1) { colValues <- values[1, 1] } else if (ncol(values) == 1) { colValues <- values[variantIndex, 1] } else if (nrow(values) == 1) { colValues <- values[1, variantIndex] } else { if (ncol(values) == 0) { return("") } colValues <- values[, variantIndex] } } else { colValues <- values[variantIndex] } return(colValues) }, error = function(e) { stop( ".getColumnValues(", dQuote(parameterName), "): ", e$message, "; class(values) = ", class(values), "; dim(values) = ", .arrayToString(dim(values), vectorLookAndFeelEnabled = TRUE), "; variantIndex = ", variantIndex, "; transposed = ", transposed ) } ) } ) ) .formatSummaryValues <- function(values, digits, smoothedZeroFormat = FALSE, formatRepeatedPValues = FALSE) { if (is.na(digits)) { digits <- 3 } if (digits < 1) { formattedValue <- as.character(values) formattedValue[is.na(formattedValue) | trimws(formattedValue) == "NA"] <- getOption("rpact.summary.na", "") return(formattedValue) } if (sum(is.na(values)) == length(values)) { formattedValue <- rep(getOption("rpact.summary.na", ""), length(values)) return(formattedValue) } threshold <- 10^-digits text <- "<0." if (digits > 1) { for (i in 1:(digits - 1)) { text <- paste0(text, "0") } } text <- paste0(text, "1") if (smoothedZeroFormat) { values[abs(values) < 1e-15] <- 0 } indices <- (!is.na(values) & values > 1e-10 & abs(values) < threshold) values[!is.na(values) & !indices] <- round(values[!is.na(values) & !indices], digits) if (sum(indices) > 0) { values[indices] <- threshold formattedValue <- .getFormattedValue(values, digits = digits, nsmall = digits, scientific = FALSE) formattedValue[indices] <- text } else { formattedValue <- .getFormattedValue(values, digits = digits, nsmall = digits, scientific = FALSE) formattedValue <- format(formattedValue, scientific = FALSE) } if (formatRepeatedPValues) { formattedValue[!is.na(formattedValue) & nchar(gsub("\\D", "", (formattedValue))) > 0 & formattedValue > 0.4999] <- ">0.5" } if (as.logical(getOption("rpact.summary.trim.zeroes", TRUE))) { zeroes <- grepl("^0\\.0*$", formattedValue) if (sum(zeroes) > 0) { formattedValue[zeroes] <- "0" } } formattedValue[is.na(formattedValue) | trimws(formattedValue) == "NA"] <- getOption("rpact.summary.na", "") return(formattedValue) } .getSummaryValuesFormatted <- function(fieldSet, parameterName, values, roundDigits = NA_integer_, ceilingEnabled = FALSE, cumsumEnabled = FALSE, smoothedZeroFormat = FALSE, formatRepeatedPValues = FALSE) { if (!is.numeric(values)) { return(values) } if (cumsumEnabled) { values <- cumsum(values) } if (ceilingEnabled) { values <- ceiling(values) } else { tryCatch( { if (!is.null(parameterName) && length(parameterName) == 1 && !is.na(parameterName) && parameterName %in% c("criticalValues", "overallAdjustedTestStatistics")) { design <- fieldSet if (!.isTrialDesign(design)) { design <- fieldSet[[".design"]] } if (!is.null(design) && .isTrialDesignFisher(design)) { roundDigits <- 0 } } formatFunctionName <- NULL if (!is.null(parameterName) && length(parameterName) == 1 && !is.na(parameterName) && !is.na(roundDigits) && roundDigits == 0) { if (inherits(fieldSet, "Dataset") && grepl("samplesize|event", tolower(parameterName))) { } else { if (inherits(fieldSet, "FieldSet")) { formatFunctionName <- fieldSet$.parameterFormatFunctions[[parameterName]] } if (is.null(formatFunctionName)) { formatFunctionName <- C_PARAMETER_FORMAT_FUNCTIONS[[parameterName]] } } } if (!is.null(formatFunctionName)) { values <- eval(call(formatFunctionName, values)) } else { values <- .formatSummaryValues(values, digits = roundDigits, smoothedZeroFormat = smoothedZeroFormat, formatRepeatedPValues = formatRepeatedPValues ) } }, error = function(e) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to show parameter '", parameterName, "': ", e$message) } ) } return(format(values)) } .createSummaryTitleObject <- function(object) { design <- NULL designPlan <- NULL if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { design <- object$.design designPlan <- object } else if (inherits(object, "AnalysisResults")) { return(.createSummaryTitleAnalysisResults(object$.design, object)) } else if (.isTrialDesign(object)) { design <- object } if (!is.null(design)) { return(.createSummaryTitleDesign(design, designPlan)) } return("") } .createSummaryTitleAnalysisResults <- function(design, analysisResults) { kMax <- design$kMax title <- "" if (kMax == 1) { title <- paste0(title, "Fixed sample analysis results") } else { title <- paste0(title, "Sequential analysis results with a maximum of ", kMax, " looks") } if (!is.null(analysisResults)) { if (.isMultiArmAnalysisResults(analysisResults)) { title <- "Multi-arm analysis results for a " } else if (.isEnrichmentAnalysisResults(analysisResults)) { title <- "Enrichment analysis results for a " } else { title <- "Analysis results for a " } if (grepl("Means", class(analysisResults$.dataInput))) { title <- paste0(title, "continuous endpoint") } else if (grepl("Rates", class(analysisResults$.dataInput))) { title <- paste0(title, "binary endpoint") } else if (grepl("Survival", class(analysisResults$.dataInput))) { title <- paste0(title, "survival endpoint") } if (.isMultiHypothesesAnalysisResults(analysisResults)) { gMax <- analysisResults$.stageResults$getGMax() if (.isMultiArmAnalysisResults(analysisResults)) { title <- paste0(title, " (", gMax, " active arms vs. control)") } else if (.isEnrichmentAnalysisResults(analysisResults)) { title <- paste0(title, " (", gMax, " populations)") } } } else if (kMax > 1) { title <- .concatenateSummaryText(title, paste0("(", design$.toString(startWithUpperCase = FALSE), ")"), sep = " " ) } return(title) } .createSummaryTitleDesign <- function(design, designPlan) { kMax <- design$kMax title <- "" if (kMax == 1) { title <- paste0(title, "Fixed sample analysis") } else { title <- paste0(title, "Sequential analysis with a maximum of ", kMax, " looks") } if (!is.null(designPlan)) { if (inherits(designPlan, "SimulationResults")) { title <- "Simulation of a " } else if (designPlan$.isSampleSizeObject()) { title <- "Sample size calculation for a " } else if (designPlan$.isPowerObject()) { title <- "Power calculation for a " } if (grepl("Means", class(designPlan))) { title <- paste0(title, "continuous endpoint") } else if (grepl("Rates", class(designPlan))) { title <- paste0(title, "binary endpoint") } else if (grepl("Survival", class(designPlan))) { title <- paste0(title, "survival endpoint") } if (grepl("MultiArm", class(designPlan)) && !is.null(designPlan[["activeArms"]]) && designPlan$activeArms > 1) { title <- .concatenateSummaryText(title, "(multi-arm design)", sep = " ") } else if (grepl("Enrichment", class(designPlan))) { title <- .concatenateSummaryText(title, "(enrichment design)", sep = " ") } } else if (kMax > 1) { title <- .concatenateSummaryText(title, paste0("(", design$.toString(startWithUpperCase = FALSE), ")"), sep = " " ) } return(title) } .isRatioComparisonEnabled <- function(object) { if (!is.null(object[["meanRatio"]]) && isTRUE(object[["meanRatio"]])) { return(TRUE) } if (!is.null(object[["riskRatio"]]) && isTRUE(object[["riskRatio"]])) { return(TRUE) } return(FALSE) } .getSummaryObjectSettings <- function(object) { multiArmEnabled <- grepl("MultiArm", class(object)) enrichmentEnabled <- grepl("Enrichment", class(object)) simulationEnabled <- grepl("Simulation", class(object)) ratioEnabled <- FALSE populations <- NA_integer_ if (inherits(object, "AnalysisResults") || inherits(object, "StageResults")) { groups <- object$.dataInput$getNumberOfGroups() meansEnabled <- grepl("Means", class(object$.dataInput)) ratesEnabled <- grepl("Rates", class(object$.dataInput)) survivalEnabled <- grepl("Survival", class(object$.dataInput)) } else { meansEnabled <- grepl("Means", class(object)) ratesEnabled <- grepl("Rates", class(object)) survivalEnabled <- grepl("Survival", class(object)) if (simulationEnabled && multiArmEnabled) { groups <- object$activeArms } else if (simulationEnabled && enrichmentEnabled) { groups <- 2 populations <- object$populations } else { # for analysis multi-arm / enrichment always 2 groups are applicable groups <- ifelse(multiArmEnabled || enrichmentEnabled || survivalEnabled, 2, object[["groups"]]) } ratioEnabled <- .isRatioComparisonEnabled(object) } return(list( meansEnabled = meansEnabled, ratesEnabled = ratesEnabled, survivalEnabled = survivalEnabled, groups = groups, populations = populations, multiArmEnabled = multiArmEnabled, enrichmentEnabled = enrichmentEnabled, simulationEnabled = simulationEnabled, ratioEnabled = ratioEnabled )) } .createSummaryHypothesisText <- function(object, summaryFactory) { if (!inherits(object, "AnalysisResults") && !inherits(object, "TrialDesignPlan") && !inherits(object, "SimulationResults")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'object' must be an instance of class 'AnalysisResults', 'TrialDesignPlan' ", "or 'SimulationResults' (is '", class(object), "')" ) } design <- object[[".design"]] if (is.null(design)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.design' must be defined in specified ", class(object)) } settings <- .getSummaryObjectSettings(object) sided <- ifelse(settings$multiArmEnabled || settings$enrichmentEnabled, 1, design$sided) directionUpper <- object[["directionUpper"]] comparsionH0 <- " = " comparsionH1 <- NA_character_ if (inherits(object, "AnalysisResults") && !is.null(directionUpper)) { comparsionH1 <- ifelse(sided == 2, " != ", ifelse(directionUpper, " > ", " < ")) } if (!is.null(object[["thetaH0"]])) { thetaH0 <- round(object$thetaH0, 3) } else { thetaH0 <- ifelse(settings$survivalEnabled, 1, 0) } treatmentArmIndex <- ifelse(settings$groups > 1, "(i)", "(treatment)") controlArmIndex <- ifelse(settings$groups > 1, "(i)", "(control)") if (settings$multiArmEnabled || settings$enrichmentEnabled) { if (settings$survivalEnabled) { treatmentArmIndex <- "(i)" controlArmIndex <- "" } else if (settings$groups == 1) { treatmentArmIndex <- "(treatment)" controlArmIndex <- "(control)" } else { if (settings$enrichmentEnabled) { treatmentArmIndex <- "(treatment)" } else { treatmentArmIndex <- "(i)" } controlArmIndex <- "(control)" } } else { if (settings$groups == 1 || settings$survivalEnabled) { treatmentArmIndex <- "" controlArmIndex <- "" } else { treatmentArmIndex <- "(1)" controlArmIndex <- "(2)" } } value <- "?" if (settings$meansEnabled) { value <- "mu" } else if (settings$ratesEnabled) { value <- "pi" } else if (settings$survivalEnabled) { value <- "hazard ratio" } calcSep <- ifelse(settings$ratioEnabled, " / ", " - ") hypothesis <- "" if (!settings$survivalEnabled && (settings$multiArmEnabled || settings$enrichmentEnabled || settings$groups == 2)) { hypothesis <- paste0( hypothesis, "H0: ", value, treatmentArmIndex, calcSep, value, controlArmIndex, comparsionH0, thetaH0 ) if (!is.na(comparsionH1)) { hypothesis <- paste0(hypothesis, " against ") hypothesis <- paste0( hypothesis, "H1: ", value, treatmentArmIndex, calcSep, value, controlArmIndex, comparsionH1, thetaH0 ) } } else { hypothesis <- paste0(hypothesis, "H0: ", value, treatmentArmIndex, comparsionH0, thetaH0) if (!is.na(comparsionH1)) { hypothesis <- paste0(hypothesis, " against ") hypothesis <- paste0(hypothesis, "H1: ", value, treatmentArmIndex, comparsionH1, thetaH0) } } hypothesis <- .concatenateSummaryText( hypothesis, .createSummaryHypothesisPowerDirectionText(object, sided, directionUpper) ) return(hypothesis) } .createSummaryHypothesisPowerDirectionText <- function(object, sided, directionUpper) { if (sided == 2 || is.null(directionUpper)) { return("") } directionUpper <- unique(directionUpper) if (length(directionUpper) != 1) { return("") } if (inherits(object, "AnalysisResults")) { return("") } if (.isTrialDesignPlan(object) && object$.objectType != "power") { return("") } if (directionUpper) { return("power directed towards larger values") } else { return("power directed towards smaller values") } } .addSummaryLineBreak <- function(text, newLineLength) { maxLineLength <- as.integer(getOption("rpact.summary.width", 83)) lines <- strsplit(text, "\n", fixed = TRUE)[[1]] lastLine <- lines[length(lines)] if (nchar(lastLine) + newLineLength > maxLineLength) { text <- paste0(text, "\n") } return(text) } .concatenateSummaryText <- function(a, b, sep = ", ") { .assertIsSingleCharacter(a, "a") .assertIsSingleCharacter(b, "b") if (is.na(b) || nchar(trimws(b)) == 0) { return(a) } if (a == "") { return(b) } a <- paste0(a, sep) a <- .addSummaryLineBreak(a, nchar(b)) return(paste0(a, b)) } .createSummaryHeaderObject <- function(object, summaryFactory, digits = NA_integer_) { if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { return(.createSummaryHeaderDesign(object$.design, object, summaryFactory)) } if (inherits(object, "AnalysisResults")) { return(.createSummaryHeaderAnalysisResults(object$.design, object, summaryFactory, digits)) } if (.isTrialDesign(object)) { return(.createSummaryHeaderDesign(object, NULL, summaryFactory)) } return("") } .addAllocationRatioToHeader <- function(parameterSet, header, sep = ", ") { if (!.isTrialDesignPlanSurvival(parameterSet) && !grepl("Simulation", class(parameterSet))) { numberOfGroups <- 1 if (inherits(parameterSet, "TrialDesignPlan")) { numberOfGroups <- parameterSet$groups } else if (inherits(parameterSet, "AnalysisResults")) { numberOfGroups <- parameterSet$.dataInput$getNumberOfGroups() } if (numberOfGroups == 1) { return(header) } } prefix <- "" if (!is.null(parameterSet[["optimumAllocationRatio"]]) && length(parameterSet$optimumAllocationRatio) == 1 && parameterSet$optimumAllocationRatio) { if (length(unique(parameterSet$allocationRatioPlanned)) > 1) { return(.concatenateSummaryText(header, "optimum planned allocation ratio", sep = sep)) } prefix <- "optimum " } allocationRatioPlanned <- round(unique(parameterSet$allocationRatioPlanned), 3) if (identical(allocationRatioPlanned, 1) && prefix == "") { return(header) } if (!is.na(allocationRatioPlanned)) { return(.concatenateSummaryText(header, paste0(prefix, "planned allocation ratio = ", allocationRatioPlanned), sep = sep )) } else { return(header) } } .createSummaryHeaderAnalysisResults <- function(design, analysisResults, summaryFactory, digits) { digitSettings <- .getSummaryDigits(digits) digitsGeneral <- digitSettings$digitsGeneral stageResults <- analysisResults$.stageResults dataInput <- analysisResults$.dataInput multiArmEnabled <- .isMultiArmAnalysisResults(analysisResults) enrichmentEnabled <- .isEnrichmentAnalysisResults(analysisResults) multiHypothesesEnabled <- .isMultiHypothesesAnalysisResults(analysisResults) header <- "" if (design$kMax == 1) { header <- paste0(header, "Fixed sample analysis.") } else { header <- paste0(header, "Sequential analysis with ", design$kMax, " looks") header <- .concatenateSummaryText(header, paste0("(", design$.toString(startWithUpperCase = FALSE), ")."), sep = " " ) } header <- paste0(header, "\n") header <- paste0(header, "The results were calculated using a ") if (stageResults$isDatasetMeans()) { if (dataInput$getNumberOfGroups() == 1) { header <- paste0(header, "one-sample t-test") } else if (dataInput$getNumberOfGroups() == 2) { header <- paste0(header, "two-sample t-test") } else { header <- paste0(header, "multi-arm t-test") } } else if (stageResults$isDatasetRates()) { if (dataInput$getNumberOfGroups() == 1) { header <- paste0(header, "one-sample test for rates") } else if (dataInput$getNumberOfGroups() == 2) { header <- paste0(header, "two-sample test for rates") } else { header <- paste0(header, "multi-arm test for rates") } } else if (stageResults$isDatasetSurvival()) { if (dataInput$getNumberOfGroups() == 2) { header <- paste0(header, "two-sample logrank test") } else { header <- paste0(header, "multi-arm logrank test") } } if (design$sided == 1) { header <- paste0(header, " (one-sided)") } else { header <- paste0(header, " (two-sided)") } if (!.isTrialDesignConditionalDunnett(design) && multiHypothesesEnabled) { if (stageResults$intersectionTest == "Dunnett") { header <- .concatenateSummaryText(header, "Dunnett intersection test") } else if (stageResults$intersectionTest == "Bonferroni") { header <- .concatenateSummaryText(header, "Bonferroni intersection test") } else if (stageResults$intersectionTest == "Simes") { header <- .concatenateSummaryText(header, "Simes intersection test") } else if (stageResults$intersectionTest == "Sidak") { header <- .concatenateSummaryText(header, "Sidak intersection test") } else if (stageResults$intersectionTest == "Hierarchical") { header <- .concatenateSummaryText(header, "Hierarchical intersection test") } else if (stageResults$intersectionTest == "SpiessensDebois") { header <- .concatenateSummaryText(header, "Spiessens and Debois intersection test") } } if (!is.null(stageResults[["normalApproximation"]]) && stageResults$normalApproximation) { header <- .concatenateSummaryText(header, "normal approximation test") } else if (stageResults$isDatasetRates()) { if (dataInput$getNumberOfGroups() == 1) { header <- .concatenateSummaryText(header, "exact test") } else { header <- .concatenateSummaryText(header, "exact test of Fisher") } } else { # header <- .concatenateSummaryText(header, "exact t test") } if (stageResults$isDatasetMeans() && multiHypothesesEnabled) { if (stageResults$varianceOption == "overallPooled") { header <- .concatenateSummaryText(header, "overall pooled variances option") } else if (stageResults$varianceOption == "pairwisePooled") { header <- .concatenateSummaryText(header, "pairwise pooled variances option") } else if (stageResults$varianceOption == "pooledFromFull") { header <- .concatenateSummaryText(header, "pooled from full population variances option") } else if (stageResults$varianceOption == "pooled") { header <- .concatenateSummaryText(header, "pooled variances option") } else if (stageResults$varianceOption == "notPooled") { header <- .concatenateSummaryText(header, "not pooled variances option") } } if (inherits(stageResults, "StageResultsMeans") && (dataInput$getNumberOfGroups() == 2)) { if (stageResults$equalVariances) { header <- .concatenateSummaryText(header, "equal variances option") } else { header <- .concatenateSummaryText(header, "unequal variances option") } } if (.isTrialDesignConditionalDunnett(design)) { if (design$secondStageConditioning) { header <- .concatenateSummaryText(header, "conditional second stage p-values") } else { header <- .concatenateSummaryText(header, "unconditional second stage p-values") } } if (enrichmentEnabled) { header <- .concatenateSummaryText(header, paste0( ifelse(analysisResults$stratifiedAnalysis, "", "non-"), "stratified analysis" )) } header <- paste0(header, ".\n", .createSummaryHypothesisText(analysisResults, summaryFactory)) if (stageResults$isDatasetMeans()) { header <- .getSummaryHeaderEntryAnalysisResults(header, analysisResults, paramName1 = "thetaH1", paramName2 = ifelse(multiHypothesesEnabled, "assumedStDevs", "assumedStDev"), paramCaption1 = "assumed effect", paramCaption2 = "assumed standard deviation", shortcut1 = "thetaH1", shortcut2 = "sd", digits1 = digitsGeneral, digits2 = digitsGeneral ) } else if (stageResults$isDatasetRates()) { header <- .getSummaryHeaderEntryAnalysisResults(header, analysisResults, paramName1 = ifelse(enrichmentEnabled, "piTreatments", ifelse(multiArmEnabled, "piTreatments", "pi1")), paramName2 = ifelse(enrichmentEnabled, "piControls", ifelse(multiArmEnabled, "piControl", "pi2")), paramCaption1 = "assumed treatment rate", paramCaption2 = "assumed control rate", shortcut1 = "pi", shortcut2 = "pi" ) } else if (stageResults$isDatasetSurvival()) { header <- .getSummaryHeaderEntryAnalysisResults(header, analysisResults, paramName1 = "thetaH1", paramCaption1 = "assumed effect", shortcut1 = "thetaH1", digits1 = digitsGeneral ) } header <- paste0(header, ".") return(header) } .getSummaryHeaderEntryValueAnalysisResults <- function(shortcut, value, analysisResults) { if (is.matrix(value)) { stage <- analysisResults$.stageResults$stage if (stage <= ncol(value)) { value <- value[, stage] } } value[!is.na(value)] <- round(value[!is.na(value)], 2) if ((is.matrix(value) && nrow(value) > 1) || length(value) > 1) { treatmentNames <- 1:length(value) if (.isEnrichmentAnalysisResults(analysisResults)) { populations <- paste0("S", treatmentNames) gMax <- analysisResults$.stageResults$getGMax() populations[treatmentNames == gMax] <- "F" treatmentNames <- populations } value <- paste0(paste(paste0(shortcut, "(", treatmentNames, ") = ", value)), collapse = ", ") } return(value) } .getSummaryHeaderEntryAnalysisResults <- function(header, analysisResults, ..., paramName1, paramName2 = NA_character_, paramCaption1, paramCaption2 = NA_character_, shortcut1, shortcut2 = NA_character_, digits1 = 2, digits2 = 2) { if (analysisResults$.design$kMax == 1) { return(header) } if (length(analysisResults$nPlanned) == 0 || all(is.na(analysisResults$nPlanned))) { return(header) } paramValue1 <- analysisResults[[paramName1]] case1 <- analysisResults$.getParameterType(paramName1) != C_PARAM_NOT_APPLICABLE && !all(is.na(paramValue1)) if (!is.na(paramCaption1) && analysisResults$.getParameterType(paramName1) == C_PARAM_GENERATED) { paramCaption1 <- sub("assumed ", "overall ", paramCaption1) } case2 <- FALSE if (!is.na(paramName2)) { paramValue2 <- analysisResults[[paramName2]] case2 <- analysisResults$.getParameterType(paramName2) != C_PARAM_NOT_APPLICABLE && !all(is.na(paramValue2)) if (!is.na(paramCaption2) && analysisResults$.getParameterType(paramName2) == C_PARAM_GENERATED) { paramCaption2 <- sub("assumed ", "overall ", paramCaption2) } } if (!case1 && !case2) { return(header) } header <- .concatenateSummaryText(header, "Conditional power calculation with planned sample size is based on", sep = ". ") header <- .addAllocationRatioToHeader(analysisResults, header, sep = " ") sepPrefix <- ifelse(length(analysisResults$allocationRatioPlanned) == 0 || identical(unique(analysisResults$allocationRatioPlanned), 1), "", ",") if (case1) { if (!any(is.na(paramValue1)) && length(unique(paramValue1)) == 1) { paramValue1 <- paramValue1[1] } if (length(paramValue1) == 1) { header <- .concatenateSummaryText(header, paste0(paramCaption1, " = ", ifelse(is.na(paramValue1), paramValue1, round(paramValue1, digits1))), sep = paste0(sepPrefix, " ") ) } else { header <- .concatenateSummaryText(header, paste0(paramCaption1, ": ", .getSummaryHeaderEntryValueAnalysisResults( shortcut1, paramValue1, analysisResults )), sep = paste0(sepPrefix, " ") ) } } if (case2) { if (length(paramValue2) == 1) { header <- .concatenateSummaryText(header, paste0(paramCaption2, " = ", ifelse(is.na(paramValue2), paramValue2, round(paramValue2, digits2))), sep = ifelse(case1, paste0(sepPrefix, " and "), " ") ) } else { header <- .concatenateSummaryText(header, paste0(paramCaption2, ": ", .getSummaryHeaderEntryValueAnalysisResults( shortcut2, paramValue2, analysisResults )), sep = ifelse(case1, paste0(sepPrefix, " and "), " ") ) } } return(header) } .addEnrichmentEffectListToHeader <- function(header, designPlan) { if (!grepl("SimulationResultsEnrichment", class(designPlan))) { return(header) } subGroups <- designPlan$effectList$subGroups header <- .concatenateSummaryText(header, paste0( "subgroup", ifelse(length(subGroups) != 1, "s", ""), " = ", .arrayToString(subGroups, vectorLookAndFeelEnabled = TRUE) )) prevalences <- designPlan$effectList$prevalences header <- .concatenateSummaryText(header, paste0( "prevalence", ifelse(length(prevalences) != 1, "s", ""), " = ", .arrayToString(round(prevalences, 3), vectorLookAndFeelEnabled = TRUE) )) return(header) } .createSummaryHeaderDesign <- function(design, designPlan, summaryFactory) { if (is.null(designPlan)) { if (.isTrialDesignFisher(design)) { designType <- "Fisher's combination test" } else if (.isTrialDesignConditionalDunnett(design)) { designType <- "Conditional Dunnett test" } else { designType <- C_TYPE_OF_DESIGN_LIST[[design$typeOfDesign]] } header <- .firstCharacterToUpperCase(designType) header <- paste0(header, " design") if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT) { header <- .concatenateSummaryText(header, paste0("(deltaWT = ", round(design$deltaWT, 3), ")"), sep = " " ) } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT_OPTIMUM) { header <- .concatenateSummaryText(header, paste0("(", design$optimizationCriterion, ")"), sep = " " ) } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { header <- .concatenateSummaryText(header, paste0("(deltaPT1 = ", round(design$deltaPT1, 3), ""), sep = " " ) header <- .concatenateSummaryText(header, paste0("deltaPT0 = ", round(design$deltaPT0, 3), ")"), sep = ", " ) } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_HP) { header <- .concatenateSummaryText(header, paste0("(constant bounds = ", round(design$constantBoundsHP, 3), ")"), sep = " " ) } else if (design$typeOfDesign %in% c(C_TYPE_OF_DESIGN_AS_KD, C_TYPE_OF_DESIGN_AS_HSD)) { header <- .concatenateSummaryText(header, paste0("(gammaA = ", round(design$gammaA, 3), ")"), sep = " " ) } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_AS_USER) { header <- .concatenateSummaryText(header, paste0("(", .arrayToString(round(design$userAlphaSpending, 3)), ")"), sep = " " ) } if (grepl("^as", design$typeOfDesign) && design$typeBetaSpending != C_TYPE_OF_DESIGN_BS_NONE) { typeBetaSpending <- C_TYPE_OF_DESIGN_BS_LIST[[design$typeBetaSpending]] header <- .concatenateSummaryText(header, typeBetaSpending, sep = " and ") if (design$typeBetaSpending %in% c(C_TYPE_OF_DESIGN_BS_KD, C_TYPE_OF_DESIGN_BS_HSD)) { header <- .concatenateSummaryText(header, paste0("(gammaB = ", round(design$gammaB, 3), ")"), sep = " " ) } else if (design$typeBetaSpending == C_TYPE_OF_DESIGN_BS_USER) { header <- .concatenateSummaryText(header, paste0("(", .arrayToString(round(design$userBetaSpending, 3)), ")"), sep = " " ) } } } if ((.isTrialDesignInverseNormalOrGroupSequential(design) && any(design$futilityBounds > -6)) || (.isTrialDesignFisher(design) && any(design$alpha0Vec < 1))) { header <- .concatenateSummaryText( header, paste0(ifelse(design$bindingFutility, "binding", "non-binding"), " futility") ) } header <- .concatenateSummaryText(header, paste0( ifelse(design$sided == 1, "one-sided", "two-sided"), ifelse(design$kMax == 1, "", " overall") )) header <- .concatenateSummaryText(header, paste0("significance level ", round(100 * design$alpha, 2), "%"), sep = " " ) if (.isTrialDesignInverseNormalOrGroupSequential(design)) { header <- .concatenateSummaryText(header, paste0("power ", round(100 * (1 - design$beta), 1), "%")) } header <- .concatenateSummaryText(header, "undefined endpoint") header <- paste0(header, ".") return(header) } header <- "" if (design$kMax == 1) { header <- paste0(header, "Fixed sample analysis,") } else { header <- paste0(header, "Sequential analysis with a maximum of ", design$kMax, " looks") header <- .concatenateSummaryText(header, paste0("(", design$.toString(startWithUpperCase = FALSE), ")"), sep = " " ) } header <- .concatenateSummaryText(header, ifelse(design$kMax == 1, "", "overall")) header <- .concatenateSummaryText(header, paste0("significance level ", round(100 * design$alpha, 2), "%"), sep = " " ) header <- .concatenateSummaryText(header, ifelse(design$sided == 1, "(one-sided).", "(two-sided)."), sep = " ") header <- paste0(header, "\n") header <- paste0(header, "The ", ifelse(inherits(designPlan, "SimulationResults") || designPlan$.isPowerObject(), "results were ", "sample size was ")) header <- paste0(header, ifelse(inherits(designPlan, "SimulationResults"), "simulated", "calculated")) header <- paste0(header, " for a ") settings <- .getSummaryObjectSettings(designPlan) if (settings$meansEnabled) { if (settings$multiArmEnabled && settings$groups > 1) { header <- .concatenateSummaryText(header, "multi-arm comparisons for means", sep = "") } else if (settings$enrichmentEnabled && settings$groups > 1) { header <- .concatenateSummaryText(header, "population enrichment comparisons for means", sep = "") } else if (settings$groups == 1 && !settings$multiArmEnabled) { header <- .concatenateSummaryText(header, "one-sample t-test", sep = "") } else if (settings$groups == 2 || settings$multiArmEnabled) { header <- .concatenateSummaryText(header, "two-sample t-test", sep = "") } } else if (settings$ratesEnabled) { if (settings$multiArmEnabled && settings$groups > 1) { header <- .concatenateSummaryText(header, "multi-arm comparisons for rates", sep = "") } else if (settings$enrichmentEnabled && settings$groups > 1) { header <- .concatenateSummaryText(header, "population enrichment comparisons for rates", sep = "") } else if (settings$groups == 1 && !settings$multiArmEnabled) { header <- .concatenateSummaryText(header, "one-sample test for rates", sep = "") } else if (settings$groups == 2 || settings$multiArmEnabled) { header <- .concatenateSummaryText(header, "two-sample test for rates", sep = "") } } else if (settings$survivalEnabled) { if (settings$multiArmEnabled && settings$groups > 1) { header <- .concatenateSummaryText(header, "multi-arm logrank test", sep = "") } else if (settings$enrichmentEnabled && settings$groups > 1) { header <- .concatenateSummaryText(header, "population enrichment logrank test", sep = "") } else if (settings$groups == 2 || settings$multiArmEnabled) { header <- .concatenateSummaryText(header, "two-sample logrank test", sep = "") } } part <- "" if (settings$multiArmEnabled && settings$groups > 1) { part <- .concatenateSummaryText(part, paste0(settings$groups, " treatments vs. control")) } else if (settings$enrichmentEnabled) { if (settings$groups == 2) { part <- .concatenateSummaryText(part, "treatment vs. control") } else if (settings$groups > 2) { part <- .concatenateSummaryText(part, paste0(settings$groups, " treatments vs. control")) } part <- .concatenateSummaryText(part, paste0( settings$populations, " population", ifelse(settings$populations == 1, "", "s") )) } if (!is.null(designPlan) && (.isTrialDesignPlan(designPlan) || inherits(designPlan, "SimulationResults")) && !settings$multiArmEnabled && !settings$enrichmentEnabled && !settings$survivalEnabled) { if (settings$ratesEnabled) { if (settings$groups == 1) { part <- .concatenateSummaryText(part, ifelse(designPlan$normalApproximation, "normal approximation", "exact test" )) } else { part <- .concatenateSummaryText(part, ifelse(designPlan$normalApproximation, "normal approximation", "exact test of Fisher" )) } } else if (designPlan$normalApproximation) { part <- .concatenateSummaryText(part, "normal approximation") } } if (part != "") { header <- .concatenateSummaryText(header, paste0("(", part, ")"), sep = " ") } if (settings$meansEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || inherits(designPlan, "SimulationResults"))) { header <- .concatenateSummaryText(header, .createSummaryHypothesisText(designPlan, summaryFactory)) if (!is.null(designPlan[["alternative"]]) && length(designPlan$alternative) == 1) { alternativeText <- paste0("H1: effect = ", round(designPlan$alternative, 3)) } else if (!is.null(designPlan[["muMaxVector"]]) && length(designPlan$muMaxVector) == 1) { alternativeText <- paste0("H1: mu_max = ", round(designPlan$muMaxVector, 3)) } else { alternativeText <- "H1: effect as specified" } header <- .concatenateSummaryText(header, alternativeText) header <- .addEnrichmentEffectListToHeader(header, designPlan) if (grepl("SimulationResultsEnrichment", class(designPlan))) { stDevs <- designPlan$effectList$stDevs if (length(unique(stDevs)) == 1) { stDevs <- unique(stDevs) } s <- ifelse(length(stDevs) != 1, "s", "") stDevCaption <- ifelse(.isRatioComparisonEnabled(designPlan), paste0("coefficient", s, " of variation"), paste0("standard deviation", s) ) header <- .concatenateSummaryText(header, paste0( stDevCaption, " = ", .arrayToString(round(stDevs, 3), vectorLookAndFeelEnabled = TRUE) )) } else { stDevCaption <- ifelse(.isRatioComparisonEnabled(designPlan), "coefficient of variation", "standard deviation") header <- .concatenateSummaryText(header, paste0(stDevCaption, " = ", round(designPlan$stDev, 3))) } header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) } else if (settings$ratesEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || inherits(designPlan, "SimulationResults"))) { if (settings$groups == 1) { if (!is.null(designPlan[["pi1"]]) && length(designPlan$pi1) == 1) { treatmentRateText <- paste0("H1: treatment rate pi = ", round(designPlan$pi1, 3)) } else { treatmentRateText <- "H1: treatment rate pi as specified" } header <- paste0(header, ",\n", .createSummaryHypothesisText(designPlan, summaryFactory)) header <- .concatenateSummaryText(header, treatmentRateText) header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) } else { if (!is.null(designPlan[["pi1"]]) && length(designPlan$pi1) == 1) { treatmentRateText <- paste0("H1; treatment rate pi(1) = ", round(designPlan$pi1, 3)) } else if (!is.null(designPlan[["piMaxVector"]]) && length(designPlan$piMaxVector) == 1) { treatmentRateText <- paste0( "H1: treatment rate pi_max = ", .arrayToString(round(designPlan$piMaxVector, 3), vectorLookAndFeelEnabled = TRUE) ) } else if (settings$enrichmentEnabled && !is.null(designPlan[["effectList"]]) && !is.null(designPlan$effectList[["piTreatments"]])) { piTreatments <- designPlan$effectList[["piTreatments"]] if (is.matrix(piTreatments) && nrow(piTreatments) == 1) { treatmentRateText <- paste0( "H1: assumed treatment rate pi(treatment) = ", .arrayToString(round(designPlan$effectList$piTreatments, 3), vectorLookAndFeelEnabled = TRUE) ) } else { treatmentRateText <- paste0("H1: assumed treatment rate pi(treatment) as specified") } } else { treatmentRateText <- paste0( "H1: treatment rate pi", ifelse(settings$multiArmEnabled, "_max", "(1)"), " as specified" ) } controlRateText <- NA_character_ if (settings$multiArmEnabled && !is.null(designPlan[["piControl"]])) { controlRateText <- paste0("control rate pi(control) = ", round(designPlan$piControl, 3)) } else if (settings$enrichmentEnabled && !is.null(designPlan[["piControls"]])) { controlRateText <- paste0( "control rates pi(control) = ", .arrayToString(round(designPlan$piControls, 3), vectorLookAndFeelEnabled = TRUE) ) } else if (settings$enrichmentEnabled && !is.null(designPlan[["effectList"]]) && !is.null(designPlan$effectList[["piControls"]])) { # simulation enrichment rates only piControl <- designPlan$effectList$piControls if (length(unique(piControl)) == 1) { piControl <- piControl[1] } controlRateText <- paste0( "control rate", ifelse(length(piControl) == 1, "", "s"), " pi(control) = ", .arrayToString(round(piControl, 3), vectorLookAndFeelEnabled = (length(unique(piControl)) > 1)) ) } else if (!is.null(designPlan[["pi2"]])) { controlRateText <- paste0("control rate pi(2) = ", round(designPlan$pi2, 3)) } else { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to identify case to build ", sQuote("treatmentRateText2")) } header <- paste0(header, ",\n", .createSummaryHypothesisText(designPlan, summaryFactory)) header <- .concatenateSummaryText(header, treatmentRateText) header <- .concatenateSummaryText(header, controlRateText) header <- .addEnrichmentEffectListToHeader(header, designPlan) header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) } } else if (settings$survivalEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || inherits(designPlan, "SimulationResults"))) { parameterNames <- designPlan$.getVisibleFieldNamesOrdered() numberOfVariants <- .getMultidimensionalNumberOfVariants(designPlan, parameterNames) if (grepl("SimulationResultsEnrichment", class(designPlan))) { userDefinedParam <- "hazardRatios" paramName <- "hazard ratios" paramValue <- designPlan$effectList$hazardRatios } else { userDefinedParam <- "pi1" for (param in c("pi1", "lambda1", "median1", "hazardRatio")) { if (designPlan$.getParameterType(param) == C_PARAM_USER_DEFINED && length(designPlan[[param]]) == numberOfVariants) { userDefinedParam <- param } } paramValue <- designPlan[[userDefinedParam]] if (is.null(paramValue) || length(paramValue) == 0 || all(is.na(paramValue))) { userDefinedParam <- "hazardRatio" } paramName <- "treatment pi(1)" if (userDefinedParam == "lambda1") { paramName <- "treatment lambda(1)" } else if (userDefinedParam == "median1") { paramName <- "treatment median(1)" } else if (userDefinedParam == "hazardRatio") { paramName <- ifelse(grepl("SimulationResultsMultiArm", class(designPlan)), "omega_max", "hazard ratio") } } if (length(designPlan[[userDefinedParam]]) == 1) { treatmentRateText <- paste0("H1: ", paramName, " = ", round(designPlan[[userDefinedParam]], 3)) } else if (!is.null(designPlan[["omegaMaxVector"]]) && length(designPlan$omegaMaxVector) == 1) { treatmentRateText <- paste0("H1: omega_max = ", round(designPlan$omegaMaxVector, 3)) } else if (!is.null(designPlan[["hazardRatio"]]) && (length(designPlan$hazardRatio) == 1) || (inherits(designPlan, "SimulationResults") && !is.null(designPlan[[".piecewiseSurvivalTime"]]) && designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled)) { treatmentRateText <- paste0( "H1: hazard ratio = ", .arrayToString(round(designPlan$hazardRatio, 3), vectorLookAndFeelEnabled = TRUE) ) } else { treatmentRateText <- paste0("H1: ", paramName, " as specified") } if (userDefinedParam %in% c("hazardRatio", "pi1") && (designPlan$.getParameterType("pi2") == C_PARAM_USER_DEFINED || designPlan$.getParameterType("pi2") == C_PARAM_DEFAULT_VALUE) && length(designPlan$pi2) == 1) { treatmentRateText <- paste0(treatmentRateText, ", control pi(2) = ", round(designPlan$pi2, 3)) } else if (userDefinedParam %in% c("hazardRatio", "lambda1") && (designPlan$.getParameterType("lambda2") == C_PARAM_USER_DEFINED || designPlan$.getParameterType("lambda2") == C_PARAM_DEFAULT_VALUE) && length(designPlan$lambda2) == 1) { treatmentRateText <- paste0(treatmentRateText, ", control lambda(2) = ", round(designPlan$lambda2, 3)) } else if (userDefinedParam %in% c("hazardRatio", "median1") && (designPlan$.getParameterType("median2") == C_PARAM_USER_DEFINED || designPlan$.getParameterType("median2") == C_PARAM_GENERATED) && length(designPlan$median2) == 1) { treatmentRateText <- paste0(treatmentRateText, ", control median(2) = ", round(designPlan$median2, 3)) } else if (!is.null(designPlan[[".piecewiseSurvivalTime"]]) && designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { treatmentRateText <- paste0(treatmentRateText, ", piecewise survival distribution") treatmentRateText <- paste0( treatmentRateText, ", \n", "control lambda(2) = ", .arrayToString(round(designPlan$lambda2, 4), vectorLookAndFeelEnabled = TRUE) ) } header <- paste0(header, ", \n", .createSummaryHypothesisText(designPlan, summaryFactory)) header <- .concatenateSummaryText(header, treatmentRateText) header <- .addEnrichmentEffectListToHeader(header, designPlan) header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) } if (!inherits(designPlan, "SimulationResults") && designPlan$.isSampleSizeObject()) { header <- .concatenateSummaryText(header, paste0("power ", round(100 * (1 - design$beta), 1), "%")) } if (inherits(designPlan, "SimulationResults")) { header <- .concatenateSummaryText(header, paste0("simulation runs = ", designPlan$maxNumberOfIterations)) header <- .concatenateSummaryText(header, paste0("seed = ", designPlan$seed)) } header <- paste0(header, ".") return(header) } .addAdditionalArgumentsToHeader <- function(header, designPlan, settings) { if (designPlan$.design$kMax > 1) { if (settings$survivalEnabled) { if (!is.null(designPlan[["plannedEvents"]])) { header <- .concatenateSummaryText(header, paste0( "planned cumulative events = ", .arrayToString(designPlan$plannedEvents, vectorLookAndFeelEnabled = (length(designPlan$plannedEvents) > 1) ) )) } } else { if (!is.null(designPlan[["plannedSubjects"]])) { header <- .concatenateSummaryText(header, paste0( "planned cumulative sample size = ", .arrayToString(designPlan$plannedSubjects, vectorLookAndFeelEnabled = (length(designPlan$plannedSubjects) > 1) ) )) } } if (!is.null(designPlan[["maxNumberOfSubjects"]]) && designPlan$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { header <- .concatenateSummaryText(header, paste0( "maximum number of subjects = ", ceiling(designPlan$maxNumberOfSubjects[1]) )) } if (settings$survivalEnabled) { if (!is.null(designPlan[["maxNumberOfEvents"]]) && designPlan$.getParameterType("maxNumberOfEvents") == C_PARAM_USER_DEFINED) { header <- .concatenateSummaryText(header, paste0( "maximum number of events = ", designPlan$maxNumberOfEvents[1] )) } } } else { if (settings$survivalEnabled) { if (!is.null(designPlan[["plannedEvents"]])) { header <- .concatenateSummaryText(header, paste0( "planned events = ", .arrayToString(designPlan$plannedEvents, vectorLookAndFeelEnabled = (length(designPlan$plannedEvents) > 1) ) )) } } else { if (!is.null(designPlan[["plannedSubjects"]])) { header <- .concatenateSummaryText(header, paste0( "planned sample size = ", .arrayToString(designPlan$plannedSubjects, vectorLookAndFeelEnabled = (length(designPlan$plannedSubjects) > 1) ) )) } } if (!is.null(designPlan[["maxNumberOfSubjects"]]) && designPlan$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { header <- .concatenateSummaryText(header, paste0( "number of subjects = ", ceiling(designPlan$maxNumberOfSubjects[1]) )) } if (settings$survivalEnabled) { if (!is.null(designPlan[["maxNumberOfEvents"]]) && designPlan$.getParameterType("maxNumberOfEvents") == C_PARAM_USER_DEFINED) { header <- .concatenateSummaryText(header, paste0( "number of events = ", designPlan$maxNumberOfEvents[1] )) } } } header <- .addAllocationRatioToHeader(designPlan, header) if (settings$survivalEnabled) { if (!is.null(designPlan[["eventTime"]]) && !is.na(designPlan[["eventTime"]])) { header <- .concatenateSummaryText(header, paste0( "event time = ", .arrayToString(designPlan$eventTime, vectorLookAndFeelEnabled = (length(designPlan$eventTime) > 1) ) )) } if (!is.null(designPlan[["accrualTime"]])) { header <- .concatenateSummaryText(header, paste0( "accrual time = ", .arrayToString(designPlan$accrualTime, vectorLookAndFeelEnabled = (length(designPlan$accrualTime) > 1) ) )) } if (!is.null(designPlan[["accrualTime"]]) && length(designPlan$accrualIntensity) == length(designPlan$accrualTime)) { header <- .concatenateSummaryText(header, paste0( "accrual intensity = ", .arrayToString(designPlan$accrualIntensity, digits = 1, vectorLookAndFeelEnabled = (length(designPlan$accrualIntensity) > 1) ) )) } if (!is.null(designPlan[["dropoutTime"]])) { if (designPlan$dropoutRate1 > 0 || designPlan$dropoutRate2 > 0) { header <- .concatenateSummaryText(header, paste0( "dropout rate(1) = ", .arrayToString(designPlan$dropoutRate1, vectorLookAndFeelEnabled = (length(designPlan$dropoutRate1) > 1) ) )) header <- .concatenateSummaryText(header, paste0( "dropout rate(2) = ", .arrayToString(designPlan$dropoutRate2, vectorLookAndFeelEnabled = (length(designPlan$dropoutRate2) > 1) ) )) header <- .concatenateSummaryText(header, paste0( "dropout time = ", .arrayToString(designPlan$dropoutTime, vectorLookAndFeelEnabled = (length(designPlan$dropoutTime) > 1) ) )) } } } if (settings$multiArmEnabled && designPlan$activeArms > 1) { header <- .addShapeSelectionToHeader(header, designPlan) } functionName <- ifelse(settings$survivalEnabled, "calcEventsFunction", "calcSubjectsFunction") userDefinedFunction <- !is.null(designPlan[[functionName]]) && designPlan$.getParameterType(functionName) == C_PARAM_USER_DEFINED if (userDefinedFunction || (!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { if (userDefinedFunction) { header <- .concatenateSummaryText( header, paste0("sample size reassessment: user defined '", functionName, "'") ) if ((!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { header <- .concatenateSummaryText( header, paste0("conditional power = ", designPlan$conditionalPower) ) } } else { if ((!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { header <- .concatenateSummaryText( header, paste0("sample size reassessment: conditional power = ", designPlan$conditionalPower) ) } } paramName1 <- ifelse(settings$survivalEnabled, "minNumberOfEventsPerStage", "minNumberOfSubjectsPerStage") paramName2 <- ifelse(settings$survivalEnabled, "maxNumberOfEventsPerStage", "maxNumberOfSubjectsPerStage") paramCaption <- ifelse(settings$survivalEnabled, "events", "subjects") if (!is.null(designPlan[[paramName1]])) { header <- .concatenateSummaryText(header, paste0( "minimum ", paramCaption, " per stage = ", .arrayToString(designPlan[[paramName1]], vectorLookAndFeelEnabled = (length(designPlan[[paramName1]]) > 1) ) )) } if (!is.null(designPlan[[paramName2]])) { header <- .concatenateSummaryText(header, paste0( "maximum ", paramCaption, " per stage = ", .arrayToString(designPlan[[paramName2]], vectorLookAndFeelEnabled = (length(designPlan[[paramName2]]) > 1) ) )) } if (settings$meansEnabled) { if (!is.na(designPlan$thetaH1)) { header <- .concatenateSummaryText( header, paste0("theta H1 = ", round(designPlan$thetaH1, 3)) ) } if (!is.na(designPlan$stDevH1)) { header <- .concatenateSummaryText( header, paste0("standard deviation H1 = ", round(designPlan$stDevH1, 3)) ) } } else if (settings$ratesEnabled) { if (settings$multiArmEnabled || settings$enrichmentEnabled) { if (settings$multiArmEnabled && !is.na(designPlan$piH1)) { header <- .concatenateSummaryText( header, paste0("pi(treatment)H1 = ", round(designPlan$piH1, 3)) ) } else if (settings$enrichmentEnabled) { piTreatmentH1 <- designPlan[["piTreatmentH1"]] if (is.null(piTreatmentH1)) { piTreatmentH1 <- designPlan[["piTreatmentsH1"]] } if (!is.null(piTreatmentH1) && !is.na(piTreatmentH1)) { header <- .concatenateSummaryText( header, paste0("pi(treatment)H1 = ", round(piTreatmentH1, 3)) ) } } if (!is.na(designPlan$piControlH1)) { header <- .concatenateSummaryText( header, paste0("pi(control)H1 = ", round(designPlan$piControlH1, 3)) ) } } else { if (!is.na(designPlan$pi1H1)) { header <- .concatenateSummaryText( header, paste0("pi(treatment)H1 = ", round(designPlan$pi1H1, 3)) ) } if (!is.na(designPlan$pi2H1)) { header <- .concatenateSummaryText( header, paste0("pi(control)H1 = ", round(designPlan$pi2H1, 3)) ) } } } if (settings$survivalEnabled && !is.null(designPlan[["thetaH1"]]) && !is.na(designPlan$thetaH1)) { header <- .concatenateSummaryText(header, paste0("thetaH1 = ", round(designPlan$thetaH1, 3))) } } return(header) } .addShapeSelectionToHeader <- function(header, designPlan) { header <- .concatenateSummaryText(header, paste0("intersection test = ", designPlan$intersectionTest)) header <- .concatenateSummaryText(header, paste0("effect shape = ", .formatCamelCase(designPlan$typeOfShape))) if (designPlan$typeOfShape == "sigmoidEmax") { header <- .concatenateSummaryText(header, paste0("slope = ", designPlan$slope)) header <- .concatenateSummaryText(header, paste0("ED50 = ", designPlan$gED50)) } if (designPlan$.design$kMax > 1) { typeOfSelectionText <- paste0("selection = ", .formatCamelCase(designPlan$typeOfSelection)) if (designPlan$typeOfSelection == "rBest") { typeOfSelectionText <- paste0(typeOfSelectionText, ", r = ", designPlan$rValue) } else if (designPlan$typeOfSelection == "epsilon") { typeOfSelectionText <- paste0(typeOfSelectionText, " rule, eps = ", designPlan$epsilonValue) } if (!is.null(designPlan$threshold) && length(designPlan$threshold) == 1 && designPlan$threshold > -Inf) { typeOfSelectionText <- paste0(typeOfSelectionText, ", threshold = ", designPlan$threshold) } header <- .concatenateSummaryText(header, typeOfSelectionText) header <- .concatenateSummaryText( header, paste0("effect measure based on ", .formatCamelCase(designPlan$effectMeasure)) ) } header <- .concatenateSummaryText( header, paste0("success criterion: ", .formatCamelCase(designPlan$successCriterion)) ) return(header) } .createSummary <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { output <- match.arg(output) if (inherits(object, "TrialDesignCharacteristics")) { return(.createSummaryDesignPlan(object$.design, digits = digits, output = output)) } if (.isTrialDesign(object) || .isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { return(.createSummaryDesignPlan(object, digits = digits, output = output)) } if (inherits(object, "AnalysisResults")) { return(.createSummaryAnalysisResults(object, digits = digits, output = output)) } stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "function 'summary' not implemented yet for class ", class(object)) } # # Main function for creating a summary of an analysis result # .createSummaryAnalysisResults <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { output <- match.arg(output) if (!inherits(object, "AnalysisResults")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'object' must be a valid analysis result object (is class ", class(object), ")" ) } digitSettings <- .getSummaryDigits(digits) digits <- digitSettings$digits digitsSampleSize <- digitSettings$digitsSampleSize digitsGeneral <- digitSettings$digitsGeneral digitsProbabilities <- digitSettings$digitsProbabilities outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") .assertIsValidSummaryIntervalFormat(intervalFormat) multiArmEnabled <- .isMultiArmAnalysisResults(object) enrichmentEnabled <- .isEnrichmentAnalysisResults(object) multiHypothesesEnabled <- .isMultiHypothesesAnalysisResults(object) analysisResults <- object design <- analysisResults$.design stageResults <- analysisResults$.stageResults dataInput <- analysisResults$.dataInput closedTestResults <- NULL conditionalPowerResults <- NULL if (multiHypothesesEnabled) { closedTestResults <- analysisResults$.closedTestResults if (length(analysisResults$nPlanned) > 0 && !all(is.na(analysisResults$nPlanned))) { conditionalPowerResults <- analysisResults$.conditionalPowerResults } } summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat, output = output) .addDesignInformationToSummary(design, object, summaryFactory, output = output) if (!.isTrialDesignConditionalDunnett(design)) { summaryFactory$addParameter(design, parameterName = "criticalValues", parameterCaption = ifelse(.isTrialDesignFisher(design), "Efficacy boundary (p product scale)", "Efficacy boundary (z-value scale)" ), roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), smoothedZeroFormat = !.isTrialDesignFisher(design) ) } if (.isTrialDesignFisher(design)) { if (any(design$alpha0Vec < 1)) { summaryFactory$addParameter(design, parameterName = "alpha0Vec", parameterCaption = "Futility boundary (separate p-value scale)", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } } else if (!.isTrialDesignConditionalDunnett(design)) { if (any(design$futilityBounds > -6)) { summaryFactory$addParameter(design, parameterName = "futilityBounds", parameterCaption = "Futility boundary (z-value scale)", roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), smoothedZeroFormat = TRUE ) } } if (design$kMax > 1 && !.isTrialDesignConditionalDunnett(design)) { summaryFactory$addParameter(design, parameterName = "alphaSpent", parameterCaption = "Cumulative alpha spent", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } if (!.isTrialDesignConditionalDunnett(design)) { summaryFactory$addParameter(design, parameterName = "stageLevels", parameterCaption = "Stage level", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } summaryFactory$addParameter(stageResults, parameterName = "effectSizes", parameterCaption = ifelse(stageResults$isDatasetRates() && dataInput$getNumberOfGroups() == 1, "Cumulative treatment rate", "Cumulative effect size" ), roundDigits = digitsGeneral ) if (stageResults$isDatasetMeans()) { parameterCaption <- ifelse(stageResults$isOneSampleDataset(), "Cumulative standard deviation", "Cumulative (pooled) standard deviation" ) parameterName <- ifelse(inherits(stageResults, "StageResultsMultiArmMeans") && !inherits(stageResults, "StageResultsEnrichmentMeans"), "overallPooledStDevs", "overallStDevs" ) summaryFactory$addParameter(stageResults, parameterName = parameterName, parameterCaption = parameterCaption, roundDigits = digitsGeneral, enforceFirstCase = (parameterName == "overallPooledStDevs") ) } else if (stageResults$isDatasetRates()) { if (outputSize != "small" && dataInput$getNumberOfGroups() > 1) { treatmentRateParamName <- "overallPi1" controlRateParamName <- "overallPi2" if (.isEnrichmentStageResults(stageResults)) { treatmentRateParamName <- "overallPisTreatment" controlRateParamName <- "overallPisControl" } else if (.isMultiArmStageResults(stageResults)) { treatmentRateParamName <- "overallPiTreatments" controlRateParamName <- "overallPiControl" } summaryFactory$addParameter(stageResults, parameterName = treatmentRateParamName, parameterCaption = "Cumulative treatment rate", roundDigits = digitsGeneral ) summaryFactory$addParameter(stageResults, parameterName = controlRateParamName, parameterCaption = "Cumulative control rate", roundDigits = digitsGeneral, enforceFirstCase = TRUE ) } } if (.isTrialDesignGroupSequential(design)) { summaryFactory$addParameter(stageResults, parameterName = "overallTestStatistics", parameterCaption = "Overall test statistic", roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), smoothedZeroFormat = TRUE ) summaryFactory$addParameter(stageResults, parameterName = ifelse(multiHypothesesEnabled, "separatePValues", "overallPValues"), parameterCaption = "Overall p-value", roundDigits = digitsProbabilities ) } else { summaryFactory$addParameter(stageResults, parameterName = "testStatistics", parameterCaption = "Stage-wise test statistic", roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), smoothedZeroFormat = TRUE ) summaryFactory$addParameter(stageResults, parameterName = ifelse(multiHypothesesEnabled, "separatePValues", "pValues"), parameterCaption = "Stage-wise p-value", roundDigits = digitsProbabilities ) } if (!is.null(closedTestResults)) { if (outputSize == "large") { if (.isTrialDesignConditionalDunnett(design)) { summaryFactory$addParameter(closedTestResults, parameterName = "conditionalErrorRate", parameterCaption = "Conditional error rate", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) summaryFactory$addParameter(closedTestResults, parameterName = "secondStagePValues", parameterCaption = "Second stage p-value", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } else { summaryFactory$addParameter(closedTestResults, parameterName = "adjustedStageWisePValues", parameterCaption = "Adjusted stage-wise p-value", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) summaryFactory$addParameter(closedTestResults, parameterName = "overallAdjustedTestStatistics", parameterCaption = "Overall adjusted test statistic", roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), smoothedZeroFormat = !.isTrialDesignFisher(design) ) } } else if (outputSize == "medium") { legendEntry <- list("(i, j, ...)" = "comparison of treatment arms 'i, j, ...' vs. control arm") gMax <- stageResults$getGMax() if (.isTrialDesignConditionalDunnett(design)) { summaryFactory$addParameter(closedTestResults, parameterName = "adjustedStageWisePValues", values = closedTestResults$conditionalErrorRate[1, ], parameterCaption = paste0( "Conditional error rate (", paste0(1:gMax, collapse = ", "), ")" ), roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, legendEntry = legendEntry ) summaryFactory$addParameter(closedTestResults, parameterName = "overallAdjustedTestStatistics", values = closedTestResults$secondStagePValues[1, ], parameterCaption = paste0( "Second stage p-value (", paste0(1:gMax, collapse = ", "), ")" ), roundDigits = digitsProbabilities + ifelse(.isTrialDesignFisher(design), 1, 0), smoothedZeroFormat = !.isTrialDesignFisher(design), legendEntry = legendEntry ) } else { summaryFactory$addParameter(closedTestResults, parameterName = "adjustedStageWisePValues", values = closedTestResults$adjustedStageWisePValues[1, ], parameterCaption = paste0( "Adjusted stage-wise p-value (", paste0(1:gMax, collapse = ", "), ")" ), roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, legendEntry = legendEntry ) summaryFactory$addParameter(closedTestResults, parameterName = "overallAdjustedTestStatistics", values = closedTestResults$overallAdjustedTestStatistics[1, ], parameterCaption = paste0( "Overall adjusted test statistic (", paste0(1:gMax, collapse = ", "), ")" ), roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), smoothedZeroFormat = !.isTrialDesignFisher(design), legendEntry = legendEntry ) } } } if (multiHypothesesEnabled) { summaryFactory$addParameter(closedTestResults, parameterName = "rejected", parameterCaption = "Test action: reject", roundDigits = digitsGeneral ) } else { if (.isTrialDesignFisher(design)) { summaryFactory$addParameter(stageResults, parameterName = "combFisher", parameterCaption = "Fisher combination", roundDigits = 0 ) } else if (.isTrialDesignInverseNormal(design)) { summaryFactory$addParameter(stageResults, parameterName = "combInverseNormal", parameterCaption = "Inverse normal combination", roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), smoothedZeroFormat = TRUE ) } summaryFactory$addParameter(analysisResults, parameterName = "testActions", parameterCaption = "Test action", roundDigits = digitsGeneral ) } if (design$kMax > 1 && !.isTrialDesignConditionalDunnett(design)) { summaryFactory$addParameter(analysisResults, parameterName = "conditionalRejectionProbabilities", parameterCaption = "Conditional rejection probability", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } if (design$kMax > 1) { if (!is.null(conditionalPowerResults)) { summaryFactory$addParameter(conditionalPowerResults, parameterName = "nPlanned", parameterCaption = "Planned sample size", roundDigits = -1 ) } else if (analysisResults$.getParameterType("nPlanned") != C_PARAM_NOT_APPLICABLE) { summaryFactory$addParameter(analysisResults, parameterName = "nPlanned", parameterCaption = "Planned sample size", roundDigits = -1 ) } } if (design$kMax > 1) { if (!is.null(conditionalPowerResults)) { summaryFactory$addParameter(conditionalPowerResults, parameterName = "conditionalPower", parameterCaption = "Conditional power", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } else if (!multiHypothesesEnabled && analysisResults$.getParameterType("nPlanned") != C_PARAM_NOT_APPLICABLE) { parameterName <- "conditionalPower" if (!is.null(analysisResults[["conditionalPowerSimulated"]]) && length(analysisResults[["conditionalPowerSimulated"]]) > 0) { parameterName <- "conditionalPowerSimulated" } summaryFactory$addParameter(analysisResults, parameterName = parameterName, parameterCaption = "Conditional power", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } } summaryFactory$addParameter(analysisResults, parameterName = c("repeatedConfidenceIntervalLowerBounds", "repeatedConfidenceIntervalUpperBounds"), parameterCaption = paste0( round((1 - design$alpha * (3 - design$sided)) * 100, 2), "% ", ifelse(design$kMax == 1, "confidence interval", "repeated confidence interval") ), roundDigits = digitsGeneral ) summaryFactory$addParameter(analysisResults, parameterName = "repeatedPValues", parameterCaption = ifelse(design$kMax == 1, ifelse(design$sided == 1, "One-sided p-value", "Two-sided p-value"), "Repeated p-value" ), roundDigits = digitsProbabilities, formatRepeatedPValues = TRUE ) if (!multiHypothesesEnabled && !is.null(analysisResults[["finalStage"]]) && !all(is.na(analysisResults$finalStage))) { summaryFactory$addParameter(analysisResults, parameterName = "finalPValues", parameterCaption = "Final p-value", roundDigits = digitsProbabilities ) summaryFactory$addParameter(analysisResults, parameterName = c("finalConfidenceIntervalLowerBounds", "finalConfidenceIntervalUpperBounds"), parameterCaption = "Final confidence interval", roundDigits = digitsGeneral ) summaryFactory$addParameter(analysisResults, parameterName = "medianUnbiasedEstimates", parameterCaption = "Median unbiased estimate", roundDigits = digitsGeneral ) } return(summaryFactory) } .getFullStagesVectorAtStage <- function(value, kMax, stage) { if (is.matrix(value) && nrow(value) > 1 && ncol(value) == 1) { x <- matrix(rep(NA_real_, nrow(value) * kMax), nrow = nrow(value), ncol = kMax) for (i in 1:nrow(value)) { x[i, stage] <- value[i, 1] } } else { x <- rep(NA_real_, kMax) x[stage] <- value } return(x) } .getSummaryDigits <- function(digits = NA_integer_) { if (is.na(digits)) { digits <- as.integer(getOption("rpact.summary.digits", 3)) } .assertIsSingleInteger(digits, "digits", validateType = FALSE, naAllowed = TRUE) .assertIsInClosedInterval(digits, "digits", lower = -1, upper = 12, naAllowed = TRUE) digitsSampleSize <- 1 if (digits > 0) { digitsGeneral <- digits digitsProbabilities <- NA_integer_ tryCatch( { digitsProbabilities <- as.integer(getOption("rpact.summary.digits.probs", digits + 1)) }, warning = function(e) { } ) if (is.na(digitsProbabilities)) { digitsProbabilities <- digits + 1 } .assertIsSingleInteger(digitsProbabilities, "digitsProbabilities", validateType = FALSE, naAllowed = FALSE) .assertIsInClosedInterval(digitsProbabilities, "digitsProbabilities", lower = -1, upper = 12, naAllowed = FALSE) } else { digitsSampleSize <- digits digitsGeneral <- digits digitsProbabilities <- digits } return(list( digits = digits, digitsSampleSize = digitsSampleSize, digitsGeneral = digitsGeneral, digitsProbabilities = digitsProbabilities )) } .getSummaryValuesInPercent <- function(values, percentFormatEnabled = TRUE, digits = 1) { if (!percentFormatEnabled) { return(as.character(round(values, digits + 2))) } return(paste0(round(100 * values, digits), "%")) } .addDesignInformationToSummary <- function(design, designPlan, summaryFactory, output = c("all", "title", "overview", "body")) { if (!(output %in% c("all", "overview"))) { return(invisible(summaryFactory)) } if (design$kMax == 1) { summaryFactory$addItem("Stage", "Fixed") return(invisible(summaryFactory)) } summaryFactory$addItem("Stage", c(1:design$kMax)) if (.isTrialDesignConditionalDunnett(design)) { summaryFactory$addItem( "Fixed information at interim", .getSummaryValuesInPercent(design$informationAtInterim, FALSE) ) return(invisible(summaryFactory)) } informationRatesCaption <- ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "AnalysisResults"), "Fixed weight", "Information") if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "AnalysisResults")) { if (.isTrialDesignFisher(design)) { weights <- .getWeightsFisher(design) } else if (.isTrialDesignInverseNormal(design)) { weights <- .getWeightsInverseNormal(design) } else { weights <- design$informationRates } summaryFactory$addItem(informationRatesCaption, .getSummaryValuesInPercent(weights, FALSE)) } else { summaryFactory$addItem( paste0( informationRatesCaption, ifelse(inherits(designPlan, "SimulationResults"), "", " rate") ), .getSummaryValuesInPercent(design$informationRates) ) } return(invisible(summaryFactory)) } .addDesignParameterToSummary <- function(design, designPlan, designCharacteristics, summaryFactory, digitsProbabilities) { if (design$kMax > 1 && !inherits(designPlan, "SimulationResults") && !.isTrialDesignConditionalDunnett(design)) { summaryFactory$addParameter(design, parameterName = "alphaSpent", parameterCaption = "Cumulative alpha spent", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) if (design$.getParameterType("betaSpent") == C_PARAM_GENERATED) { summaryFactory$addParameter(design, parameterName = "betaSpent", parameterCaption = "Cumulative beta spent", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } } if (!is.null(designPlan)) { if (!grepl("SimulationResults(MultiArm|Enrichment)", class(designPlan))) { outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) if (outputSize == "large" && inherits(designPlan, "SimulationResults")) { summaryFactory$addParameter(designPlan, parameterName = "conditionalPowerAchieved", parameterCaption = "Conditional power (achieved)", roundDigits = digitsProbabilities ) } } } else { powerObject <- NULL if (!is.null(designCharacteristics)) { powerObject <- designCharacteristics } else if (design$.getParameterType("power") == C_PARAM_GENERATED) { powerObject <- design } if (!is.null(powerObject)) { summaryFactory$addParameter(powerObject, parameterName = "power", parameterCaption = ifelse(design$kMax == 1, "Power", "Overall power"), roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } } if (.isTrialDesignConditionalDunnett(design)) { summaryFactory$addParameter(design, parameterName = "alpha", parameterCaption = "Significance level", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } else if (!is.null(designPlan) && !inherits(designPlan, "SimulationResults")) { summaryFactory$addParameter(design, parameterName = "stageLevels", twoSided = design$sided == 2, parameterCaption = paste0(ifelse(design$sided == 2, "Two", "One"), "-sided local significance level"), roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } return(summaryFactory) } # # Main function for creating a summary of a design or design plan # .createSummaryDesignPlan <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { output <- match.arg(output) designPlan <- NULL if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { design <- object$.design designPlan <- object } else if (.isTrialDesign(object)) { design <- object } else { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'object' must be a valid design, design plan, ", "or simulation result object (is class ", class(object), ")" ) } digitSettings <- .getSummaryDigits(digits) digits <- digitSettings$digits digitsSampleSize <- digitSettings$digitsSampleSize digitsGeneral <- digitSettings$digitsGeneral digitsProbabilities <- digitSettings$digitsProbabilities outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") .assertIsValidSummaryIntervalFormat(intervalFormat) summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat, output = output) if (output %in% c("all", "title", "overview")) { .addDesignInformationToSummary(design, object, summaryFactory, output = output) } if (!(output %in% c("all", "body"))) { return(summaryFactory) } if (!.isTrialDesignConditionalDunnett(design)) { summaryFactory$addParameter(design, parameterName = "criticalValues", parameterCaption = ifelse(.isTrialDesignFisher(design), "Efficacy boundary (p product scale)", "Efficacy boundary (z-value scale)" ), roundDigits = digitsGeneral ) } if (.isTrialDesignFisher(design)) { if (any(design$alpha0Vec < 1)) { summaryFactory$addParameter(design, parameterName = "alpha0Vec", parameterCaption = "Futility boundary (separate p-value scale)", roundDigits = digitsGeneral ) } } else if (!.isTrialDesignConditionalDunnett(design)) { if (any(design$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { summaryFactory$addParameter(design, parameterName = "futilityBounds", parameterCaption = "Futility boundary (z-value scale)", roundDigits = digitsGeneral ) } } designCharacteristics <- NULL if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { designCharacteristics <- getDesignCharacteristics(design) } if (is.null(designPlan)) { return(.addDesignParameterToSummary( design, designPlan, designCharacteristics, summaryFactory, digitsProbabilities )) } simulationEnabled <- grepl("SimulationResults", class(designPlan)) multiArmEnabled <- grepl("MultiArm", class(designPlan)) enrichmentEnabled <- grepl("Enrichment", class(designPlan)) baseEnabled <- grepl("(TrialDesignPlan|SimulationResults)(Means|Rates|Survival)", class(designPlan)) planningEnabled <- .isTrialDesignPlan(designPlan) simulationEnabled <- .isSimulationResults(designPlan) survivalEnabled <- grepl("Survival", class(designPlan)) probsH0 <- NULL probsH1 <- NULL if (design$kMax > 1) { if (.isTrialDesignInverseNormalOrGroupSequential(design) && length(designCharacteristics$shift) == 1 && !is.na(designCharacteristics$shift) && designCharacteristics$shift >= 1) { probsH0 <- getPowerAndAverageSampleNumber(design, theta = 0, nMax = designCharacteristics$shift) probsH1 <- getPowerAndAverageSampleNumber(design, theta = 1, nMax = designCharacteristics$shift) } if (!is.null(designPlan[["rejectPerStage"]])) { probsH1 <- list( earlyStop = designPlan$rejectPerStage[1:(design$kMax - 1), ] + as.vector(designPlan$futilityPerStage), rejectPerStage = designPlan$rejectPerStage, futilityPerStage = designPlan$futilityPerStage ) numberOfVariants <- 1 if (inherits(designPlan, "ParameterSet")) { parameterNames <- designPlan$.getVisibleFieldNamesOrdered() numberOfVariants <- .getMultidimensionalNumberOfVariants(designPlan, parameterNames) } if (numberOfVariants > 1 && is.matrix(probsH1$earlyStop) && ncol(probsH1$earlyStop) == 1) { probsH1$earlyStop <- matrix(rep(probsH1$earlyStop, numberOfVariants), ncol = numberOfVariants) probsH1$rejectPerStage <- matrix(rep(probsH1$rejectPerStage, numberOfVariants), ncol = numberOfVariants) probsH1$futilityPerStage <- matrix(rep(probsH1$futilityPerStage, numberOfVariants), ncol = numberOfVariants) } } } if (simulationEnabled && (multiArmEnabled || enrichmentEnabled)) { # simulation multi-arm #1:rejectAtLeastOne per mu_max summaryFactory$addParameter(designPlan, parameterName = "rejectAtLeastOne", parameterCaption = "Reject at least one", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE, legendEntry = { if (multiArmEnabled) list("(i)" = "treatment arm i") else list() } ) # simulation multi-arm #2: rejectedArmsPerStage if (outputSize == "large" && multiArmEnabled) { .addSimulationMultiArmArrayParameter(designPlan, parameterName = "rejectedArmsPerStage", parameterCaption = ifelse(design$kMax == 1, "Rejected arms", "Rejected arms per stage"), summaryFactory, roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } # simulation enrichment #2: rejectedPopulationsPerStage if (outputSize == "large" && enrichmentEnabled) { .addSimulationArrayToSummary(designPlan, parameterName = "rejectedPopulationsPerStage", parameterCaption = ifelse(design$kMax == 1, "Rejected populations", "Rejected populations per stage"), summaryFactory, digitsSampleSize = digitsProbabilities, smoothedZeroFormat = TRUE ) } # simulation multi-arm #3: successPerStage summaryFactory$addParameter(designPlan, parameterName = "successPerStage", parameterCaption = "Success per stage", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE ) # simulation multi-arm #4: futilityPerStage if (!planningEnabled && !baseEnabled && any(designPlan$futilityPerStage != 0)) { summaryFactory$addParameter(designPlan, parameterName = "futilityPerStage", parameterCaption = "Exit probability for futility", # (under H1) roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE ) } if (survivalEnabled) { summaryFactory$addParameter(designPlan, parameterName = "expectedNumberOfEvents", parameterCaption = "Expected number of events", roundDigits = digitsSampleSize, transpose = TRUE ) } else { summaryFactory$addParameter(designPlan, parameterName = "expectedNumberOfSubjects", parameterCaption = "Expected number of subjects", roundDigits = digitsSampleSize, transpose = TRUE ) } # simulation multi-arm #5: earlyStop per mu_max if (outputSize %in% c("medium", "large")) { summaryFactory$addParameter(designPlan, parameterName = "earlyStop", parameterCaption = "Overall exit probability", # (under H1) roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE ) } # simulation multi-arm / enrichment #6: sampleSizes if (outputSize %in% c("medium", "large")) { if (enrichmentEnabled && survivalEnabled) { parameterName <- "singleNumberOfEventsPerStage" parameterCaption <- "Single number of events" } else if (survivalEnabled) { parameterName <- "eventsPerStage" parameterCaption <- "Cumulative number of events" } else { parameterName <- "sampleSizes" parameterCaption <- "Stagewise number of subjects" } .addSimulationArrayToSummary( designPlan, parameterName, parameterCaption, summaryFactory, digitsSampleSize, smoothedZeroFormat = TRUE ) } if (outputSize == "large") { if (inherits(designPlan, "SimulationResultsMultiArmSurvival") || inherits(designPlan, "SimulationResultsEnrichmentSurvival")) { .addSimulationArrayToSummary( designPlan = designPlan, parameterName = "singleNumberOfEventsPerStage", parameterCaption = "Single number of events", summaryFactory = summaryFactory, digitsSampleSize = digitsSampleSize ) } } # simulation multi-arm #7: selectedArms if (multiArmEnabled && outputSize %in% c("medium", "large")) { .addSimulationMultiArmArrayParameter( designPlan = designPlan, parameterName = "selectedArms", parameterCaption = "Selected arms", summaryFactory = summaryFactory, roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } # simulation enrichment #7: selectedPopulations if (enrichmentEnabled && outputSize %in% c("medium", "large")) { .addSimulationArrayToSummary( designPlan = designPlan, parameterName = "selectedPopulations", parameterCaption = "Selected populations", summaryFactory = summaryFactory, digitsSampleSize = digitsProbabilities, smoothedZeroFormat = TRUE ) } # simulation multi-arm #8: numberOfActiveArms if (multiArmEnabled && outputSize %in% c("medium", "large")) { summaryFactory$addParameter(designPlan, parameterName = "numberOfActiveArms", parameterCaption = "Number of active arms", roundDigits = digitsGeneral, transpose = TRUE ) } # simulation enrichment #8: numberOfPopulations if (enrichmentEnabled && outputSize %in% c("medium", "large")) { summaryFactory$addParameter(designPlan, parameterName = "numberOfPopulations", parameterCaption = "Number of populations", roundDigits = digitsGeneral, transpose = TRUE ) } if (outputSize == "large") { summaryFactory$addParameter(designPlan, parameterName = "conditionalPowerAchieved", parameterCaption = "Conditional power (achieved)", roundDigits = digitsProbabilities, transpose = TRUE ) } } if (baseEnabled) { parameterName <- "rejectPerStage" if (design$kMax == 1) { parameterName <- "overallReject" } if (any(!is.na(designPlan[[parameterName]]))) { summaryFactory$addParameter(designPlan, parameterName = parameterName, parameterCaption = ifelse(design$kMax == 1, "Power", "Overall power"), roundDigits = digitsProbabilities, cumsumEnabled = TRUE, smoothedZeroFormat = TRUE ) } if (inherits(designPlan, "SimulationResults")) { parameterName1 <- ifelse(survivalEnabled, "numberOfSubjects", "sampleSizes") parameterName2 <- "eventsPerStage" } else { if (design$kMax == 1 && (designPlan$.isSampleSizeObject() || .isTrialDesignPlanMeans(designPlan) || .isTrialDesignPlanRates(designPlan))) { parameterName1 <- "nFixed" parameterName2 <- "eventsFixed" } else if (design$kMax == 1 && designPlan$.isPowerObject()) { parameterName1 <- "expectedNumberOfSubjects" parameterName2 <- "expectedNumberOfEvents" } else { parameterName1 <- "numberOfSubjects" parameterName2 <- "eventsPerStage" } } if (design$kMax > 1) { summaryFactory$addParameter(designPlan, parameterName = ifelse(inherits(designPlan, "TrialDesignPlan") && designPlan$.isSampleSizeObject(), "expectedNumberOfSubjectsH1", "expectedNumberOfSubjects" ), parameterCaption = "Expected number of subjects", roundDigits = digitsSampleSize, transpose = TRUE ) } if (outputSize %in% c("medium", "large")) { subjectsCaption <- ifelse(design$kMax > 1 && inherits(designPlan, "SimulationResults") && !survivalEnabled, "Stagewise number of subjects", "Number of subjects") summaryFactory$addParameter(designPlan, parameterName = parameterName1, parameterCaption = subjectsCaption, roundDigits = digitsSampleSize ) } if (survivalEnabled) { if (design$kMax > 1 && !(inherits(designPlan, "TrialDesignPlanSurvival") && designPlan$.isSampleSizeObject())) { summaryFactory$addParameter(designPlan, parameterName = "expectedNumberOfEvents", parameterCaption = "Expected number of events", roundDigits = digitsSampleSize, transpose = TRUE ) } if (outputSize %in% c("medium", "large")) { summaryFactory$addParameter(designPlan, parameterName = parameterName2, parameterCaption = ifelse(design$kMax == 1, "Number of events", "Cumulative number of events"), roundDigits = digitsSampleSize, cumsumEnabled = FALSE ) } if (outputSize == "large") { summaryFactory$addParameter(designPlan, parameterName = "analysisTime", parameterCaption = "Analysis time", roundDigits = digitsSampleSize ) } summaryFactory$addParameter(designPlan, parameterName = "studyDuration", parameterCaption = "Expected study duration", roundDigits = digitsSampleSize, smoothedZeroFormat = TRUE, transpose = TRUE ) } } if (!is.null(designPlan[["allocationRatioPlanned"]]) && length(unique(designPlan$allocationRatioPlanned)) > 1) { summaryFactory$addParameter(designPlan, parameterName = "allocationRatioPlanned", parameterCaption = "Optimum allocation ratio", roundDigits = digitsGeneral ) } .addDesignParameterToSummary( design, designPlan, designCharacteristics, summaryFactory, digitsProbabilities ) if (baseEnabled && !planningEnabled && !is.null(designPlan[["futilityPerStage"]]) && !any(is.na(designPlan[["futilityPerStage"]])) && any(designPlan$futilityPerStage != 0) && any(designPlan$futilityPerStage > 1e-08)) { summaryFactory$addParameter(designPlan, parameterName = "futilityPerStage", parameterCaption = "Exit probability for futility", # (under H1) roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } if (baseEnabled && simulationEnabled && design$kMax > 1) { values <- NULL if (!is.null(probsH1)) { values <- probsH1$rejectPerStage } summaryFactory$addParameter(designPlan, parameterName = "rejectPerStage", values = values, parameterCaption = "Exit probability for efficacy", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } # sample size and power only if (planningEnabled) { legendEntry <- list("(t)" = "treatment effect scale") if (ncol(designPlan$criticalValuesEffectScale) > 0) { summaryFactory$addParameter(designPlan, parameterName = "criticalValuesEffectScale", parameterCaption = "Efficacy boundary (t)", roundDigits = digitsGeneral, legendEntry = legendEntry ) } else if (ncol(designPlan$criticalValuesEffectScaleUpper) > 0) { if (as.logical(getOption("rpact.summary.enforceIntervalView", FALSE))) { summaryFactory$addParameter(designPlan, parameterName = c("criticalValuesEffectScaleLower", "criticalValuesEffectScaleUpper"), parameterCaption = "Efficacy boundary (t)", roundDigits = digitsGeneral, legendEntry = legendEntry ) } else { summaryFactory$addParameter(designPlan, parameterName = "criticalValuesEffectScaleLower", parameterCaption = "Lower efficacy boundary (t)", roundDigits = digitsGeneral, legendEntry = legendEntry ) summaryFactory$addParameter(designPlan, parameterName = "criticalValuesEffectScaleUpper", parameterCaption = "Upper efficacy boundary (t)", roundDigits = digitsGeneral, legendEntry = legendEntry ) } } if (ncol(designPlan$futilityBoundsEffectScale) > 0 && !all(is.na(designPlan$futilityBoundsEffectScale))) { summaryFactory$addParameter(designPlan, parameterName = "futilityBoundsEffectScale", parameterCaption = "Futility boundary (t)", roundDigits = digitsGeneral, legendEntry = legendEntry ) } else if (ncol(designPlan$futilityBoundsEffectScaleUpper) > 0 && (any(!is.na(designPlan$futilityBoundsEffectScaleLower)) || any(!is.na(designPlan$futilityBoundsEffectScaleUpper)))) { if (as.logical(getOption("rpact.summary.enforceIntervalView", FALSE))) { summaryFactory$addParameter(designPlan, parameterName = c("futilityBoundsEffectScaleLower", "futilityBoundsEffectScaleUpper"), parameterCaption = "Futility boundary (t)", roundDigits = digitsGeneral, legendEntry = legendEntry ) } else { summaryFactory$addParameter(designPlan, parameterName = "futilityBoundsEffectScaleLower", parameterCaption = "Lower futility boundary (t)", roundDigits = digitsGeneral, legendEntry = legendEntry ) summaryFactory$addParameter(designPlan, parameterName = "futilityBoundsEffectScaleUpper", parameterCaption = "Upper futility boundary (t)", roundDigits = digitsGeneral, legendEntry = legendEntry ) } } if (!is.null(probsH1) && !is.null(probsH0) && design$kMax > 1) { probsH0$earlyStop <- matrix(probsH0$earlyStop[1:(design$kMax - 1), 1], ncol = 1) probsH0$rejectPerStage <- matrix(probsH0$rejectPerStage[1:(design$kMax - 1), 1], ncol = 1) if (is.matrix(probsH1$rejectPerStage)) { if (design$kMax > 1 && designPlan$.isSampleSizeObject()) { probsH1$rejectPerStage <- probsH1$rejectPerStage[1:(design$kMax - 1), 1] } else { probsH1$rejectPerStage <- matrix(probsH1$rejectPerStage[1:(design$kMax - 1), ], ncol = ncol(probsH1$rejectPerStage) ) } } else { probsH1$rejectPerStage <- probsH1$rejectPerStage[1:(design$kMax - 1)] } if (any(design$futilityBounds > -6)) { if (is.matrix(probsH1$earlyStop)) { probsH1$earlyStop <- matrix(probsH1$earlyStop[1:(design$kMax - 1), ], ncol = ncol(probsH1$earlyStop) ) } else { probsH1$earlyStop <- probsH1$earlyStop[1:(design$kMax - 1)] } summaryFactory$addParameter(probsH0, parameterName = "earlyStop", parameterCaption = "Overall exit probability (under H0)", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) x <- designPlan if (is.null(x)) { x <- design } summaryFactory$addParameter(x, parameterName = "earlyStop", values = probsH1$earlyStop, parameterCaption = "Overall exit probability (under H1)", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } summaryFactory$addParameter(probsH0, parameterName = "rejectPerStage", parameterCaption = "Exit probability for efficacy (under H0)", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) if (designPlan$.isPowerObject()) { summaryFactory$addParameter(designPlan, parameterName = "rejectPerStage", values = probsH1$rejectPerStage, parameterCaption = "Exit probability for efficacy (under H1)", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } else { summaryFactory$addParameter(probsH1, parameterName = "rejectPerStage", parameterCaption = "Exit probability for efficacy (under H1)", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } if (any(design$futilityBounds > -6)) { summaryFactory$addParameter(probsH0, parameterName = "futilityPerStage", parameterCaption = "Exit probability for futility (under H0)", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) x <- designPlan if (is.null(x)) { x <- design } futilityPerStage <- probsH1$futilityPerStage if (.isTrialDesignPlan(x) && x$.isSampleSizeObject() && ncol(futilityPerStage) > 1) { futilityPerStage <- futilityPerStage[, 1] } summaryFactory$addParameter(x, parameterName = "futilityPerStage", values = futilityPerStage, parameterCaption = "Exit probability for futility (under H1)", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } } } return(summaryFactory) } .getSummaryVariedParameterNameEnrichment <- function(designPlan) { if (grepl("Rates", class(designPlan))) { return("piTreatments") } if (grepl("Survival", class(designPlan))) { return("hazardRatios") } return("effects") } .getSummaryGroup <- function(parameterCaption, numberOfVariedParams, variedParamNumber, designPlan) { if (numberOfVariedParams <= 1) { return(list( groupCaption = parameterCaption, legendEntry = list() )) } enrichmentEnabled <- grepl("SimulationResultsEnrichment", class(designPlan)) if (enrichmentEnabled) { variedParameterName <- .getSummaryVariedParameterNameEnrichment(designPlan) variedParameterValues <- designPlan$effectList[[variedParameterName]] if (variedParameterName == "piTreatments") { variedParameterCaption <- "pi(treatment)" } else { variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] } if (is.matrix(variedParameterValues) && ncol(variedParameterValues) == 1) { variedParameterCaption <- sub("s$", "", variedParameterCaption) } } else { variedParameterName <- .getSummaryVariedParameterSimulationMultiArm(designPlan) variedParameterValues <- designPlan[[variedParameterName]] variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] } userDefinedEffectMatrix <- !enrichmentEnabled && designPlan$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED if (userDefinedEffectMatrix) { return(list( groupCaption = paste0(parameterCaption, " [", variedParamNumber, "]"), legendEntry = list("[j]" = "effect matrix row j (situation to consider)") )) } if (is.matrix(variedParameterValues)) { values <- variedParameterValues[variedParamNumber, ] if (length(values) > 1) { values <- .arrayToString(values, vectorLookAndFeelEnabled = TRUE) } } else { values <- variedParameterValues[variedParamNumber] } if (is.numeric(values)) { values <- round(values, 2) } return(list( groupCaption = paste0( parameterCaption, ", ", tolower(variedParameterCaption), " = ", values ), legendEntry = list() )) } .getSummaryGroupCaption <- function(designPlan, parameterName, numberOfGroups, groupNumber) { listItemPrefix <- getOption("rpact.summary.list.item.prefix", C_SUMMARY_LIST_ITEM_PREFIX_DEFAULT) if (grepl("Enrichment", class(designPlan))) { categoryCaption <- .getCategoryCaptionEnrichment(designPlan, parameterName, groupNumber) categoryCaption <- sub("^F$", "Full population F", categoryCaption) categoryCaption <- sub("^R$", "Remaining population R", categoryCaption) categoryCaption <- sub("^S", "Subset S", categoryCaption) return(paste0(listItemPrefix, categoryCaption)) } treatmentCaption <- ifelse(numberOfGroups > 2, paste0("Treatment arm ", groupNumber), "Treatment arm") if (!grepl("Survival", class(designPlan)) || (inherits(designPlan, "SimulationResultsMultiArmSurvival") && parameterName == "singleNumberOfEventsPerStage")) { return(ifelse(groupNumber == numberOfGroups, paste0(listItemPrefix, "Control arm"), paste0(listItemPrefix, treatmentCaption) )) } return(paste0(listItemPrefix, treatmentCaption, " vs. control")) } .addSimulationArrayToSummary <- function(designPlan, parameterName, parameterCaption, summaryFactory, digitsSampleSize, smoothedZeroFormat = FALSE) { arrayData <- designPlan[[parameterName]] numberOfVariedParams <- dim(arrayData)[2] numberOfGroups <- dim(arrayData)[3] for (variedParamNumber in 1:numberOfVariedParams) { summaryGroup <- .getSummaryGroup( parameterCaption, numberOfVariedParams, variedParamNumber, designPlan ) groupCaption <- summaryGroup$groupCaption legendEntry <- summaryGroup$legendEntry if (numberOfGroups > 1) { summaryFactory$addItem(groupCaption, "", legendEntry = legendEntry) } for (groupNumber in 1:numberOfGroups) { dataPerGroupAndStage <- arrayData[, variedParamNumber, groupNumber] if (numberOfGroups > 1) { groupCaption <- .getSummaryGroupCaption( designPlan, parameterName, numberOfGroups, groupNumber ) } summaryFactory$addParameter(designPlan, parameterName = parameterName, values = dataPerGroupAndStage, parameterCaption = groupCaption, roundDigits = digitsSampleSize, smoothedZeroFormat = smoothedZeroFormat, enforceFirstCase = TRUE ) } } } .addSimulationMultiArmArrayParameter <- function(designPlan, parameterName, parameterCaption, summaryFactory, roundDigits, smoothedZeroFormat = FALSE) { arrayData <- designPlan[[parameterName]] if (is.array(arrayData) && length(dim(arrayData)) == 3) { totalNumberOfGroups <- dim(designPlan[[ifelse(grepl("Survival", class(designPlan)), "eventsPerStage", "sampleSizes" )]])[3] numberOfGroups <- dim(arrayData)[3] if (parameterName == "selectedArms" && !grepl("Survival", class(designPlan))) { # remove control group numberOfGroups <- numberOfGroups - 1 } numberOfVariedParams <- dim(arrayData)[2] for (variedParamNumber in 1:numberOfVariedParams) { summaryGroup <- .getSummaryGroup( parameterCaption, numberOfVariedParams, variedParamNumber, designPlan ) groupCaption <- summaryGroup$groupCaption legendEntry <- summaryGroup$legendEntry if (numberOfGroups > 1) { summaryFactory$addItem(groupCaption, "", legendEntry = legendEntry) } for (groupNumber in 1:numberOfGroups) { dataPerGroupAndStage <- arrayData[, variedParamNumber, groupNumber] if (numberOfGroups > 1) { groupCaption <- .getSummaryGroupCaption( designPlan, parameterName, numberOfGroups, groupNumber ) } summaryFactory$addParameter(designPlan, parameterName = parameterName, values = dataPerGroupAndStage, parameterCaption = groupCaption, roundDigits = roundDigits, smoothedZeroFormat = smoothedZeroFormat, enforceFirstCase = TRUE ) } } } else { data <- designPlan[[parameterName]] numberOfGroups <- ncol(data) for (groupNumber in 1:numberOfGroups) { dataPerGroupAndStage <- data[, groupNumber] summaryFactory$addParameter(designPlan, parameterName = parameterName, values = dataPerGroupAndStage, parameterCaption = ifelse(groupNumber == numberOfGroups, paste0(parameterCaption, ", control"), paste0(parameterCaption, ", treatment ", groupNumber) ), roundDigits = roundDigits, smoothedZeroFormat = smoothedZeroFormat ) } } } .getSummaryVariedParameterSimulationMultiArm <- function(designPlan) { if (!grepl("SimulationResultsMultiArm", class(designPlan))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'designPlan' (", class(designPlan), ") must be of class 'SimulationResultsMultiArm'" ) } if (grepl("Means", class(designPlan))) { return("muMaxVector") } else if (grepl("Rates", class(designPlan))) { return("piMaxVector") } else if (grepl("Survival", class(designPlan))) { return("omegaMaxVector") } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'designPlan' (", class(designPlan), ") must be of class 'SimulationResultsMultiArm'" ) } rpact/R/f_simulation_enrichment.R0000644000175000017500000010434014156304412016750 0ustar nileshnilesh## | ## | *Simulation of enrichment design with combination test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5655 $ ## | Last changed: $Date: 2021-12-15 07:19:53 +0100 (Wed, 15 Dec 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include f_simulation_utilities.R NULL .getIndicesOfSelectedSubsets <- function(gMax) { subsets <- .getAllAvailableSubsets(1:gMax) subsets <- subsets[grepl(as.character(gMax), subsets)] indexList <- list() subsetIndex <- 1 if (length(subsets) > 1) { subsetIndex <- c(2:length(subsets), 1) } for (i in subsetIndex) { s <- subsets[i] indices <- as.integer(strsplit(s, "", fixed = TRUE)[[1]]) indexList[[length(indexList) + 1]] <- indices } return(indexList) } .createSelectedSubsetsTheoretical <- function(stage, selectedPopulations) { gMax <- nrow(selectedPopulations) selectedVector <- rep(FALSE, 2^(gMax - 1)) indices <- .getIndicesOfSelectedSubsets(gMax) for (i in 1:length(indices)) { selectedVector[i] <- any(selectedPopulations[indices[[i]], stage]) } return(selectedVector) } .createSelectedSubsets <- function(stage, selectedPopulations) { gMax <- nrow(selectedPopulations) selectedVector <- rep(FALSE, 2^(gMax - 1)) if (gMax == 1) { selectedVector[1] <- selectedPopulations[1, stage] } if (gMax == 2) { selectedVector[1] <- selectedPopulations[1, stage] || selectedPopulations[2, stage] selectedVector[2] <- selectedPopulations[2, stage] } if (gMax == 3) { selectedVector[1] <- selectedPopulations[1, stage] || selectedPopulations[3, stage] selectedVector[2] <- selectedPopulations[2, stage] || selectedPopulations[3, stage] selectedVector[3] <- selectedPopulations[1, stage] || selectedPopulations[2, stage] || selectedPopulations[3, stage] selectedVector[4] <- selectedPopulations[3, stage] } if (gMax == 4) { selectedVector[1] <- selectedPopulations[1, stage] || selectedPopulations[4, stage] selectedVector[2] <- selectedPopulations[2, stage] || selectedPopulations[4, stage] selectedVector[3] <- selectedPopulations[3, stage] || selectedPopulations[4, stage] selectedVector[4] <- selectedPopulations[1, stage] || selectedPopulations[2, stage] || selectedPopulations[4, stage] selectedVector[5] <- selectedPopulations[1, stage] || selectedPopulations[3, stage] || selectedPopulations[4, stage] selectedVector[6] <- selectedPopulations[2, stage] || selectedPopulations[3, stage] || selectedPopulations[4, stage] selectedVector[7] <- selectedPopulations[1, stage] || selectedPopulations[2, stage] || selectedPopulations[3, stage] || selectedPopulations[4, stage] selectedVector[8] <- selectedPopulations[4, stage] } return(selectedVector) } .selectPopulations <- function(stage, effectVector, typeOfSelection, epsilonValue, rValue, threshold, selectPopulationsFunction) { gMax <- length(effectVector) if (typeOfSelection != "userDefined") { if (typeOfSelection == "all") { selectedPopulations <- rep(TRUE, gMax) } else { selectedPopulations <- rep(FALSE, gMax) if (typeOfSelection == "best") { selectedPopulations[which.max(effectVector)] <- TRUE } else if (tolower(typeOfSelection) == "rbest") { selectedPopulations[order(effectVector, decreasing = TRUE)[1:rValue]] <- TRUE selectedPopulations[is.na(effectVector)] <- FALSE } else if (typeOfSelection == "epsilon") { selectedPopulations[max(effectVector, na.rm = TRUE) - effectVector <= epsilonValue] <- TRUE selectedPopulations[is.na(effectVector)] <- FALSE } } selectedPopulations[effectVector <= threshold] <- FALSE } else { functionArgumentNames <- .getFunctionArgumentNames(selectPopulationsFunction, ignoreThreeDots = TRUE) if (length(functionArgumentNames) == 1) { .assertIsValidFunction( fun = selectPopulationsFunction, funArgName = "selectPopulationsFunction", expectedArguments = c("effectVector"), validateThreeDots = FALSE ) selectedPopulations <- selectPopulationsFunction(effectVector) } else { .assertIsValidFunction( fun = selectPopulationsFunction, funArgName = "selectPopulationsFunction", expectedArguments = c("effectVector", "stage"), validateThreeDots = FALSE ) selectedPopulations <- selectPopulationsFunction(effectVector = effectVector, stage = stage) } selectedPopulations[is.na(effectVector)] <- FALSE msg <- paste0( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'selectPopulationsFunction' returned an illegal or undefined result (", .arrayToString(selectedPopulations), "); " ) if (length(selectedPopulations) != gMax) { stop(msg, "the output must be a logical vector of length 'gMax' (", gMax, ")") } if (!is.logical(selectedPopulations)) { stop(msg, "the output must be a logical vector (is ", class(selectedPopulations), ")") } } return(selectedPopulations) } .performClosedCombinationTestForSimulationEnrichment <- function(..., stageResults, design, indices, intersectionTest, successCriterion) { if (.isTrialDesignGroupSequential(design) && (design$kMax > 1)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "Group sequential design cannot be used for enrichment designs with population selection" ) } gMax <- nrow(stageResults$testStatistics) kMax <- design$kMax adjustedStageWisePValues <- matrix(NA_real_, nrow = 2^gMax - 1, ncol = kMax) overallAdjustedTestStatistics <- matrix(NA_real_, nrow = 2^gMax - 1, ncol = kMax) rejected <- matrix(FALSE, nrow = gMax, ncol = kMax) rejectedIntersections <- matrix(FALSE, nrow = nrow(indices), ncol = kMax) futility <- matrix(FALSE, nrow = gMax, ncol = kMax - 1) futilityIntersections <- matrix(FALSE, nrow = nrow(indices), ncol = kMax - 1) rejectedIntersectionsBefore <- matrix(FALSE, nrow = nrow(indices), ncol = 1) successStop <- rep(FALSE, kMax) futilityStop <- rep(FALSE, kMax - 1) if (.isTrialDesignFisher(design)) { weightsFisher <- .getWeightsFisher(design) } else { weightsInverseNormal <- .getWeightsInverseNormal(design) } if (gMax == 1) { intersectionTest <- "Bonferroni" } separatePValues <- stageResults$separatePValues if (intersectionTest == "SpiessensDebois") { subjectsPerStage <- stageResults[[ifelse( !is.null(stageResults[["subjectsPerStage"]]), "subjectsPerStage", "eventsPerStage" )]] testStatistics <- stageResults$testStatistics } else { subjectsPerStage <- NULL testStatistics <- NULL } for (k in 1:kMax) { for (i in 1:(2^gMax - 1)) { if (!all(is.na(separatePValues[indices[i, ] == 1, k]))) { if (intersectionTest == "SpiessensDebois") { subjectsSelected <- as.numeric(na.omit(subjectsPerStage[indices[i, ] == 1 & stageResults$selectedPopulations[, k], k])) if (length(subjectsSelected) == 1) { sigma <- 1 } else { sigma <- matrix(sqrt(subjectsSelected[1] / sum(subjectsSelected)), nrow = 2, ncol = 2) diag(sigma) <- 1 } maxTestStatistic <- max(testStatistics[indices[i, ] == 1, k], na.rm = TRUE) adjustedStageWisePValues[i, k] <- 1 - .getMultivariateDistribution( type = "normal", upper = maxTestStatistic, sigma = sigma, df = NA_real_ ) } # Bonferroni adjusted p-values else if (intersectionTest == "Bonferroni") { adjustedStageWisePValues[i, k] <- min(c(sum(indices[ i, !is.na(separatePValues[, k]) ]) * min(separatePValues[indices[i, ] == 1, k], na.rm = TRUE), 1)) } # Simes adjusted p-values else if (intersectionTest == "Simes") { adjustedStageWisePValues[i, k] <- min(sum(indices[ i, !is.na(separatePValues[, k]) ]) / (1:sum(indices[i, !is.na(separatePValues[, k])])) * sort(separatePValues[indices[i, ] == 1, k])) } # Sidak adjusted p-values else if (intersectionTest == "Sidak") { adjustedStageWisePValues[i, k] <- 1 - (1 - min(separatePValues[indices[i, ] == 1, k], na.rm = TRUE))^ sum(indices[i, !is.na(separatePValues[, k])]) } if (.isTrialDesignFisher(design)) { overallAdjustedTestStatistics[i, k] <- prod(adjustedStageWisePValues[i, 1:k]^weightsFisher[1:k]) } else { overallAdjustedTestStatistics[i, k] <- (weightsInverseNormal[1:k] %*% .getOneMinusQNorm(adjustedStageWisePValues[i, 1:k])) / sqrt(sum(weightsInverseNormal[1:k]^2)) } } if (.isTrialDesignFisher(design)) { rejectedIntersections[i, k] <- (overallAdjustedTestStatistics[i, k] <= design$criticalValues[k]) if (k < kMax) { futilityIntersections[i, k] <- (adjustedStageWisePValues[i, k] >= design$alpha0Vec[k]) } } else if (.isTrialDesignInverseNormal(design)) { rejectedIntersections[i, k] <- (overallAdjustedTestStatistics[i, k] >= design$criticalValues[k]) if (k < kMax) { futilityIntersections[i, k] <- (overallAdjustedTestStatistics[i, k] <= design$futilityBounds[k]) } } rejectedIntersections[is.na(rejectedIntersections[, k]), k] <- FALSE if (k == kMax && !rejectedIntersections[1, k]) { break } } rejectedIntersections[, k] <- rejectedIntersections[, k] | rejectedIntersectionsBefore rejectedIntersectionsBefore <- matrix(rejectedIntersections[, k], ncol = 1) for (j in 1:gMax) { rejected[j, k] <- all(rejectedIntersections[indices[, j] == 1, k], na.rm = TRUE) if (k < kMax) { futility[j, k] <- any(futilityIntersections[indices[, j] == 1, k], na.rm = TRUE) } } if (successCriterion == "all") { successStop[k] <- all(rejected[stageResults$selectedPopulations[1:gMax, k], k]) } else { successStop[k] <- any(rejected[, k]) } if (k < kMax) { futilityStop[k] <- all(futility[stageResults$selectedPopulations[1:gMax, k], k]) if (all(stageResults$selectedPopulations[1:gMax, k + 1] == FALSE)) { futilityStop[k] <- TRUE } } } return(list( separatePValues = separatePValues, adjustedStageWisePValues = adjustedStageWisePValues, overallAdjustedTestStatistics = overallAdjustedTestStatistics, rejected = rejected, rejectedIntersections = rejectedIntersections, selectedPopulations = stageResults$selectedPopulations, successStop = successStop, futilityStop = futilityStop )) } .createSimulationResultsEnrichmentObject <- function(..., design, populations, effectList, intersectionTest, stratifiedAnalysis = NA, directionUpper = NA, # rates + survival only adaptations, typeOfSelection, effectMeasure, successCriterion, epsilonValue, rValue, threshold, plannedSubjects = NA_real_, # means + rates only plannedEvents = NA_real_, # survival only allocationRatioPlanned, minNumberOfSubjectsPerStage = NA_real_, # means + rates only maxNumberOfSubjectsPerStage = NA_real_, # means + rates only minNumberOfEventsPerStage = NA_real_, # survival only maxNumberOfEventsPerStage = NA_real_, # survival only conditionalPower, thetaH1 = NA_real_, # means + survival only stDevH1 = NA_real_, # means only piTreatmentH1 = NA_real_, # rates only piControlH1 = NA_real_, # rates only maxNumberOfIterations, seed, calcSubjectsFunction = NULL, # means + rates only calcEventsFunction = NULL, # survival only selectPopulationsFunction, showStatistics, endpoint = c("means", "rates", "survival")) { endpoint <- match.arg(endpoint) .assertIsSingleNumber(threshold, "threshold", naAllowed = FALSE) .assertIsSingleLogical(stratifiedAnalysis, "stratifiedAnalysis") .assertIsSinglePositiveInteger(rValue, "rValue", naAllowed = TRUE, validateType = FALSE) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned", naAllowed = TRUE) .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM, naAllowed = TRUE) .assertIsSingleNumber(conditionalPower, "conditionalPower", naAllowed = TRUE) .assertIsInOpenInterval(conditionalPower, "conditionalPower", 0, 1, naAllowed = TRUE) .assertIsLogicalVector(adaptations, "adaptations", naAllowed = TRUE) if (endpoint %in% c("means", "rates")) { .assertIsNumericVector(minNumberOfSubjectsPerStage, "minNumberOfSubjectsPerStage", naAllowed = TRUE) .assertIsNumericVector(maxNumberOfSubjectsPerStage, "maxNumberOfSubjectsPerStage", naAllowed = TRUE) } else if (endpoint == "survival") { .assertIsNumericVector(minNumberOfEventsPerStage, "minNumberOfEventsPerStage", naAllowed = TRUE) .assertIsNumericVector(maxNumberOfEventsPerStage, "maxNumberOfEventsPerStage", naAllowed = TRUE) } .assertIsSinglePositiveInteger(maxNumberOfIterations, "maxNumberOfIterations", validateType = FALSE) .assertIsSingleLogical(showStatistics, "showStatistics", naAllowed = FALSE) .assertIsSingleNumber(seed, "seed", naAllowed = TRUE) if (endpoint %in% c("rates", "survival")) { .assertIsSingleLogical(directionUpper, "directionUpper") } if (endpoint %in% c("means", "survival")) { .assertIsSingleNumber(thetaH1, "thetaH1", naAllowed = TRUE) # means + survival only } if (endpoint == "means") { .assertIsSingleNumber(stDevH1, "stDevH1", naAllowed = TRUE) .assertIsInOpenInterval(stDevH1, "stDevH1", 0, NULL, naAllowed = TRUE) } successCriterion <- .assertIsValidSuccessCriterion(successCriterion) effectMeasure <- .assertIsValidEffectMeasure(effectMeasure) if (endpoint == "means") { simulationResults <- SimulationResultsEnrichmentMeans(design, showStatistics = showStatistics) } else if (endpoint == "rates") { simulationResults <- SimulationResultsEnrichmentRates(design, showStatistics = showStatistics) } else if (endpoint == "survival") { simulationResults <- SimulationResultsEnrichmentSurvival(design, showStatistics = showStatistics) } .assertIsSinglePositiveInteger(populations, "populations", naAllowed = TRUE, validateType = FALSE) if (is.na(populations)) { if (is.null(effectList) || is.null(effectList[["subGroups"]])) { .assertIsSinglePositiveInteger(populations, "populations", naAllowed = FALSE, validateType = FALSE) } populations <- .getGMaxFromSubGroups(effectList$subGroups) } if (populations > 4) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'populations' (", populations, ") max not exceed 4") } gMax <- populations kMax <- design$kMax intersectionTest <- intersectionTest[1] .assertIsValidIntersectionTestEnrichment(design, intersectionTest) if (intersectionTest == "SpiessensDebois" && gMax > 2) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "Spiessen & Debois intersection test cannot generally ", "be used for enrichment designs with more than two populations" ) } typeOfSelection <- .assertIsValidTypeOfSelection(typeOfSelection, rValue, epsilonValue, populations) if (length(typeOfSelection) == 1 && typeOfSelection == "userDefined" && !is.null(threshold) && length(threshold) == 1 && threshold != -Inf) { warning("'threshold' (", threshold, ") will be ignored because 'typeOfSelection' = \"userDefined\"", call. = FALSE) threshold <- -Inf } if (length(typeOfSelection) == 1 && typeOfSelection != "userDefined" && !is.null(selectPopulationsFunction)) { warning("'selectPopulationsFunction' will be ignored because 'typeOfSelection' is not \"userDefined\"", call. = FALSE) } else if (!is.null(selectPopulationsFunction) && is.function(selectPopulationsFunction)) { simulationResults$selectPopulationsFunction <- selectPopulationsFunction } if (endpoint %in% c("rates", "survival")) { .setValueAndParameterType(simulationResults, "directionUpper", directionUpper, TRUE) } effectList <- .getValidatedEffectList(effectList, gMax = gMax) if (endpoint == "means") { if (!stratifiedAnalysis) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "For testing means, only stratified analysis can be selected" ) } stDevH1 <- .ignoreParameterIfNotUsed( "stDevH1", stDevH1, kMax > 1, "design is fixed ('kMax' = 1)", "Assumed standard deviation" ) } else if (endpoint == "rates") { .assertIsSingleNumber(piTreatmentH1, "piTreatmentH1", naAllowed = TRUE) .assertIsInOpenInterval(piTreatmentH1, "piTreatmentH1", 0, 1, naAllowed = TRUE) piTreatmentH1 <- .ignoreParameterIfNotUsed( "piTreatmentH1", piTreatmentH1, kMax > 1, "design is fixed ('kMax' = 1)", "Assumed active rate(s)" ) # if (is.na(conditionalPower) && is.null(calcSubjectsFunction) && !is.na(piTreatmentH1)) { # warning("'piTreatmentH1' will be ignored because neither 'conditionalPower' nor ", # "'calcSubjectsFunction' is defined", call. = FALSE) # } .setValueAndParameterType(simulationResults, "piTreatmentH1", piTreatmentH1, NA_real_) .assertIsSingleNumber(piControlH1, "piControlH1", naAllowed = TRUE) .assertIsInOpenInterval(piControlH1, "piControlH1", 0, 1, naAllowed = TRUE) piControlH1 <- .ignoreParameterIfNotUsed( "piControlH1", piControlH1, kMax > 1, "design is fixed ('kMax' = 1)", "Assumed control rate(s)" ) # if (is.na(conditionalPower) && is.null(calcSubjectsFunction) && !is.na(piControlH1)) { # warning("'piControlH1' will be ignored because neither 'conditionalPower' nor ", # "'calcSubjectsFunction' is defined", call. = FALSE) # } .setValueAndParameterType(simulationResults, "piControlH1", piControlH1, NA_real_) } else if (endpoint == "survival") { if (!stratifiedAnalysis) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "For survival designs, only stratified analysis is possible" ) } .assertIsIntegerVector(plannedEvents, "plannedEvents", validateType = FALSE) if (length(plannedEvents) != kMax) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'plannedEvents' (", .arrayToString(plannedEvents), ") must have length ", kMax ) } .assertIsInClosedInterval(plannedEvents, "plannedEvents", lower = 1, upper = NULL) .assertValuesAreStrictlyIncreasing(plannedEvents, "plannedEvents") .setValueAndParameterType(simulationResults, "plannedEvents", plannedEvents, NA_real_) } .assertIsValidThreshold(threshold, gMax) if (endpoint %in% c("means", "rates")) { .assertIsValidPlannedSubjects(plannedSubjects, kMax) # means + rates only } if (endpoint %in% c("means", "survival")) { thetaH1 <- .ignoreParameterIfNotUsed( "thetaH1", thetaH1, kMax > 1, "design is fixed ('kMax' = 1)", "Assumed effect" ) } if (endpoint == "means") { # if (is.na(conditionalPower) && is.null(calcSubjectsFunction) && !is.na(thetaH1)) { # warning("'thetaH1' will be ignored because neither 'conditionalPower' nor ", # "'calcSubjectsFunction' is defined", call. = FALSE) # } # if (is.na(conditionalPower) && is.null(calcSubjectsFunction) && !is.na(stDevH1)) { # warning("'stDevH1' will be ignored because neither 'conditionalPower' nor ", # "'calcSubjectsFunction' is defined", call. = FALSE) # } } if (endpoint == "survival") { # if (is.na(conditionalPower) && is.null(calcEventsFunction) && !is.na(thetaH1)) { # warning("'thetaH1' will be ignored because neither 'conditionalPower' nor ", # "'calcEventsFunction' is defined", call. = FALSE) # } } conditionalPower <- .ignoreParameterIfNotUsed( "conditionalPower", conditionalPower, kMax > 1, "design is fixed ('kMax' = 1)" ) if (endpoint %in% c("means", "rates")) { # means + rates only minNumberOfSubjectsPerStage <- .ignoreParameterIfNotUsed( "minNumberOfSubjectsPerStage", minNumberOfSubjectsPerStage, kMax > 1, "design is fixed ('kMax' = 1)" ) minNumberOfSubjectsPerStage <- .assertIsValidNumberOfSubjectsPerStage(minNumberOfSubjectsPerStage, "minNumberOfSubjectsPerStage", plannedSubjects, conditionalPower, calcSubjectsFunction, kMax, endpoint = endpoint ) maxNumberOfSubjectsPerStage <- .ignoreParameterIfNotUsed( "maxNumberOfSubjectsPerStage", maxNumberOfSubjectsPerStage, kMax > 1, "design is fixed ('kMax' = 1)" ) maxNumberOfSubjectsPerStage <- .assertIsValidNumberOfSubjectsPerStage(maxNumberOfSubjectsPerStage, "maxNumberOfSubjectsPerStage", plannedSubjects, conditionalPower, calcSubjectsFunction, kMax, endpoint = endpoint ) if (kMax > 1) { if (!all(is.na(maxNumberOfSubjectsPerStage - minNumberOfSubjectsPerStage)) && any(maxNumberOfSubjectsPerStage - minNumberOfSubjectsPerStage < 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjectsPerStage' (", .arrayToString(maxNumberOfSubjectsPerStage), ") must be not smaller than minNumberOfSubjectsPerStage' (", .arrayToString(minNumberOfSubjectsPerStage), ")" ) } .setValueAndParameterType( simulationResults, "minNumberOfSubjectsPerStage", minNumberOfSubjectsPerStage, NA_real_ ) .setValueAndParameterType( simulationResults, "maxNumberOfSubjectsPerStage", maxNumberOfSubjectsPerStage, NA_real_ ) } } else if (endpoint == "survival") { minNumberOfEventsPerStage <- .ignoreParameterIfNotUsed( "minNumberOfEventsPerStage", minNumberOfEventsPerStage, kMax > 1, "design is fixed ('kMax' = 1)" ) minNumberOfEventsPerStage <- .assertIsValidNumberOfSubjectsPerStage(minNumberOfEventsPerStage, "minNumberOfEventsPerStage", plannedEvents, conditionalPower, calcEventsFunction, kMax, endpoint = endpoint ) maxNumberOfEventsPerStage <- .ignoreParameterIfNotUsed( "maxNumberOfEventsPerStage", maxNumberOfEventsPerStage, kMax > 1, "design is fixed ('kMax' = 1)" ) maxNumberOfEventsPerStage <- .assertIsValidNumberOfSubjectsPerStage(maxNumberOfEventsPerStage, "maxNumberOfEventsPerStage", plannedEvents, conditionalPower, calcEventsFunction, kMax, endpoint = endpoint ) if (kMax > 1) { if (!all(is.na(maxNumberOfEventsPerStage - minNumberOfEventsPerStage)) && any(maxNumberOfEventsPerStage - minNumberOfEventsPerStage < 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfEventsPerStage' (", .arrayToString(maxNumberOfEventsPerStage), ") must be not smaller than 'minNumberOfEventsPerStage' (", .arrayToString(minNumberOfEventsPerStage), ")" ) } .setValueAndParameterType( simulationResults, "minNumberOfEventsPerStage", minNumberOfEventsPerStage, NA_real_ ) .setValueAndParameterType( simulationResults, "maxNumberOfEventsPerStage", maxNumberOfEventsPerStage, NA_real_ ) } } if (kMax == 1 && !is.na(conditionalPower)) { warning("'conditionalPower' will be ignored for fixed sample design", call. = FALSE) } if (endpoint %in% c("means", "rates") && kMax == 1 && !is.null(calcSubjectsFunction)) { warning("'calcSubjectsFunction' will be ignored for fixed sample design", call. = FALSE) } if (endpoint == "survival" && kMax == 1 && !is.null(calcEventsFunction)) { warning("'calcEventsFunction' will be ignored for fixed sample design", call. = FALSE) } if (endpoint %in% c("means", "rates") && is.na(conditionalPower) && is.null(calcSubjectsFunction)) { if (length(minNumberOfSubjectsPerStage) != 1 || !is.na(minNumberOfSubjectsPerStage)) { warning("'minNumberOfSubjectsPerStage' (", .arrayToString(minNumberOfSubjectsPerStage), ") will be ignored because ", "neither 'conditionalPower' nor 'calcSubjectsFunction' is defined", call. = FALSE ) simulationResults$minNumberOfSubjectsPerStage <- NA_real_ } if (length(maxNumberOfSubjectsPerStage) != 1 || !is.na(maxNumberOfSubjectsPerStage)) { warning("'maxNumberOfSubjectsPerStage' (", .arrayToString(maxNumberOfSubjectsPerStage), ") will be ignored because ", "neither 'conditionalPower' nor 'calcSubjectsFunction' is defined", call. = FALSE ) simulationResults$maxNumberOfSubjectsPerStage <- NA_real_ } } if (endpoint == "survival" && is.na(conditionalPower) && is.null(calcEventsFunction)) { if (length(minNumberOfEventsPerStage) != 1 || !is.na(minNumberOfEventsPerStage)) { warning("'minNumberOfEventsPerStage' (", .arrayToString(minNumberOfEventsPerStage), ") ", "will be ignored because neither 'conditionalPower' nor 'calcEventsFunction' is defined", call. = FALSE ) simulationResults$minNumberOfEventsPerStage <- NA_real_ } if (length(maxNumberOfEventsPerStage) != 1 || !is.na(maxNumberOfEventsPerStage)) { warning("'maxNumberOfEventsPerStage' (", .arrayToString(maxNumberOfEventsPerStage), ") ", "will be ignored because neither 'conditionalPower' nor 'calcEventsFunction' is defined", call. = FALSE ) simulationResults$maxNumberOfEventsPerStage <- NA_real_ } } if (endpoint %in% c("means", "rates")) { simulationResults$.setParameterType( "calcSubjectsFunction", ifelse(kMax == 1, C_PARAM_NOT_APPLICABLE, ifelse(!is.null(calcSubjectsFunction) && kMax > 1, C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE) ) ) } else if (endpoint == "survival") { simulationResults$.setParameterType( "calcEventsFunction", ifelse(kMax == 1, C_PARAM_NOT_APPLICABLE, ifelse(!is.null(calcEventsFunction) && kMax > 1, C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE) ) ) } if (endpoint == "means") { if (is.null(calcSubjectsFunction)) { calcSubjectsFunction <- .getSimulationMeansEnrichmentStageSubjects } else { .assertIsValidFunction( fun = calcSubjectsFunction, funArgName = "calcSubjectsFunction", expectedFunction = .getSimulationMeansEnrichmentStageSubjects ) } simulationResults$calcSubjectsFunction <- calcSubjectsFunction } else if (endpoint == "rates") { if (is.null(calcSubjectsFunction)) { calcSubjectsFunction <- .getSimulationRatesEnrichmentStageSubjects } else { .assertIsValidFunction( fun = calcSubjectsFunction, funArgName = "calcSubjectsFunction", expectedFunction = .getSimulationRatesEnrichmentStageSubjects ) } simulationResults$calcSubjectsFunction <- calcSubjectsFunction } else if (endpoint == "survival") { if (is.null(calcEventsFunction)) { calcEventsFunction <- .getSimulationSurvivalEnrichmentStageEvents } else { .assertIsValidFunction( fun = calcEventsFunction, funArgName = "calcEventsFunction", expectedFunction = .getSimulationSurvivalEnrichmentStageEvents ) } simulationResults$calcEventsFunction <- calcEventsFunction } if (is.na(allocationRatioPlanned)) { allocationRatioPlanned <- C_ALLOCATION_RATIO_DEFAULT } .setValueAndParameterType( simulationResults, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT ) if (endpoint %in% c("means", "rates")) { .setValueAndParameterType(simulationResults, "plannedSubjects", plannedSubjects, NA_real_) .setValueAndParameterType(simulationResults, "minNumberOfSubjectsPerStage", minNumberOfSubjectsPerStage, NA_real_, notApplicableIfNA = TRUE ) .setValueAndParameterType(simulationResults, "maxNumberOfSubjectsPerStage", maxNumberOfSubjectsPerStage, NA_real_, notApplicableIfNA = TRUE ) } else if (endpoint == "survival") { .setValueAndParameterType(simulationResults, "plannedEvents", plannedEvents, NA_real_) .setValueAndParameterType(simulationResults, "minNumberOfEventsPerStage", minNumberOfEventsPerStage, NA_real_, notApplicableIfNA = TRUE ) .setValueAndParameterType(simulationResults, "maxNumberOfEventsPerStage", maxNumberOfEventsPerStage, NA_real_, notApplicableIfNA = TRUE ) } .setValueAndParameterType(simulationResults, "conditionalPower", conditionalPower, NA_real_, notApplicableIfNA = TRUE ) if (endpoint %in% c("means", "survival")) { .setValueAndParameterType(simulationResults, "thetaH1", thetaH1, NA_real_, notApplicableIfNA = TRUE) } if (endpoint == "means") { .setValueAndParameterType(simulationResults, "stDevH1", stDevH1, NA_real_, notApplicableIfNA = TRUE) } .setValueAndParameterType( simulationResults, "maxNumberOfIterations", as.integer(maxNumberOfIterations), C_MAX_SIMULATION_ITERATIONS_DEFAULT ) simulationResults$.setParameterType("seed", ifelse(is.na(seed), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) simulationResults$seed <- .setSeed(seed) if (is.null(adaptations) || all(is.na(adaptations))) { adaptations <- rep(TRUE, kMax - 1) } if (length(adaptations) != kMax - 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'adaptations' must have length ", (kMax - 1), " (kMax - 1)") } .setValueAndParameterType(simulationResults, "adaptations", adaptations, rep(TRUE, kMax - 1)) simulationResults$.setParameterType("effectList", C_PARAM_USER_DEFINED) simulationResults$effectList <- effectList .setValueAndParameterType( simulationResults, "stratifiedAnalysis", stratifiedAnalysis, C_STRATIFIED_ANALYSIS_DEFAULT ) .setValueAndParameterType(simulationResults, "populations", as.integer(populations), C_POPULATIONS_DEFAULT) if (typeOfSelection != "userDefined") { .setValueAndParameterType(simulationResults, "threshold", threshold, -Inf) .setValueAndParameterType(simulationResults, "epsilonValue", epsilonValue, NA_real_) .setValueAndParameterType(simulationResults, "rValue", rValue, NA_real_) } .setValueAndParameterType(simulationResults, "intersectionTest", intersectionTest, C_INTERSECTION_TEST_ENRICHMENT_DEFAULT) .setValueAndParameterType(simulationResults, "typeOfSelection", typeOfSelection, C_TYPE_OF_SELECTION_DEFAULT) .setValueAndParameterType(simulationResults, "successCriterion", successCriterion, C_SUCCESS_CRITERION_DEFAULT) .setValueAndParameterType(simulationResults, "effectMeasure", effectMeasure, C_EFFECT_MEASURE_DEFAULT) warning("Simulation of enrichment designs is experimental and hence not fully validated", call. = FALSE) return(simulationResults) } rpact/R/pkgname.R0000644000175000017500000001011014145656365013473 0ustar nileshnilesh## | ## | *rpact* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' #' @title #' rpact - Confirmatory Adaptive Clinical Trial Design and Analysis #' #' @description #' rpact (R Package for Adaptive Clinical Trials) is a comprehensive package that enables #' the design and analysis of confirmatory adaptive group sequential designs. #' Particularly, the methods described in the recent monograph by Wassmer and Brannath #' (published by Springer, 2016) are implemented. It also comprises advanced methods for sample #' size calculations for fixed sample size designs incl., e.g., sample size calculation for survival #' trials with piecewise exponentially distributed survival times and staggered patients entry. #' #' @details #' rpact includes the classical group sequential designs (incl. user spending function approaches) #' where the sample sizes per stage (or the time points of interim analysis) cannot be changed #' in a data-driven way. #' Confirmatory adaptive designs explicitly allow for this under control of the Type I error rate. #' They are either based on the combination testing or the conditional rejection #' probability (CRP) principle. #' Both are available, for the former the inverse normal combination test and #' Fisher's combination test can be used. #' #' Specific techniques of the adaptive methodology are also available, e.g., #' overall confidence intervals, overall p-values, and conditional and predictive power assessments. #' Simulations can be performed to assess the design characteristics of a (user-defined) sample size #' recalculation strategy. Designs are available for trials with continuous, binary, and survival endpoint. #' #' For more information please visit \href{https://www.rpact.org}{www.rpact.org}. #' If you are interested in professional services round about the package or need #' a comprehensive validation documentation to fulfill regulatory requirements #' please visit \href{https://www.rpact.com}{www.rpact.com}. #' #' rpact is developed by #' \itemize{ #' \item Gernot Wassmer (\email{gernot.wassmer@@rpact.com}) and #' \item Friedrich Pahlke (\email{friedrich.pahlke@@rpact.com}). #' } #' #' @references #' Wassmer, G., Brannath, W. (2016) Group Sequential and Confirmatory Adaptive Designs #' in Clinical Trials (Springer Series in Pharmaceutical Statistics; \doi{10.1007/978-3-319-32562-0}) #' #' @docType package #' @author Gernot Wassmer, Friedrich Pahlke #' @importFrom Rcpp evalCpp #' @useDynLib rpact, .registration = TRUE #' @name rpact #' #' @import methods #' @import stats #' @import utils #' @import graphics #' @import tools #' "_PACKAGE" #> [1] "_PACKAGE" .onLoad <- function(libname, pkgname) { } .onAttach <- function(libname, pkgname) { if (grepl("^\\d\\.\\d\\.\\d\\.\\d{4,4}$", packageVersion("rpact"))) { packageStartupMessage(paste0("rpact developer version ", packageVersion("rpact"), " loaded")) } } .onUnload <- function(libpath) { if (!is.null(.parallelComputingCluster)) { tryCatch({ parallel::stopCluster(.parallelComputingCluster) }, error = function(e) { .logWarn("Failed to stop parallel computing cluster", e) }) } tryCatch({ library.dynam.unload("rpact", libpath) }, error = function(e) { .logWarn("Failed to unload dynamic C library", e) }) } .onDetach <- function(libpath) { packageStartupMessage(paste0("rpact ", packageVersion("rpact"), " successfully unloaded\n")) } rpact/R/f_simulation_base_survival.R0000644000175000017500000011622114153433457017473 0ustar nileshnilesh## | ## | *Simulation of survival data with group sequential and combination test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5620 $ ## | Last changed: $Date: 2021-12-06 17:15:42 +0100 (Mo, 06 Dez 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include class_simulation_results.R NULL .isLambdaBasedSimulationEnabled <- function(pwsTimeObject) { if (!pwsTimeObject$.isLambdaBased()) { return(FALSE) } if (pwsTimeObject$delayedResponseEnabled) { return(TRUE) } if (pwsTimeObject$piecewiseSurvivalEnabled) { return(TRUE) } if (pwsTimeObject$kappa != 1) { if (length(pwsTimeObject$lambda1) != 1) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "if 'kappa' != 1 then 'lambda1' (", .arrayToString(pwsTimeObject$lambda1), ") must be a single numeric value" ) } if (length(pwsTimeObject$lambda2) != 1) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "if 'kappa' != 1 then 'lambda2' (", .arrayToString(pwsTimeObject$lambda2), ") must be a single numeric value" ) } return(TRUE) } if (pwsTimeObject$.getParameterType("hazardRatio") == C_PARAM_USER_DEFINED && !all(is.na(pwsTimeObject$hazardRatio))) { if (pwsTimeObject$.getParameterType("lambda1") == C_PARAM_USER_DEFINED && length(pwsTimeObject$lambda1) == length(pwsTimeObject$hazardRatio) && !all(is.na(pwsTimeObject$lambda1))) { return(TRUE) } if (pwsTimeObject$.getParameterType("lambda2") == C_PARAM_USER_DEFINED && length(pwsTimeObject$lambda2) == length(pwsTimeObject$hazardRatio) && !all(is.na(pwsTimeObject$lambda2))) { return(TRUE) } } return(FALSE) } #' @title #' Get Simulation Survival #' #' @description #' Returns the analysis times, power, stopping probabilities, conditional power, and expected sample size #' for testing the hazard ratio in a two treatment groups survival design. #' #' @inheritParams param_design_with_default #' @inheritParams param_thetaH0 #' @inheritParams param_directionUpper #' @inheritParams param_pi1_survival #' @inheritParams param_pi2_survival #' @inheritParams param_lambda1 #' @inheritParams param_lambda2 #' @inheritParams param_median1 #' @inheritParams param_median2 #' @inheritParams param_hazardRatio #' @inheritParams param_piecewiseSurvivalTime #' @inheritParams param_kappa #' @param allocation1 The number how many subjects are assigned to treatment 1 in a #' subsequent order, default is \code{1} #' @param allocation2 The number how many subjects are assigned to treatment 2 in a #' subsequent order, default is \code{1} #' @inheritParams param_eventTime #' @inheritParams param_accrualTime #' @inheritParams param_accrualIntensity #' @inheritParams param_accrualIntensityType #' @inheritParams param_dropoutRate1 #' @inheritParams param_dropoutRate2 #' @inheritParams param_dropoutTime #' @inheritParams param_maxNumberOfSubjects_survival #' @inheritParams param_plannedEvents #' @inheritParams param_minNumberOfEventsPerStage #' @inheritParams param_maxNumberOfEventsPerStage #' @inheritParams param_conditionalPowerSimulation #' @inheritParams param_thetaH1 #' @inheritParams param_maxNumberOfIterations #' @inheritParams param_showStatistics #' @param maxNumberOfRawDatasetsPerStage The number of raw datasets per stage that shall #' be extracted and saved as \code{\link[base]{data.frame}}, default is \code{0}. #' \code{\link{getRawData}} can be used to get the extracted raw data from the object. #' @param longTimeSimulationAllowed Logical that indicates whether long time simulations #' that consumes more than 30 seconds are allowed or not, default is \code{FALSE}. #' @inheritParams param_seed #' @inheritParams param_three_dots #' #' @details #' At given design the function simulates the power, stopping probabilities, conditional power, and expected #' sample size at given number of events, number of subjects, and parameter configuration. #' It also simulates the time when the required events are expected under the given #' assumptions (exponentially, piecewise exponentially, or Weibull distributed survival times #' and constant or non-constant piecewise accrual). #' Additionally, integers \code{allocation1} and \code{allocation2} can be specified that determine the number allocated #' to treatment group 1 and treatment group 2, respectively. #' #' \code{conditionalPower}\cr #' The definition of \code{thetaH1} makes only sense if \code{kMax} > 1 #' and if \code{conditionalPower}, \code{minNumberOfEventsPerStage}, and #' \code{maxNumberOfEventsPerStage} are defined. #' #' Note that \code{numberOfSubjects}, \code{numberOfSubjects1}, and \code{numberOfSubjects2} in the output #' are expected number of subjects. #' #' @template details_piecewise_survival #' #' @template details_piecewise_accrual #' #' @section Simulation Data: #' The summary statistics "Simulated data" contains the following parameters: median [range]; mean +/-sd\cr #' #' \code{$show(showStatistics = FALSE)} or \code{$setShowStatistics(FALSE)} can be used to disable #' the output of the aggregated simulated data.\cr #' #' Example 1: \cr #' \code{simulationResults <- getSimulationSurvival(maxNumberOfSubjects = 100, plannedEvents = 30)} \cr #' \code{simulationResults$show(showStatistics = FALSE)}\cr #' #' Example 2: \cr #' \code{simulationResults <- getSimulationSurvival(maxNumberOfSubjects = 100, plannedEvents = 30)} \cr #' \code{simulationResults$setShowStatistics(FALSE)}\cr #' \code{simulationResults}\cr #' #' \code{\link{getData}} can be used to get the aggregated simulated data from the #' object as \code{\link[base]{data.frame}}. The data frame contains the following columns: #' \enumerate{ #' \item \code{iterationNumber}: The number of the simulation iteration. #' \item \code{stageNumber}: The stage. #' \item \code{pi1}: The assumed or derived event rate in the treatment group. #' \item \code{pi2}: The assumed or derived event rate in the control group. #' \item \code{hazardRatio}: The hazard ratio under consideration (if available). #' \item \code{analysisTime}: The analysis time. #' \item \code{numberOfSubjects}: The number of subjects under consideration when the #' (interim) analysis takes place. #' \item \code{eventsPerStage1}: The observed number of events per stage #' in treatment group 1. #' \item \code{eventsPerStage2}: The observed number of events per stage #' in treatment group 2. #' \item \code{eventsPerStage}: The observed number of events per stage #' in both treatment groups. #' \item \code{rejectPerStage}: 1 if null hypothesis can be rejected, 0 otherwise. #' \item \code{futilityPerStage}: 1 if study should be stopped for futility, 0 otherwise. #' \item \code{eventsNotAchieved}: 1 if number of events could not be reached with #' observed number of subjects, 0 otherwise. #' \item \code{testStatistic}: The test statistic that is used for the test decision, #' depends on which design was chosen (group sequential, inverse normal, #' or Fisher combination test)' #' \item \code{logRankStatistic}: Z-score statistic which corresponds to a one-sided #' log-rank test at considered stage. #' \item \code{hazardRatioEstimateLR}: The estimated hazard ratio, derived from the #' log-rank statistic. #' \item \code{trialStop}: \code{TRUE} if study should be stopped for efficacy or futility or final stage, \code{FALSE} otherwise. #' \item \code{conditionalPowerAchieved}: The conditional power for the subsequent stage of the trial for #' selected sample size and effect. The effect is either estimated from the data or can be #' user defined with \code{thetaH1}. #' } #' #' @section Raw Data: #' \code{\link{getRawData}} can be used to get the simulated raw data from the #' object as \code{\link[base]{data.frame}}. Note that \code{getSimulationSurvival} #' must called before with \code{maxNumberOfRawDatasetsPerStage} > 0. #' The data frame contains the following columns: #' \enumerate{ #' \item \code{iterationNumber}: The number of the simulation iteration. #' \item \code{stopStage}: The stage of stopping. #' \item \code{subjectId}: The subject id (increasing number 1, 2, 3, ...) #' \item \code{accrualTime}: The accrual time, i.e., the time when the subject entered the trial. #' \item \code{treatmentGroup}: The treatment group number (1 or 2). #' \item \code{survivalTime}: The survival time of the subject. #' \item \code{dropoutTime}: The dropout time of the subject (may be \code{NA}). #' \item \code{observationTime}: The specific observation time. #' \item \code{timeUnderObservation}: The time under observation is defined as follows:\cr #' if (event == TRUE) {\cr #' timeUnderObservation <- survivalTime;\cr #' } else if (dropoutEvent == TRUE) {\cr #' timeUnderObservation <- dropoutTime;\cr #' } else {\cr #' timeUnderObservation <- observationTime - accrualTime;\cr #' } #' \item \code{event}: \code{TRUE} if an event occurred; \code{FALSE} otherwise. #' \item \code{dropoutEvent}: \code{TRUE} if an dropout event occurred; \code{FALSE} otherwise. #' } #' #' @template return_object_simulation_results #' @template how_to_get_help_for_generics #' #' @template examples_get_simulation_survival #' #' @export #' getSimulationSurvival <- function(design = NULL, ..., thetaH0 = 1, # C_THETA_H0_SURVIVAL_DEFAULT directionUpper = TRUE, # C_DIRECTION_UPPER_DEFAULT pi1 = NA_real_, pi2 = NA_real_, lambda1 = NA_real_, lambda2 = NA_real_, median1 = NA_real_, median2 = NA_real_, hazardRatio = NA_real_, kappa = 1, piecewiseSurvivalTime = NA_real_, allocation1 = 1, # C_ALLOCATION_1_DEFAULT allocation2 = 1, # C_ALLOCATION_2_DEFAULT eventTime = 12L, # C_EVENT_TIME_DEFAULT accrualTime = c(0L, 12L), # C_ACCRUAL_TIME_DEFAULT accrualIntensity = 0.1, # C_ACCRUAL_INTENSITY_DEFAULT accrualIntensityType = c("auto", "absolute", "relative"), dropoutRate1 = 0, # C_DROP_OUT_RATE_1_DEFAULT dropoutRate2 = 0, # C_DROP_OUT_RATE_2_DEFAULT dropoutTime = 12L, # C_DROP_OUT_TIME_DEFAULT maxNumberOfSubjects = NA_real_, plannedEvents = NA_real_, minNumberOfEventsPerStage = NA_real_, maxNumberOfEventsPerStage = NA_real_, conditionalPower = NA_real_, thetaH1 = NA_real_, maxNumberOfIterations = 1000L, # C_MAX_SIMULATION_ITERATIONS_DEFAULT maxNumberOfRawDatasetsPerStage = 0, longTimeSimulationAllowed = FALSE, seed = NA_real_, showStatistics = FALSE) { .assertRcppIsInstalled() if (is.null(design)) { design <- .getDefaultDesign(..., type = "simulation") .warnInCaseOfUnknownArguments( functionName = "getSimulationSurvival", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "showStatistics"), ... ) } else { .assertIsTrialDesign(design) .warnInCaseOfUnknownArguments( functionName = "getSimulationSurvival", ignore = "showStatistics", ... ) .warnInCaseOfTwoSidedPowerArgument(...) } .assertIsSingleLogical(directionUpper, "directionUpper") .assertIsSingleNumber(thetaH0, "thetaH0") .assertIsInOpenInterval(thetaH0, "thetaH0", 0, NULL, naAllowed = TRUE) .assertIsNumericVector(minNumberOfEventsPerStage, "minNumberOfEventsPerStage", naAllowed = TRUE) .assertIsNumericVector(maxNumberOfEventsPerStage, "maxNumberOfEventsPerStage", naAllowed = TRUE) .assertIsSingleNumber(conditionalPower, "conditionalPower", naAllowed = TRUE) .assertIsInOpenInterval(conditionalPower, "conditionalPower", 0, 1, naAllowed = TRUE) .assertIsSingleNumber(thetaH1, "thetaH1", naAllowed = TRUE) .assertIsInOpenInterval(thetaH1, "thetaH1", 0, NULL, naAllowed = TRUE) .assertIsSinglePositiveInteger(maxNumberOfIterations, "maxNumberOfIterations", validateType = FALSE) .assertIsSingleNumber(seed, "seed", naAllowed = TRUE) .assertIsNumericVector(lambda1, "lambda1", naAllowed = TRUE) .assertIsNumericVector(lambda2, "lambda2", naAllowed = TRUE) .assertIsSinglePositiveInteger(maxNumberOfSubjects, "maxNumberOfSubjects", validateType = FALSE, naAllowed = TRUE ) .assertIsSinglePositiveInteger(allocation1, "allocation1", validateType = FALSE) .assertIsSinglePositiveInteger(allocation2, "allocation2", validateType = FALSE) .assertIsSingleLogical(longTimeSimulationAllowed, "longTimeSimulationAllowed") .assertIsSingleLogical(showStatistics, "showStatistics", naAllowed = FALSE) if (design$sided == 2) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "Only one-sided case is implemented for the survival simulation design" ) } if (!all(is.na(lambda2)) && !all(is.na(lambda1)) && length(lambda2) != length(lambda1) && length(lambda2) > 1) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'lambda2' (", length(lambda2), ") must be equal to length of 'lambda1' (", length(lambda1), ")" ) } if (all(is.na(lambda2)) && !all(is.na(lambda1))) { warning("'lambda1' (", .arrayToString(lambda1), ") will be ignored ", "because 'lambda2' (", .arrayToString(lambda2), ") is undefined", call. = FALSE ) lambda1 <- NA_real_ } if (!all(is.na(lambda2)) && is.list(piecewiseSurvivalTime)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' needs to be a numeric vector and not a list ", "because 'lambda2' (", .arrayToString(lambda2), ") is defined separately" ) } thetaH1 <- .ignoreParameterIfNotUsed( "thetaH1", thetaH1, design$kMax > 1, "design is fixed ('kMax' = 1)", "Assumed effect" ) if (is.na(conditionalPower) && !is.na(thetaH1)) { warning("'thetaH1' will be ignored because 'conditionalPower' is not defined", call. = FALSE) } conditionalPower <- .ignoreParameterIfNotUsed( "conditionalPower", conditionalPower, design$kMax > 1, "design is fixed ('kMax' = 1)" ) minNumberOfEventsPerStage <- .ignoreParameterIfNotUsed( "minNumberOfEventsPerStage", minNumberOfEventsPerStage, design$kMax > 1, "design is fixed ('kMax' = 1)" ) maxNumberOfEventsPerStage <- .ignoreParameterIfNotUsed( "maxNumberOfEventsPerStage", maxNumberOfEventsPerStage, design$kMax > 1, "design is fixed ('kMax' = 1)" ) minNumberOfEventsPerStage <- .assertIsValidNumberOfSubjectsPerStage(minNumberOfEventsPerStage, "minNumberOfEventsPerStage", plannedEvents, conditionalPower, NULL, design$kMax, endpoint = "survival", calcSubjectsFunctionEnabled = FALSE ) maxNumberOfEventsPerStage <- .assertIsValidNumberOfSubjectsPerStage(maxNumberOfEventsPerStage, "maxNumberOfEventsPerStage", plannedEvents, conditionalPower, NULL, design$kMax, endpoint = "survival", calcSubjectsFunctionEnabled = FALSE ) simulationResults <- SimulationResultsSurvival(design, showStatistics = showStatistics) if (!is.na(conditionalPower)) { if (design$kMax > 1) { if (any(maxNumberOfEventsPerStage - minNumberOfEventsPerStage < 0) && !all(is.na(maxNumberOfEventsPerStage - minNumberOfEventsPerStage))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfEventsPerStage' (", .arrayToString(maxNumberOfEventsPerStage), ") must be not smaller than minNumberOfEventsPerStage' (", .arrayToString(minNumberOfEventsPerStage), ")" ) } .setValueAndParameterType( simulationResults, "minNumberOfEventsPerStage", minNumberOfEventsPerStage, NA_real_ ) .setValueAndParameterType( simulationResults, "maxNumberOfEventsPerStage", maxNumberOfEventsPerStage, NA_real_ ) } else { warning("'conditionalPower' will be ignored for fixed sample design", call. = FALSE) } } else { simulationResults$minNumberOfEventsPerStage <- NA_real_ simulationResults$maxNumberOfEventsPerStage <- NA_real_ simulationResults$.setParameterType("minNumberOfEventsPerStage", C_PARAM_NOT_APPLICABLE) simulationResults$.setParameterType("maxNumberOfEventsPerStage", C_PARAM_NOT_APPLICABLE) simulationResults$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) } if (!is.na(conditionalPower) && (design$kMax == 1)) { warning("'conditionalPower' will be ignored for fixed sample design", call. = FALSE) } accrualSetup <- getAccrualTime( accrualTime = accrualTime, accrualIntensity = accrualIntensity, accrualIntensityType = accrualIntensityType, maxNumberOfSubjects = maxNumberOfSubjects ) if (is.na(accrualSetup$maxNumberOfSubjects)) { if (identical(accrualIntensity, 1L)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "choose a 'accrualIntensity' > 1 or define 'maxNumberOfSubjects'" ) } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjects' must be defined" ) } simulationResults$.setParameterType("seed", ifelse(is.na(seed), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) simulationResults$seed <- .setSeed(seed) simulationResults$.accrualTime <- accrualSetup accrualTime <- accrualSetup$.getAccrualTimeWithoutLeadingZero() simulationResults$maxNumberOfSubjects <- accrualSetup$maxNumberOfSubjects simulationResults$.setParameterType( "maxNumberOfSubjects", accrualSetup$.getParameterType("maxNumberOfSubjects") ) simulationResults$accrualTime <- accrualSetup$.getAccrualTimeWithoutLeadingZero() simulationResults$.setParameterType("accrualTime", accrualSetup$.getParameterType("accrualTime")) simulationResults$accrualIntensity <- accrualSetup$accrualIntensity simulationResults$.setParameterType( "accrualIntensity", accrualSetup$.getParameterType("accrualIntensity") ) .assertIsIntegerVector(plannedEvents, "plannedEvents", validateType = FALSE) if (length(plannedEvents) != design$kMax) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'plannedEvents' (", .arrayToString(plannedEvents), ") must have length ", design$kMax ) } .assertIsInClosedInterval(plannedEvents, "plannedEvents", lower = 1, upper = NULL) .assertValuesAreStrictlyIncreasing(plannedEvents, "plannedEvents") simulationResults$plannedEvents <- plannedEvents simulationResults$.setParameterType("plannedEvents", C_PARAM_USER_DEFINED) pwsTimeObject <- getPiecewiseSurvivalTime( piecewiseSurvivalTime = piecewiseSurvivalTime, lambda2 = lambda2, lambda1 = lambda1, median1 = median1, median2 = median2, hazardRatio = hazardRatio, pi1 = pi1, pi2 = pi2, eventTime = eventTime, kappa = kappa, delayedResponseAllowed = TRUE, .pi1Default = C_PI_1_DEFAULT ) simulationResults$.piecewiseSurvivalTime <- pwsTimeObject simulationResults$hazardRatio <- pwsTimeObject$hazardRatio simulationResults$.setParameterType("hazardRatio", pwsTimeObject$.getParameterType("hazardRatio")) simulationResults$.setParameterType("eventTime", pwsTimeObject$.getParameterType("eventTime")) simulationResults$eventTime <- pwsTimeObject$eventTime if (.isLambdaBasedSimulationEnabled(pwsTimeObject)) { simulationResults$piecewiseSurvivalTime <- pwsTimeObject$piecewiseSurvivalTime simulationResults$.setParameterType("piecewiseSurvivalTime", C_PARAM_USER_DEFINED) simulationResults$lambda2 <- pwsTimeObject$lambda2 simulationResults$.setParameterType("lambda2", pwsTimeObject$.getParameterType("lambda2")) lambdaVec2 <- simulationResults$lambda2 simulationResults$lambda1 <- pwsTimeObject$lambda1 simulationResults$.setParameterType("lambda1", pwsTimeObject$.getParameterType("lambda1")) if (any(is.na(pwsTimeObject$lambda1))) { .assertIsValidHazardRatioVector(pwsTimeObject$hazardRatio) .setValueAndParameterType( simulationResults, "hazardRatio", pwsTimeObject$hazardRatio, NA_real_ ) numberOfResults <- length(simulationResults$hazardRatio) lambdaVec1 <- simulationResults$lambda2 * pwsTimeObject$hazardRatio } else { numberOfResults <- 1 lambdaVec1 <- pwsTimeObject$lambda1 } .warnInCaseOfDefinedPiValue(simulationResults, "pi1") .warnInCaseOfDefinedPiValue(simulationResults, "pi2") simulationResults$pi1 <- pwsTimeObject$pi1 simulationResults$pi2 <- pwsTimeObject$pi2 simulationResults$.setParameterType("pi1", pwsTimeObject$.getParameterType("pi1")) simulationResults$.setParameterType("pi2", pwsTimeObject$.getParameterType("pi2")) simulationResults$median1 <- pwsTimeObject$median1 simulationResults$median2 <- pwsTimeObject$median2 simulationResults$.setParameterType("median1", pwsTimeObject$.getParameterType("median1")) simulationResults$.setParameterType("median2", pwsTimeObject$.getParameterType("median2")) cdfValues1 <- .getPiecewiseExponentialDistribution( pwsTimeObject$piecewiseSurvivalTime, lambdaVec1, pwsTimeObject$piecewiseSurvivalTime, kappa = kappa ) cdfValues2 <- .getPiecewiseExponentialDistribution( pwsTimeObject$piecewiseSurvivalTime, lambdaVec2, pwsTimeObject$piecewiseSurvivalTime, kappa = kappa ) if (length(cdfValues1) == 1) { cdfValues1 <- NA_real_ cdfValues2 <- NA_real_ } else { cdfValues1 <- cdfValues1[2:length(cdfValues1)] # use values without a leading 0 cdfValues2 <- cdfValues2[2:length(cdfValues2)] } pi1 <- NA_real_ pi2 <- NA_real_ } else { numberOfResults <- .initDesignPlanSurvivalByPiecewiseSurvivalTimeObject( simulationResults, pwsTimeObject ) pi1 <- simulationResults$pi1 if (all(is.na(pi1))) { pi1 <- getPiByLambda(simulationResults$lambda1, eventTime = eventTime, kappa = kappa) simulationResults$pi1 <- pi1 simulationResults$.setParameterType("pi1", C_PARAM_GENERATED) } pi2 <- simulationResults$pi2 if (all(is.na(pi2))) { pi2 <- getPiByLambda(simulationResults$lambda2, eventTime = eventTime, kappa = kappa) simulationResults$pi2 <- pi2 simulationResults$.setParameterType("pi2", C_PARAM_GENERATED) } simulationResults$piecewiseSurvivalTime <- NA_real_ lambdaVec1 <- NA_real_ lambdaVec2 <- NA_real_ cdfValues1 <- NA_real_ cdfValues2 <- NA_real_ } numberOfSimStepsTotal <- numberOfResults * maxNumberOfIterations * accrualSetup$maxNumberOfSubjects maxNumberOfSimStepsTotal <- 10 * 100000 * 100 if (numberOfSimStepsTotal > maxNumberOfSimStepsTotal) { if (!longTimeSimulationAllowed) { stop( "Simulation stopped because long time simulation is disabled ", "and the defined number of single simulation steps (", numberOfSimStepsTotal, ") is larger than the threshold ", maxNumberOfSimStepsTotal, ". ", "Set 'longTimeSimulationAllowed = TRUE' to enable simulations ", "that take a long time (> 30 sec)" ) } message( "Note that the simulation may take a long time because ", sprintf("%.0f", numberOfSimStepsTotal), " single simulation steps must be calculated" ) } .setValueAndParameterType(simulationResults, "directionUpper", directionUpper, C_DIRECTION_UPPER_DEFAULT) .setValueAndParameterType(simulationResults, "dropoutRate1", dropoutRate1, C_DROP_OUT_RATE_1_DEFAULT) .setValueAndParameterType(simulationResults, "dropoutRate2", dropoutRate2, C_DROP_OUT_RATE_2_DEFAULT) .setValueAndParameterType(simulationResults, "dropoutTime", dropoutTime, C_DROP_OUT_TIME_DEFAULT) .setValueAndParameterType(simulationResults, "thetaH0", thetaH0, C_THETA_H0_SURVIVAL_DEFAULT) .setValueAndParameterType(simulationResults, "allocation1", allocation1, C_ALLOCATION_1_DEFAULT) .setValueAndParameterType(simulationResults, "allocation2", allocation2, C_ALLOCATION_2_DEFAULT) allocationRatioPlanned <- allocation1 / allocation2 .setValueAndParameterType( simulationResults, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT ) .setValueAndParameterType(simulationResults, "conditionalPower", conditionalPower, NA_real_) if (!is.na(thetaH0) && !is.na(thetaH1) && thetaH0 != 1) { thetaH1 <- thetaH1 / thetaH0 .setValueAndParameterType(simulationResults, "thetaH1", thetaH1, NA_real_) simulationResults$.setParameterType("thetaH1", C_PARAM_GENERATED) } else { .setValueAndParameterType(simulationResults, "thetaH1", thetaH1, NA_real_) } if (is.na(conditionalPower)) { simulationResults$.setParameterType("thetaH1", C_PARAM_NOT_APPLICABLE) } .setValueAndParameterType(simulationResults, "kappa", kappa, 1) .setValueAndParameterType( simulationResults, "maxNumberOfIterations", as.integer(maxNumberOfIterations), C_MAX_SIMULATION_ITERATIONS_DEFAULT ) phi <- -c(log(1 - dropoutRate1), log(1 - dropoutRate2)) / dropoutTime densityIntervals <- accrualTime if (length(accrualTime) > 1) { densityIntervals[2:length(accrualTime)] <- accrualTime[2:length(accrualTime)] - accrualTime[1:(length(accrualTime) - 1)] } densityVector <- accrualSetup$accrualIntensity / sum(densityIntervals * accrualSetup$accrualIntensity) intensityReplications <- round(densityVector * densityIntervals * accrualSetup$maxNumberOfSubjects) if (all(intensityReplications > 0)) { accrualTimeValue <- cumsum(rep( 1 / (densityVector * accrualSetup$maxNumberOfSubjects), intensityReplications )) } else { accrualTimeValue <- cumsum(rep( 1 / (densityVector[1] * accrualSetup$maxNumberOfSubjects), intensityReplications[1] )) if (length(accrualIntensity) > 1) { for (i in 2:length(accrualIntensity)) { if (intensityReplications[i] > 0) { accrualTimeValue <- c(accrualTimeValue, accrualTime[i - 1] + cumsum(rep( 1 / (densityVector[i] * accrualSetup$maxNumberOfSubjects), intensityReplications[i] ))) } } } } accrualTimeValue <- accrualTimeValue[1:accrualSetup$maxNumberOfSubjects] # to avoid last value to be NA_real_ i <- accrualSetup$maxNumberOfSubjects while (is.na(accrualTimeValue[i])) { accrualTimeValue[i] <- accrualTime[length(accrualTime)] i <- i - 1 } treatmentGroup <- rep( c(rep(1, allocation1), rep(2, allocation2)), ceiling(accrualSetup$maxNumberOfSubjects / (allocation1 + allocation2)) )[1:accrualSetup$maxNumberOfSubjects] if (.isTrialDesignFisher(design)) { alpha0Vec <- design$alpha0Vec futilityBounds <- rep(NA_real_, design$kMax - 1) } else { alpha0Vec <- rep(NA_real_, design$kMax - 1) futilityBounds <- design$futilityBounds } if (.isTrialDesignGroupSequential(design)) { designNumber <- 1L } else if (.isTrialDesignInverseNormal(design)) { designNumber <- 2L } else if (.isTrialDesignFisher(design)) { designNumber <- 3L } resultData <- getSimulationSurvivalCpp( designNumber = designNumber, kMax = design$kMax, sided = design$sided, criticalValues = design$criticalValues, informationRates = design$informationRates, conditionalPower = conditionalPower, plannedEvents = plannedEvents, thetaH1 = thetaH1, minNumberOfEventsPerStage = minNumberOfEventsPerStage, maxNumberOfEventsPerStage = maxNumberOfEventsPerStage, directionUpper = directionUpper, allocation1 = allocation1, allocation2 = allocation2, accrualTime = accrualTimeValue, treatmentGroup = treatmentGroup, thetaH0 = thetaH0, futilityBounds = futilityBounds, alpha0Vec = alpha0Vec, pi1Vec = pi1, pi2 = pi2, eventTime = eventTime, piecewiseSurvivalTime = .getPiecewiseExpStartTimesWithoutLeadingZero(pwsTimeObject$piecewiseSurvivalTime), cdfValues1 = cdfValues1, cdfValues2 = cdfValues2, lambdaVec1 = lambdaVec1, lambdaVec2 = lambdaVec2, phi = phi, maxNumberOfSubjects = accrualSetup$maxNumberOfSubjects, maxNumberOfIterations = maxNumberOfIterations, maxNumberOfRawDatasetsPerStage = maxNumberOfRawDatasetsPerStage, kappa = kappa ) overview <- resultData$overview if (length(overview) == 0 || nrow(overview) == 0) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "no simulation results calculated") } n <- nrow(overview) overview <- cbind( design = rep(sub("^TrialDesign", "", class(design)), n), overview ) if (pwsTimeObject$.isPiBased() && pwsTimeObject$.getParameterType("hazardRatio") != C_PARAM_USER_DEFINED) { simulationResults$hazardRatio <- matrix(overview$hazardRatio, nrow = design$kMax)[1, ] } simulationResults$iterations <- matrix(as.integer(overview$iterations), nrow = design$kMax) if (!is.null(overview$eventsPerStage)) { simulationResults$eventsPerStage <- matrix(overview$eventsPerStage, nrow = design$kMax) } simulationResults$eventsNotAchieved <- matrix(overview$eventsNotAchieved, nrow = design$kMax) if (any(simulationResults$eventsNotAchieved > 0)) { warning("Presumably due to drop-outs, required number of events ", "were not achieved for at least one situation. ", "Increase the maximum number of subjects (", accrualSetup$maxNumberOfSubjects, ") ", "to avoid this situation", call. = FALSE ) } simulationResults$numberOfSubjects <- matrix(overview$numberOfSubjects, nrow = design$kMax) simulationResults$numberOfSubjects1 <- .getNumberOfSubjects1(simulationResults$numberOfSubjects, allocationRatioPlanned) simulationResults$numberOfSubjects2 <- .getNumberOfSubjects2(simulationResults$numberOfSubjects, allocationRatioPlanned) if (allocationRatioPlanned != 1) { simulationResults$.setParameterType("numberOfSubjects1", C_PARAM_GENERATED) simulationResults$.setParameterType("numberOfSubjects2", C_PARAM_GENERATED) } simulationResults$overallReject <- matrix(overview$overallReject, nrow = design$kMax)[1, ] if (design$kMax > 1) { simulationResults$rejectPerStage <- matrix(overview$rejectPerStage, nrow = design$kMax) } else { simulationResults$rejectPerStage <- matrix(simulationResults$overallReject, nrow = 1) } if (!all(is.na(overview$conditionalPowerAchieved))) { simulationResults$conditionalPowerAchieved <- matrix( overview$conditionalPowerAchieved, nrow = design$kMax ) simulationResults$.setParameterType("conditionalPowerAchieved", C_PARAM_GENERATED) } if (design$kMax == 1) { simulationResults$.setParameterType("numberOfSubjects", C_PARAM_NOT_APPLICABLE) simulationResults$.setParameterType("eventsPerStage", C_PARAM_NOT_APPLICABLE) } if (design$kMax > 1) { if (numberOfResults == 1) { simulationResults$futilityPerStage <- matrix( overview$futilityPerStage[1:(design$kMax - 1)], nrow = design$kMax - 1 ) } else { simulationResults$futilityPerStage <- matrix(matrix( overview$futilityPerStage, nrow = design$kMax )[1:(design$kMax - 1), ], nrow = design$kMax - 1 ) } } if (design$kMax > 1) { simulationResults$futilityStop <- matrix(overview$futilityStop, nrow = design$kMax)[1, ] simulationResults$earlyStop <- simulationResults$futilityStop + simulationResults$overallReject - simulationResults$rejectPerStage[design$kMax, ] } else { simulationResults$futilityStop <- rep(0, numberOfResults) simulationResults$earlyStop <- rep(0, numberOfResults) } simulationResults$analysisTime <- matrix(overview$analysisTime, nrow = design$kMax) simulationResults$studyDuration <- matrix(overview$studyDuration, nrow = design$kMax)[1, ] if (design$kMax > 1) { subData <- simulationResults$rejectPerStage[1:(design$kMax - 1), ] + simulationResults$futilityPerStage pStop <- rbind(subData, 1 - colSums(subData)) numberOfSubjects <- simulationResults$numberOfSubjects numberOfSubjects[is.na(numberOfSubjects)] <- 0 simulationResults$expectedNumberOfSubjects <- diag(t(numberOfSubjects) %*% pStop) if (!is.null(simulationResults$eventsPerStage) && nrow(simulationResults$eventsPerStage) > 0 && ncol(simulationResults$eventsPerStage) > 0) { simulationResults$eventsPerStage <- .convertStageWiseToOverallValues( simulationResults$eventsPerStage ) simulationResults$expectedNumberOfEvents <- diag(t(simulationResults$eventsPerStage) %*% pStop) } } else { simulationResults$expectedNumberOfSubjects <- as.numeric(simulationResults$numberOfSubjects) if (!is.null(simulationResults$eventsPerStage) && nrow(simulationResults$eventsPerStage) > 0 && ncol(simulationResults$eventsPerStage) > 0) { simulationResults$expectedNumberOfEvents <- as.numeric(simulationResults$eventsPerStage) } } if (is.null(simulationResults$expectedNumberOfEvents) || length(simulationResults$expectedNumberOfEvents) == 0) { warning("Failed to calculate expected number of events", call. = FALSE) } data <- resultData$data[!is.na(resultData$data$iterationNumber), ] data$trialStop <- (data$rejectPerStage == 1 | data$futilityPerStage == 1 | data$stageNumber == design$kMax) if (!is.null(data$eventsPerStage) && !any(is.nan(data$eventsPerStage))) { if (directionUpper) { data$hazardRatioEstimateLR <- exp(data$logRankStatistic * (1 + allocation1 / allocation2) / sqrt(allocation1 / allocation2 * data$eventsPerStage)) } else { data$hazardRatioEstimateLR <- exp(-data$logRankStatistic * (1 + allocation1 / allocation2) / sqrt(allocation1 / allocation2 * data$eventsPerStage)) } } simulationResults$.data <- data stages <- 1:design$kMax rawData <- resultData$rawData if (!is.null(rawData) && nrow(rawData) > 0 && ncol(rawData) > 0) { rawData <- rawData[!is.na(rawData$iterationNumber), ] } if (!is.null(rawData) && nrow(rawData) > 0 && ncol(rawData) > 0) { stopStageNumbers <- rawData$stopStage missingStageNumbers <- c() if (length(stopStageNumbers) > 0) { stopStageNumbers <- order(unique(stopStageNumbers)) missingStageNumbers <- stages[!which(stages %in% stopStageNumbers)] } else { missingStageNumbers <- stages } if (length(missingStageNumbers) > 0) { warning("Could not get rawData (individual results) for stages ", .arrayToString(missingStageNumbers), call. = FALSE ) } } else { rawData <- data.frame( iterationNumber = numeric(0), stopStage = numeric(0), pi1 = numeric(0), pi2 = numeric(0), subjectId = numeric(0), accrualTime = numeric(0), treatmentGroup = numeric(0), survivalTime = numeric(0), dropoutTime = numeric(0), observationTime = numeric(0), timeUnderObservation = numeric(0), event = logical(0), dropoutEvent = logical(0), censorIndicator = numeric(0) ) if (maxNumberOfRawDatasetsPerStage > 0) { warning("Could not get rawData (individual results) for stages ", .arrayToString(stages), call. = FALSE ) } } if (pwsTimeObject$.isLambdaBased() || length(pi1) < 2) { rawData <- rawData[, !(colnames(rawData) %in% c("pi1", "pi2"))] } # remove censorIndicator because it will not be calculated yet rawData <- rawData[, colnames(rawData) != "censorIndicator"] simulationResults$.rawData <- rawData return(simulationResults) } rpact/R/f_simulation_multiarm_rates.R0000644000175000017500000010355114150167045017652 0ustar nileshnilesh## | ## | *Simulation of multi-arm design with binary data* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5594 $ ## | Last changed: $Date: 2021-11-26 15:24:35 +0100 (Fr, 26 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include f_simulation_multiarm.R NULL .getSimulationRatesMultiArmStageSubjects <- function(..., stage, directionUpper, conditionalPower, conditionalCriticalValue, plannedSubjects, allocationRatioPlanned, selectedArms, piH1, piControlH1, overallRates, overallRatesControl, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage) { stage <- stage - 1 # to be consistent with non-multiarm situation gMax <- nrow(overallRates) if (!is.na(conditionalPower)) { if (any(selectedArms[1:gMax, stage + 1], na.rm = TRUE)) { if (is.na(piControlH1)) { piAssumedControlH1 <- overallRatesControl[stage] } else { piAssumedControlH1 <- piControlH1 } if (is.na(piH1)) { if (directionUpper) { piAssumedH1 <- min(overallRates[selectedArms[1:gMax, stage + 1], stage], na.rm = TRUE) } else { piAssumedH1 <- max(overallRates[selectedArms[1:gMax, stage + 1], stage], na.rm = TRUE) } } else { piAssumedH1 <- piH1 } pim <- (allocationRatioPlanned * piAssumedH1 + piAssumedControlH1) / (1 + allocationRatioPlanned) if (conditionalCriticalValue[stage] > 8) { newSubjects <- maxNumberOfSubjectsPerStage[stage + 1] } else { newSubjects <- (max(0, conditionalCriticalValue[stage] * sqrt(pim * (1 - pim) * (1 + allocationRatioPlanned)) + .getQNorm(conditionalPower) * sqrt(piAssumedH1 * (1 - piAssumedH1) + piAssumedControlH1 * (1 - piAssumedControlH1) * allocationRatioPlanned)))^2 / (max(1e-7, (2 * directionUpper - 1) * (piAssumedH1 - piAssumedControlH1)))^2 newSubjects <- min( max(minNumberOfSubjectsPerStage[stage + 1], newSubjects), maxNumberOfSubjectsPerStage[stage + 1] ) } } else { newSubjects <- 0 } } else { newSubjects <- plannedSubjects[stage + 1] - plannedSubjects[stage] } return(newSubjects) } .getSimulatedStageRatesMultiArm <- function(design, directionUpper, piVector, piControl, plannedSubjects, typeOfSelection, effectMeasure, adaptations, epsilonValue, rValue, threshold, allocationRatioPlanned, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage, conditionalPower, piH1, piControlH1, calcSubjectsFunction, calcSubjectsFunctionIsUserDefined, selectArmsFunction) { kMax <- length(plannedSubjects) gMax <- length(piVector) simRates <- matrix(NA_real_, nrow = gMax + 1, ncol = kMax) overallEffectSizes <- matrix(NA_real_, nrow = gMax, ncol = kMax) subjectsPerStage <- matrix(NA_real_, nrow = gMax + 1, ncol = kMax) testStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallTestStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) separatePValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) conditionalCriticalValue <- rep(NA_real_, kMax - 1) conditionalPowerPerStage <- rep(NA_real_, kMax) selectedArms <- matrix(FALSE, nrow = gMax + 1, ncol = kMax) selectedArms[, 1] <- TRUE adjustedPValues <- rep(NA_real_, kMax) overallRates <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallRatesControl <- rep(NA_real_, kMax) if (.isTrialDesignFisher(design)) { weights <- .getWeightsFisher(design) } else if (.isTrialDesignInverseNormal(design)) { weights <- .getWeightsInverseNormal(design) } for (k in (1:kMax)) { if (k == 1) { subjectsPerStage[gMax + 1, k] <- trunc(plannedSubjects[k] / allocationRatioPlanned) } else { subjectsPerStage[gMax + 1, k] <- trunc((plannedSubjects[k] - plannedSubjects[k - 1]) / allocationRatioPlanned) } simRates[gMax + 1, k] <- stats::rbinom(1, subjectsPerStage[gMax + 1, k], piControl) / subjectsPerStage[gMax + 1, k] for (treatmentArm in (1:gMax)) { if (selectedArms[treatmentArm, k]) { if (k == 1) { subjectsPerStage[treatmentArm, k] <- plannedSubjects[k] } else { subjectsPerStage[treatmentArm, k] <- plannedSubjects[k] - plannedSubjects[k - 1] } simRates[treatmentArm, k] <- stats::rbinom(1, subjectsPerStage[treatmentArm, k], piVector[treatmentArm]) / subjectsPerStage[treatmentArm, k] rm <- (subjectsPerStage[treatmentArm, k] * simRates[treatmentArm, k] + subjectsPerStage[gMax + 1, k] * simRates[gMax + 1, k]) / (subjectsPerStage[treatmentArm, k] + subjectsPerStage[gMax + 1, k]) if (simRates[treatmentArm, k] - simRates[gMax + 1, k] == 0) { testStatistics[treatmentArm, k] <- 0 } else { testStatistics[treatmentArm, k] <- (2 * directionUpper - 1) * (simRates[treatmentArm, k] - simRates[gMax + 1, k]) / sqrt(rm * (1 - rm) * (1 / subjectsPerStage[treatmentArm, k] + 1 / subjectsPerStage[gMax + 1, k])) } separatePValues[treatmentArm, k] <- 1 - stats::pnorm(testStatistics[treatmentArm, k]) overallRates[treatmentArm, k] <- subjectsPerStage[treatmentArm, 1:k] %*% simRates[treatmentArm, 1:k] / sum(subjectsPerStage[treatmentArm, 1:k]) overallRatesControl[k] <- subjectsPerStage[gMax + 1, 1:k] %*% simRates[gMax + 1, 1:k] / sum(subjectsPerStage[gMax + 1, 1:k]) overallEffectSizes[treatmentArm, k] <- (2 * directionUpper - 1) * (overallRates[treatmentArm, k] - overallRatesControl[k]) rmOverall <- (allocationRatioPlanned * overallRates[treatmentArm, k] + overallRatesControl[k]) / (allocationRatioPlanned + 1) if (overallEffectSizes[treatmentArm, k] == 0) { overallTestStatistics[treatmentArm, k] <- 0 } else { overallTestStatistics[treatmentArm, k] <- overallEffectSizes[treatmentArm, k] / sqrt(rmOverall * (1 - rmOverall) * sqrt(1 / sum(subjectsPerStage[treatmentArm, 1:k]) + 1 / sum(subjectsPerStage[gMax + 1, 1:k]))) } } } if (k < kMax) { if (colSums(selectedArms)[k] == 1) { break } # Bonferroni adjustment adjustedPValues[k] <- min(min(separatePValues[, k], na.rm = TRUE) * (colSums(selectedArms)[k] - 1), 1 - 1e-12) # conditional critical value to reject the null hypotheses at the next stage of the trial if (.isTrialDesignConditionalDunnett(design)) { conditionalCriticalValue[k] <- (.getOneMinusQNorm(design$alpha) - .getOneMinusQNorm(adjustedPValues[k]) * sqrt(design$informationAtInterim)) / sqrt(1 - design$informationAtInterim) } else { if (.isTrialDesignFisher(design)) { conditionalCriticalValue[k] <- .getOneMinusQNorm(min((design$criticalValues[k + 1] / prod(adjustedPValues[1:k]^weights[1:k]))^(1 / weights[k + 1]), 1 - 1e-7)) } else { if (design$criticalValues[k + 1] >= 6) { conditionalCriticalValue[k] <- Inf } else { conditionalCriticalValue[k] <- (design$criticalValues[k + 1] * sqrt(design$informationRates[k + 1]) - .getOneMinusQNorm(adjustedPValues[1:k]) %*% weights[1:k]) / sqrt(design$informationRates[k + 1] - design$informationRates[k]) } } } if (adaptations[k]) { if (effectMeasure == "testStatistic") { selectedArms[, k + 1] <- (selectedArms[, k] & .selectTreatmentArms( k, overallTestStatistics[, k] + runif(gMax, -1E-5, 1E-5), typeOfSelection, epsilonValue, rValue, threshold, selectArmsFunction )) } else if (effectMeasure == "effectEstimate") { selectedArms[, k + 1] <- (selectedArms[, k] & .selectTreatmentArms( k, overallEffectSizes[, k] + runif(gMax, -1E-5, 1E-5), typeOfSelection, epsilonValue, rValue, threshold, selectArmsFunction )) } newSubjects <- calcSubjectsFunction( stage = k + 1, # to be consistent with non-multiarm situation, cf. line 39 directionUpper = directionUpper, conditionalPower = conditionalPower, conditionalCriticalValue = conditionalCriticalValue, plannedSubjects = plannedSubjects, allocationRatioPlanned = allocationRatioPlanned, selectedArms = selectedArms, piH1 = piH1, piControlH1 = piControlH1, overallRates = overallRates, overallRatesControl = overallRatesControl, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage ) if (is.null(newSubjects) || length(newSubjects) != 1 || !is.numeric(newSubjects) || is.na(newSubjects)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'calcSubjectsFunction' returned an illegal or undefined result (", newSubjects, "); ", "the output must be a single numeric value" ) } if (!is.na(conditionalPower) || calcSubjectsFunctionIsUserDefined) { plannedSubjects[(k + 1):kMax] <- ceiling(sum(subjectsPerStage[gMax + 1, 1:k]) * allocationRatioPlanned + cumsum(rep(newSubjects, kMax - k))) } } else { selectedArms[, k + 1] <- selectedArms[, k] } if (is.na(piControlH1)) { piAssumedControlH1 <- overallRatesControl[k] } else { piAssumedControlH1 <- piControlH1 } if (is.na(piH1)) { if (directionUpper) { piAssumedH1 <- min(overallRates[selectedArms[1:gMax, k], k], na.rm = TRUE) } else { piAssumedH1 <- max(overallRates[selectedArms[1:gMax, k], k], na.rm = TRUE) } } else { piAssumedH1 <- piH1 } pim <- (allocationRatioPlanned * piAssumedH1 + piAssumedControlH1) / (1 + allocationRatioPlanned) if (piAssumedH1 * (1 - piAssumedH1) + piAssumedControlH1 * (1 - piAssumedControlH1) == 0) { thetaStandardized <- 0 } else { thetaStandardized <- sqrt(allocationRatioPlanned) / (1 + allocationRatioPlanned) * ( (piAssumedH1 - piAssumedControlH1) * sqrt(1 + allocationRatioPlanned) / sqrt(piAssumedH1 * (1 - piAssumedH1) + allocationRatioPlanned * piAssumedControlH1 * (1 - piAssumedControlH1)) + sign(piAssumedH1 - piAssumedControlH1) * conditionalCriticalValue[k] * (1 - sqrt(pim * (1 - pim) + allocationRatioPlanned * pim * (1 - pim)) / sqrt(piAssumedH1 * (1 - piAssumedH1) + allocationRatioPlanned * piAssumedControlH1 * (1 - piAssumedControlH1))) * sqrt((1 + allocationRatioPlanned) / (plannedSubjects[k + 1] - plannedSubjects[k])) ) } thetaStandardized <- (2 * directionUpper - 1) * thetaStandardized conditionalPowerPerStage[k] <- 1 - stats::pnorm(conditionalCriticalValue[k] - thetaStandardized * sqrt((1 + allocationRatioPlanned) / allocationRatioPlanned) * sqrt(plannedSubjects[k + 1] - plannedSubjects[k])) } } return(list( subjectsPerStage = subjectsPerStage, allocationRatioPlanned = allocationRatioPlanned, overallEffectSizes = overallEffectSizes, testStatistics = testStatistics, directionUpper = directionUpper, overallTestStatistics = overallTestStatistics, overallRatesControl = overallRatesControl, overallRates = overallRates, separatePValues = separatePValues, conditionalCriticalValue = conditionalCriticalValue, conditionalPowerPerStage = conditionalPowerPerStage, selectedArms = selectedArms )) } #' #' @title #' Get Simulation Multi-Arm Rates #' #' @description #' Returns the simulated power, stopping and selection probabilities, conditional power, #' and expected sample size for testing rates in a multi-arm treatment groups testing situation. #' #' @param piMaxVector Range of assumed probabilities for the treatment group with #' highest response for \code{"linear"} and \code{"sigmoidEmax"} model, #' default is \code{seq(0, 1, 0.2)}. #' @param piControl If specified, the assumed probability in the control arm #' for simulation and under which the sample size recalculation is performed. #' @param piH1 If specified, the assumed probability in the active treatment arm(s) #' under which the sample size recalculation is performed. #' @param piControlH1 If specified, the assumed probability in the reference group #' (if different from \code{piControl}) for which the conditional power was calculated. #' @inheritParams param_intersectionTest_MultiArm #' @inheritParams param_typeOfSelection #' @inheritParams param_effectMeasure #' @inheritParams param_adaptations #' @inheritParams param_threshold #' @inheritParams param_effectMatrix #' @inheritParams param_activeArms #' @inheritParams param_successCriterion #' @inheritParams param_typeOfShape #' @inheritParams param_typeOfSelection #' @inheritParams param_design_with_default #' @inheritParams param_directionUpper #' @inheritParams param_allocationRatioPlanned #' @inheritParams param_plannedSubjects #' @inheritParams param_minNumberOfSubjectsPerStage #' @inheritParams param_maxNumberOfSubjectsPerStage #' @inheritParams param_conditionalPowerSimulation #' @inheritParams param_maxNumberOfIterations #' @inheritParams param_calcSubjectsFunction #' @inheritParams param_selectArmsFunction #' @inheritParams param_rValue #' @inheritParams param_epsilonValue #' @inheritParams param_gED50 #' @inheritParams param_slope #' @inheritParams param_seed #' @inheritParams param_three_dots #' @inheritParams param_showStatistics #' #' @details #' At given design the function simulates the power, stopping probabilities, #' selection probabilities, and expected sample size at given number of subjects, #' parameter configuration, and treatment arm selection rule in the multi-arm situation. #' An allocation ratio can be specified referring to the ratio of number of #' subjects in the active treatment groups as compared to the control group. #' #' The definition of \code{pi1H1} and/or \code{piControl} makes only sense if \code{kMax} > 1 #' and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and #' \code{maxNumberOfSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. #' #' \code{calcSubjectsFunction}\cr #' This function returns the number of subjects at given conditional power and #' conditional critical value for specified testing situation. #' The function might depend on the variables #' \code{stage}, #' \code{selectedArms}, #' \code{directionUpper}, #' \code{plannedSubjects}, #' \code{allocationRatioPlanned}, #' \code{minNumberOfSubjectsPerStage}, #' \code{maxNumberOfSubjectsPerStage}, #' \code{conditionalPower}, #' \code{conditionalCriticalValue}, #' \code{overallRates}, #' \code{overallRatesControl}, #' \code{piH1}, and #' \code{piControlH1}. #' The function has to contain the three-dots argument '...' (see examples). #' #' @template return_object_simulation_results #' @template how_to_get_help_for_generics #' #' @template examples_get_simulation_multiarm_rates #' #' @export #' getSimulationMultiArmRates <- function(design = NULL, ..., activeArms = 3L, # C_ACTIVE_ARMS_DEFAULT effectMatrix = NULL, typeOfShape = c("linear", "sigmoidEmax", "userDefined"), # C_TYPE_OF_SHAPE_DEFAULT piMaxVector = seq(0.2, 0.5, 0.1), # C_PI_1_DEFAULT piControl = 0.2, # C_PI_2_DEFAULT gED50 = NA_real_, slope = 1, intersectionTest = c("Dunnett", "Bonferroni", "Simes", "Sidak", "Hierarchical"), # C_INTERSECTION_TEST_MULTIARMED_DEFAULT directionUpper = TRUE, # C_DIRECTION_UPPER_DEFAULT adaptations = NA, typeOfSelection = c("best", "rBest", "epsilon", "all", "userDefined"), # C_TYPE_OF_SELECTION_DEFAULT effectMeasure = c("effectEstimate", "testStatistic"), # C_EFFECT_MEASURE_DEFAULT successCriterion = c("all", "atLeastOne"), # C_SUCCESS_CRITERION_DEFAULT epsilonValue = NA_real_, rValue = NA_real_, threshold = -Inf, plannedSubjects = NA_real_, allocationRatioPlanned = NA_real_, minNumberOfSubjectsPerStage = NA_real_, maxNumberOfSubjectsPerStage = NA_real_, conditionalPower = NA_real_, piH1 = NA_real_, piControlH1 = NA_real_, maxNumberOfIterations = 1000L, # C_MAX_SIMULATION_ITERATIONS_DEFAULT seed = NA_real_, calcSubjectsFunction = NULL, selectArmsFunction = NULL, showStatistics = FALSE) { if (is.null(design)) { design <- .getDefaultDesign(..., type = "simulation") .warnInCaseOfUnknownArguments( functionName = "getSimulationMultiArmRates", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "showStatistics"), ... ) } else { .assertIsTrialDesignInverseNormalOrFisherOrConditionalDunnett(design) .warnInCaseOfUnknownArguments( functionName = "getSimulationMultiArmRates", ignore = "showStatistics", ... ) .warnInCaseOfTwoSidedPowerArgument(...) } .assertIsOneSidedDesign(design, designType = "multi-arm", engineType = "simulation") calcSubjectsFunctionIsUserDefined <- !is.null(calcSubjectsFunction) simulationResults <- .createSimulationResultsMultiArmObject( design = design, activeArms = activeArms, effectMatrix = effectMatrix, typeOfShape = typeOfShape, piMaxVector = piMaxVector, # rates only piControl = piControl, # rates only gED50 = gED50, slope = slope, intersectionTest = intersectionTest, directionUpper = directionUpper, # rates + survival only adaptations = adaptations, typeOfSelection = typeOfSelection, effectMeasure = effectMeasure, successCriterion = successCriterion, epsilonValue = epsilonValue, rValue = rValue, threshold = threshold, plannedSubjects = plannedSubjects, # means + rates only allocationRatioPlanned = allocationRatioPlanned, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, # means + rates only maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage, # means + rates only conditionalPower = conditionalPower, piH1 = piH1, # rates only piControlH1 = piControlH1, # rates only maxNumberOfIterations = maxNumberOfIterations, seed = seed, calcSubjectsFunction = calcSubjectsFunction, # means + rates only selectArmsFunction = selectArmsFunction, showStatistics = showStatistics, endpoint = "rates" ) design <- simulationResults$.design successCriterion <- simulationResults$successCriterion effectMeasure <- simulationResults$effectMeasure adaptations <- simulationResults$adaptations gMax <- activeArms kMax <- simulationResults$.design$kMax intersectionTest <- simulationResults$intersectionTest typeOfSelection <- simulationResults$typeOfSelection effectMatrix <- t(simulationResults$effectMatrix) piMaxVector <- simulationResults$piMaxVector # rates only piControl <- simulationResults$piControl # rates only piH1 <- simulationResults$piH1 # rates only piControlH1 <- simulationResults$piControlH1 # rates only conditionalPower <- simulationResults$conditionalPower minNumberOfSubjectsPerStage <- simulationResults$minNumberOfSubjectsPerStage maxNumberOfSubjectsPerStage <- simulationResults$maxNumberOfSubjectsPerStage allocationRatioPlanned <- simulationResults$allocationRatioPlanned calcSubjectsFunction <- simulationResults$calcSubjectsFunction indices <- .getIndicesOfClosedHypothesesSystemForSimulation(gMax = gMax) if (.isTrialDesignConditionalDunnett(design)) { criticalValuesDunnett <- .getCriticalValuesDunnettForSimulation( alpha = design$alpha, indices = indices, allocationRatioPlanned = allocationRatioPlanned ) } cols <- length(piMaxVector) simulatedSelections <- array(0, dim = c(kMax, cols, gMax + 1)) simulatedRejections <- array(0, dim = c(kMax, cols, gMax)) simulatedNumberOfActiveArms <- matrix(0, nrow = kMax, ncol = cols) simulatedSubjectsPerStage <- array(0, dim = c(kMax, cols, gMax + 1)) simulatedSuccessStopping <- matrix(0, nrow = kMax, ncol = cols) simulatedFutilityStopping <- matrix(0, nrow = kMax - 1, ncol = cols) simulatedConditionalPower <- matrix(0, nrow = kMax, ncol = cols) simulatedRejectAtLeastOne <- rep(0, cols) expectedNumberOfSubjects <- rep(0, cols) iterations <- matrix(0, nrow = kMax, ncol = cols) len <- maxNumberOfIterations * kMax * gMax * cols dataIterationNumber <- rep(NA_real_, len) dataStageNumber <- rep(NA_real_, len) dataArmNumber <- rep(NA_real_, len) dataAlternative <- rep(NA_real_, len) dataEffect <- rep(NA_real_, len) dataSubjectsControlArm <- rep(NA_real_, len) dataSubjectsActiveArm <- rep(NA_real_, len) dataNumberOfSubjects <- rep(NA_real_, len) dataNumberOfCumulatedSubjects <- rep(NA_real_, len) dataRejectPerStage <- rep(NA, len) dataFutilityStop <- rep(NA_real_, len) dataSuccessStop <- rep(NA, len) dataFutilityStop <- rep(NA, len) dataTestStatistics <- rep(NA_real_, len) dataConditionalCriticalValue <- rep(NA_real_, len) dataConditionalPowerAchieved <- rep(NA_real_, len) dataEffectEstimate <- rep(NA_real_, len) dataPValuesSeparate <- rep(NA_real_, len) index <- 1 for (i in 1:cols) { for (j in 1:maxNumberOfIterations) { stageResults <- .getSimulatedStageRatesMultiArm( design = design, directionUpper = directionUpper, piVector = effectMatrix[i, ], piControl = piControl, plannedSubjects = plannedSubjects, typeOfSelection = typeOfSelection, effectMeasure = effectMeasure, adaptations = adaptations, epsilonValue = epsilonValue, rValue = rValue, threshold = threshold, allocationRatioPlanned = allocationRatioPlanned, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage, conditionalPower = conditionalPower, piH1 = piH1, piControlH1 = piControlH1, calcSubjectsFunction = calcSubjectsFunction, calcSubjectsFunctionIsUserDefined = calcSubjectsFunctionIsUserDefined, selectArmsFunction = selectArmsFunction ) if (.isTrialDesignConditionalDunnett(design)) { closedTest <- .performClosedConditionalDunnettTestForSimulation( stageResults = stageResults, design = design, indices = indices, criticalValuesDunnett = criticalValuesDunnett, successCriterion = successCriterion ) } else { closedTest <- .performClosedCombinationTestForSimulationMultiArm( stageResults = stageResults, design = design, indices = indices, intersectionTest = intersectionTest, successCriterion = successCriterion ) } rejectAtSomeStage <- FALSE rejectedArmsBefore <- rep(FALSE, gMax) for (k in 1:kMax) { simulatedRejections[k, i, ] <- simulatedRejections[k, i, ] + (closedTest$rejected[, k] & closedTest$selectedArms[1:gMax, k] | rejectedArmsBefore) simulatedSelections[k, i, ] <- simulatedSelections[k, i, ] + closedTest$selectedArms[, k] simulatedNumberOfActiveArms[k, i] <- simulatedNumberOfActiveArms[k, i] + sum(closedTest$selectedArms[, k]) if (!any(is.na(closedTest$successStop))) { simulatedSuccessStopping[k, i] <- simulatedSuccessStopping[k, i] + closedTest$successStop[k] } if ((kMax > 1) && (k < kMax)) { if (!any(is.na(closedTest$futilityStop))) { simulatedFutilityStopping[k, i] <- simulatedFutilityStopping[k, i] + (closedTest$futilityStop[k] && !closedTest$successStop[k]) } if (!closedTest$successStop[k] && !closedTest$futilityStop[k]) { simulatedConditionalPower[k + 1, i] <- simulatedConditionalPower[k + 1, i] + stageResults$conditionalPowerPerStage[k] } } iterations[k, i] <- iterations[k, i] + 1 for (g in (1:(gMax + 1))) { if (!is.na(stageResults$subjectsPerStage[g, k])) { simulatedSubjectsPerStage[k, i, g] <- simulatedSubjectsPerStage[k, i, g] + stageResults$subjectsPerStage[g, k] } } for (g in 1:gMax) { dataIterationNumber[index] <- j dataStageNumber[index] <- k dataArmNumber[index] <- g dataAlternative[index] <- piMaxVector[i] dataEffect[index] <- effectMatrix[i, g] dataSubjectsControlArm[index] <- round(stageResults$subjectsPerStage[gMax + 1, k], 1) dataSubjectsActiveArm[index] <- round(stageResults$subjectsPerStage[g, k], 1) dataNumberOfSubjects[index] <- round(sum(stageResults$subjectsPerStage[, k], na.rm = TRUE), 1) dataNumberOfCumulatedSubjects[index] <- round(sum(stageResults$subjectsPerStage[, 1:k], na.rm = TRUE), 1) dataRejectPerStage[index] <- closedTest$rejected[g, k] dataTestStatistics[index] <- stageResults$testStatistics[g, k] dataSuccessStop[index] <- closedTest$successStop[k] if (k < kMax) { dataFutilityStop[index] <- closedTest$futilityStop[k] dataConditionalCriticalValue[index] <- stageResults$conditionalCriticalValue[k] dataConditionalPowerAchieved[index + 1] <- stageResults$conditionalPowerPerStage[k] } dataEffectEstimate[index] <- stageResults$overallEffectSizes[g, k] dataPValuesSeparate[index] <- closedTest$separatePValues[g, k] index <- index + 1 } if (!rejectAtSomeStage && any(closedTest$rejected[, k] & closedTest$selectedArms[1:gMax, k] | rejectedArmsBefore)) { simulatedRejectAtLeastOne[i] <- simulatedRejectAtLeastOne[i] + 1 rejectAtSomeStage <- TRUE } if ((k < kMax) && (closedTest$successStop[k] || closedTest$futilityStop[k])) { # rejected hypotheses remain rejected also in case of early stopping simulatedRejections[(k + 1):kMax, i, ] <- simulatedRejections[(k + 1):kMax, i, ] + matrix((closedTest$rejected[, k] & closedTest$selectedArms[1:gMax, k] | rejectedArmsBefore), kMax - k, gMax, byrow = TRUE ) break } rejectedArmsBefore <- closedTest$rejected[, k] & closedTest$selectedArms[1:gMax, k] | rejectedArmsBefore } } simulatedSubjectsPerStage[is.na(simulatedSubjectsPerStage)] <- 0 simulatedSubjectsPerStage[, i, ] <- simulatedSubjectsPerStage[, i, ] / iterations[, i] if (kMax > 1) { simulatedRejections[2:kMax, i, ] <- simulatedRejections[2:kMax, i, ] - simulatedRejections[1:(kMax - 1), i, ] stopping <- cumsum(simulatedSuccessStopping[1:(kMax - 1), i] + simulatedFutilityStopping[, i]) / maxNumberOfIterations expectedNumberOfSubjects[i] <- sum(simulatedSubjectsPerStage[1, i, ] + t(1 - stopping) %*% simulatedSubjectsPerStage[2:kMax, i, ]) } else { expectedNumberOfSubjects[i] <- sum(simulatedSubjectsPerStage[1, i, ]) } } simulatedConditionalPower[1, ] <- NA_real_ if (kMax > 1) { simulatedConditionalPower[2:kMax, ] <- as.matrix(simulatedConditionalPower[2:kMax, ] / iterations[2:kMax, ]) } simulationResults$rejectAtLeastOne <- simulatedRejectAtLeastOne / maxNumberOfIterations simulationResults$numberOfActiveArms <- simulatedNumberOfActiveArms / iterations - 1 simulationResults$selectedArms <- simulatedSelections / maxNumberOfIterations simulationResults$rejectedArmsPerStage <- simulatedRejections / maxNumberOfIterations simulationResults$successPerStage <- simulatedSuccessStopping / maxNumberOfIterations simulationResults$futilityPerStage <- simulatedFutilityStopping / maxNumberOfIterations simulationResults$futilityStop <- base::colSums(simulatedFutilityStopping / maxNumberOfIterations) if (kMax > 1) { simulationResults$earlyStop <- simulationResults$futilityPerStage + simulationResults$successPerStage[1:(kMax - 1), ] simulationResults$conditionalPowerAchieved <- simulatedConditionalPower } simulationResults$sampleSizes <- simulatedSubjectsPerStage simulationResults$expectedNumberOfSubjects <- expectedNumberOfSubjects simulationResults$iterations <- iterations if (!all(is.na(simulationResults$conditionalPowerAchieved))) { simulationResults$.setParameterType("conditionalPowerAchieved", C_PARAM_GENERATED) } if (any(simulationResults$rejectedArmsPerStage < 0)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "internal error, simulation not possible due to numerical overflow") } data <- data.frame( iterationNumber = dataIterationNumber, stageNumber = dataStageNumber, armNumber = dataArmNumber, piMax = dataAlternative, effect = dataEffect, numberOfSubjects = dataNumberOfSubjects, numberOfCumulatedSubjects = dataNumberOfCumulatedSubjects, subjectsControlArm = dataSubjectsControlArm, subjectsActiveArm = dataSubjectsActiveArm, effectEstimate = dataEffectEstimate, testStatistics = dataTestStatistics, pValue = dataPValuesSeparate, conditionalCriticalValue = round(dataConditionalCriticalValue, 6), conditionalPowerAchieved = round(dataConditionalPowerAchieved, 6), rejectPerStage = dataRejectPerStage, successStop = dataSuccessStop, futilityPerStage = dataFutilityStop ) data <- data[!is.na(data$effectEstimate), ] simulationResults$.data <- data return(simulationResults) } rpact/R/f_analysis_base_rates.R0000644000175000017500000023257314165522247016405 0ustar nileshnilesh## | ## | *Analysis of rates with group sequential and combination test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5684 $ ## | Last changed: $Date: 2022-01-05 12:27:24 +0100 (Mi, 05 Jan 2022) $ ## | Last changed by: $Author: wassmer $ ## | # @title # Get Analysis Results Rates # # @description # Returns an analysis result object. # # @param design The trial design. # # @return Returns a \code{AnalysisResultsRates} object. # # @keywords internal # .getAnalysisResultsRates <- function(..., design, dataInput) { if (.isTrialDesignGroupSequential(design)) { return(.getAnalysisResultsRatesGroupSequential( design = design, dataInput = dataInput, ... )) } if (.isTrialDesignInverseNormal(design)) { return(.getAnalysisResultsRatesInverseNormal( design = design, dataInput = dataInput, ... )) } if (.isTrialDesignFisher(design)) { return(.getAnalysisResultsRatesFisher( design = design, dataInput = dataInput, ... )) } .stopWithWrongDesignMessage(design) } .getAnalysisResultsRatesInverseNormal <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, thetaH0 = C_THETA_H0_RATES_DEFAULT, pi1 = NA_real_, pi2 = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .assertIsTrialDesignInverseNormal(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsRatesInverseNormal", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsInverseNormal(design = design, dataInput = dataInput) .getAnalysisResultsRatesAll( results = results, design = design, dataInput = dataInput, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, thetaH0 = thetaH0, pi1 = pi1, pi2 = pi2, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance ) return(results) } .getAnalysisResultsRatesGroupSequential <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, thetaH0 = C_THETA_H0_RATES_DEFAULT, pi1 = NA_real_, pi2 = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .assertIsTrialDesignGroupSequential(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsRatesGroupSequential", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsGroupSequential(design = design, dataInput = dataInput) .getAnalysisResultsRatesAll( results = results, design = design, dataInput = dataInput, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, thetaH0 = thetaH0, pi1 = pi1, pi2 = pi2, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance ) return(results) } .getAnalysisResultsRatesFisher <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, thetaH0 = C_THETA_H0_RATES_DEFAULT, pi1 = NA_real_, pi2 = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsRatesFisher", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsFisher(design = design, dataInput = dataInput) .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) .getAnalysisResultsRatesAll( results = results, design = design, dataInput = dataInput, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, thetaH0 = thetaH0, pi1 = pi1, pi2 = pi2, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, tolerance = tolerance, iterations = iterations, seed = seed ) return(results) } # # The following parameters will be taken from 'design': # stages, informationRates, criticalValues, futilityBounds, alphaSpent, stageLevels # .getAnalysisResultsRatesAll <- function(..., results, design, dataInput, stage, directionUpper, normalApproximation, thetaH0, pi1, pi2, nPlanned, allocationRatioPlanned, tolerance, iterations, seed) { startTime <- Sys.time() stageResults <- .getStageResultsRates( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation ) results$.setStageResults(stageResults) .logProgress("Stage results calculated", startTime = startTime) pi1User <- pi1 .assertIsSingleNumber(pi1, "pi1", naAllowed = TRUE) pi1 <- .assertIsValidPi1(pi1, stageResults, stage) if (identical(pi1, pi1User)) { .setValueAndParameterType(results, "pi1", pi1, NA_real_) } else { results$pi1 <- pi1 results$.setParameterType("pi1", C_PARAM_GENERATED) } if (dataInput$getNumberOfGroups() == 2) { pi2User <- pi2 .assertIsSingleNumber(pi2, "pi2", naAllowed = TRUE) pi2 <- .assertIsValidPi2(pi2, stageResults, stage) if (identical(pi2, pi2User)) { .setValueAndParameterType(results, "pi2", pi2, NA_real_) } else { results$pi2 <- pi2 results$.setParameterType("pi2", C_PARAM_GENERATED) } } else { if (!all(is.na(pi2))) { warning("'pi2' (", .arrayToString(pi2), ") will be ignored ", "because the specified data has only one group", call. = FALSE ) } results$pi2 <- NA_real_ results$.setParameterType("pi2", C_PARAM_NOT_APPLICABLE) } .warnInCaseOfUnusedConditionalPowerArgument(results, nPlanned, "pi1", pi1) .warnInCaseOfUnusedConditionalPowerArgument(results, nPlanned, "pi2", pi2) .setValueAndParameterType(results, "directionUpper", directionUpper, C_DIRECTION_UPPER_DEFAULT) .setValueAndParameterType( results, "normalApproximation", normalApproximation, C_NORMAL_APPROXIMATION_RATES_DEFAULT ) .setValueAndParameterType(results, "thetaH0", thetaH0, C_THETA_H0_RATES_DEFAULT) .setConditionalPowerArguments(results, dataInput, nPlanned, allocationRatioPlanned) # test actions results$testActions <- getTestActions(stageResults = stageResults) results$.setParameterType("testActions", C_PARAM_GENERATED) if (design$kMax > 1) { # conditional power startTime <- Sys.time() if (.isTrialDesignFisher(design)) { results$.conditionalPowerResults <- .getConditionalPowerRates( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, pi1 = pi1, pi2 = pi2, iterations = iterations, seed = seed ) if (results$.conditionalPowerResults$simulated) { results$conditionalPowerSimulated <- results$.conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalPowerSimulated", C_PARAM_GENERATED) results$.setParameterType("seed", results$.conditionalPowerResults$.getParameterType("seed")) results$seed <- results$.conditionalPowerResults$seed results$.setParameterType("iterations", results$.conditionalPowerResults$.getParameterType("iterations")) results$iterations <- results$.conditionalPowerResults$iterations } else { results$conditionalPower <- results$.conditionalPowerResults$conditionalPower results$conditionalPowerSimulated <- numeric(0) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$.setParameterType("conditionalPowerSimulated", C_PARAM_NOT_APPLICABLE) } } else { results$.conditionalPowerResults <- .getConditionalPowerRates( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, pi1 = pi1, pi2 = pi2 ) results$conditionalPower <- results$.conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_GENERATED) } .logProgress("Conditional power calculated", startTime = startTime) # CRP - conditional rejection probabilities startTime <- Sys.time() if (.isTrialDesignFisher(design) && isTRUE(.getOptionalArgument("simulateCRP", ...))) { results$.setParameterType("seed", ifelse(is.na(seed), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) seed <- results$.conditionalPowerResults$seed crp <- getConditionalRejectionProbabilities( stageResults = stageResults, iterations = iterations, seed = seed ) results$conditionalRejectionProbabilities <- crp$crpFisherSimulated paramTypeSeed <- results$.conditionalPowerResults$.getParameterType("seed") if (paramTypeSeed != C_PARAM_TYPE_UNKNOWN) { results$.setParameterType("seed", paramTypeSeed) } results$seed <- seed } else { results$conditionalRejectionProbabilities <- getConditionalRejectionProbabilities(stageResults = stageResults) } results$.setParameterType("conditionalRejectionProbabilities", C_PARAM_GENERATED) .logProgress("Conditional rejection probabilities (CRP) calculated", startTime = startTime) } # RCI - repeated confidence interval startTime <- Sys.time() repeatedConfidenceIntervals <- .getRepeatedConfidenceIntervalsRates( design = design, dataInput = dataInput, stage = stage, normalApproximation = normalApproximation, tolerance = tolerance ) results$repeatedConfidenceIntervalLowerBounds <- repeatedConfidenceIntervals[1, ] results$repeatedConfidenceIntervalUpperBounds <- repeatedConfidenceIntervals[2, ] results$.setParameterType("repeatedConfidenceIntervalLowerBounds", C_PARAM_GENERATED) results$.setParameterType("repeatedConfidenceIntervalUpperBounds", C_PARAM_GENERATED) .logProgress("Repeated confidence interval calculated", startTime = startTime) # repeated p-value startTime <- Sys.time() results$repeatedPValues <- getRepeatedPValues( stageResults = stageResults, tolerance = tolerance ) results$.setParameterType("repeatedPValues", C_PARAM_GENERATED) .logProgress("Repeated p-values calculated", startTime = startTime) if (design$kMax > 1) { # final p-value startTime <- Sys.time() finalPValue <- getFinalPValue(stageResults) results$finalPValues <- .getVectorWithFinalValueAtFinalStage( kMax = design$kMax, finalValue = finalPValue$pFinal, finalStage = finalPValue$finalStage ) results$.setParameterType("finalPValues", C_PARAM_GENERATED) results$finalStage <- finalPValue$finalStage results$.setParameterType("finalPValues", C_PARAM_GENERATED) results$.setParameterType("finalStage", C_PARAM_GENERATED) .logProgress("Final p-value calculated", startTime = startTime) # final confidence interval & median unbiased estimate startTime <- Sys.time() finalConfidenceIntervals <- .getFinalConfidenceIntervalRates( design = design, dataInput = dataInput, thetaH0 = thetaH0, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, tolerance = tolerance ) if (!is.null(finalConfidenceIntervals)) { finalStage <- finalConfidenceIntervals$finalStage results$finalConfidenceIntervalLowerBounds <- .getVectorWithFinalValueAtFinalStage( kMax = design$kMax, finalValue = finalConfidenceIntervals$finalConfidenceInterval[1], finalStage = finalStage ) results$finalConfidenceIntervalUpperBounds <- .getVectorWithFinalValueAtFinalStage( kMax = design$kMax, finalValue = finalConfidenceIntervals$finalConfidenceInterval[2], finalStage = finalStage ) results$medianUnbiasedEstimates <- .getVectorWithFinalValueAtFinalStage( kMax = design$kMax, finalValue = finalConfidenceIntervals$medianUnbiased, finalStage = finalStage ) results$.setParameterType("finalConfidenceIntervalLowerBounds", C_PARAM_GENERATED) results$.setParameterType("finalConfidenceIntervalUpperBounds", C_PARAM_GENERATED) results$.setParameterType("medianUnbiasedEstimates", C_PARAM_GENERATED) .logProgress("Final confidence interval calculated", startTime = startTime) } } return(results) } # @title # Get Stage Results Rates # # @description # Returns a stage results object. # # @param design the trial design. # # @return Returns a \code{StageResultsRates} object. # # @keywords internal # .getStageResultsRates <- function(..., design, dataInput, thetaH0 = NA_real_, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, stage = NA_integer_, userFunctionCallEnabled = FALSE) { .assertIsDatasetRates(dataInput) .assertIsValidThetaH0DataInput(thetaH0, dataInput) directionUpper <- .assertIsValidDirectionUpper(directionUpper, design$sided, userFunctionCallEnabled = userFunctionCallEnabled ) .assertIsSingleLogical(normalApproximation, "normalApproximation") .warnInCaseOfUnknownArguments( functionName = "getStageResultsRates", ignore = .getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), ... ) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design, stage = stage) effectSizes <- rep(NA_real_, design$kMax) if (dataInput$getNumberOfGroups() == 1) { if (is.na(thetaH0)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'thetaH0' must be defined") } if (normalApproximation) { overallTestStatistics <- c((dataInput$getOverallEventsUpTo(stage) / dataInput$getOverallSampleSizesUpTo(stage) - thetaH0) / sqrt(thetaH0 * (1 - thetaH0)) * sqrt(dataInput$getOverallSampleSizesUpTo(stage)), rep(NA_real_, design$kMax - stage)) if (directionUpper) { overallPValues <- 1 - stats::pnorm(overallTestStatistics) } else { overallPValues <- stats::pnorm(overallTestStatistics) } } else { overallTestStatistics <- rep(NA_real_, design$kMax) if (directionUpper) { overallPValues <- stats::pbinom(dataInput$getOverallEventsUpTo(stage) - 1, dataInput$getOverallSampleSizesUpTo(stage), thetaH0, lower.tail = FALSE ) } else { overallPValues <- stats::pbinom(dataInput$getOverallEventsUpTo(stage), dataInput$getOverallSampleSizesUpTo(stage), thetaH0, lower.tail = TRUE ) } overallTestStatistics <- .getOneMinusQNorm(overallPValues) } effectSizes[1:stage] <- dataInput$getOverallEventsUpTo(stage) / dataInput$getOverallSampleSizesUpTo(stage) } if (dataInput$getNumberOfGroups() == 2) { if (is.na(thetaH0)) { thetaH0 <- C_THETA_H0_RATES_DEFAULT } overallEvents1 <- dataInput$getOverallEvents(group = 1) overallEvents2 <- dataInput$getOverallEvents(group = 2) overallTestStatistics <- rep(NA_real_, design$kMax) overallPValues <- rep(NA_real_, design$kMax) for (k in 1:stage) { if (normalApproximation) { if (thetaH0 == 0) { if ((overallEvents1[k] + overallEvents2[k] == 0) || (overallEvents1[k] + overallEvents2[k] == sum(dataInput$getSampleSizesUpTo(k, 1)) + sum(dataInput$getSampleSizesUpTo(k, 2)))) { overallTestStatistics[k] <- 0 } else { overallRateH0 <- (overallEvents1[k] + overallEvents2[k]) / (sum(dataInput$getSampleSizesUpTo(k, 1)) + sum(dataInput$getSampleSizesUpTo(k, 2))) overallTestStatistics[k] <- (overallEvents1[k] / sum(dataInput$getSampleSizesUpTo(k, 1)) - overallEvents2[k] / sum(dataInput$getSampleSizesUpTo(k, 2)) - thetaH0) / sqrt(overallRateH0 * (1 - overallRateH0) * (1 / sum(dataInput$getSampleSizesUpTo(k, 1)) + 1 / sum(dataInput$getSampleSizesUpTo(k, 2)))) } } else { y <- .getFarringtonManningValues( rate1 = overallEvents1[k] / sum(dataInput$getSampleSizesUpTo(k, 1)), rate2 = overallEvents2[k] / sum(dataInput$getSampleSizesUpTo(k, 2)), theta = thetaH0, allocation = sum(dataInput$getSampleSizesUpTo(k, 1)) / sum(dataInput$getSampleSizesUpTo(k, 2)), "diff" ) overallTestStatistics[k] <- (overallEvents1[k] / sum(dataInput$getSampleSizesUpTo(k, 1)) - overallEvents2[k] / sum(dataInput$getSampleSizesUpTo(k, 2)) - thetaH0) / sqrt(y$ml1 * (1 - y$ml1) / sum(dataInput$getSampleSizesUpTo(k, 1)) + y$ml2 * (1 - y$ml2) / sum(dataInput$getSampleSizesUpTo(k, 2))) } if (directionUpper) { overallPValues[k] <- 1 - stats::pnorm(overallTestStatistics[k]) } else { overallPValues[k] <- stats::pnorm(overallTestStatistics[k]) } } else { if (thetaH0 != 0) { stop( C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "thetaH0 must be equal 0 for performing Fisher's exact test" ) } if (directionUpper) { overallPValues[k] <- stats::phyper(overallEvents1[k] - 1, overallEvents1[k] + overallEvents2[k], sum(dataInput$getSampleSizesUpTo(k, 1)) + sum(dataInput$getSampleSizesUpTo(k, 2)) - overallEvents1[k] - overallEvents2[k], sum(dataInput$getSampleSizesUpTo(k, 1)), lower.tail = FALSE ) } else { overallPValues[k] <- stats::phyper(overallEvents1[k], overallEvents1[k] + overallEvents2[k], sum(dataInput$getSampleSizesUpTo(k, 1)) + sum(dataInput$getSampleSizesUpTo(k, 2)) - overallEvents1[k] - overallEvents2[k], sum(dataInput$getSampleSizesUpTo(k, 1)), lower.tail = TRUE ) } overallTestStatistics <- .getOneMinusQNorm(overallPValues) } } effectSizes[1:stage] <- overallEvents1[1:stage] / cumsum(dataInput$getSampleSizesUpTo(stage, 1)) - overallEvents2[1:stage] / cumsum(dataInput$getSampleSizesUpTo(stage, 2)) } # calculation of stage-wise test statistics and combination tests testStatistics <- rep(NA_real_, design$kMax) pValues <- rep(NA_real_, design$kMax) combInverseNormal <- rep(NA_real_, design$kMax) combFisher <- rep(NA_real_, design$kMax) weightsInverseNormal <- .getWeightsInverseNormal(design) weightsFisher <- .getWeightsFisher(design) for (k in 1:stage) { if (dataInput$getNumberOfGroups() == 1) { if (normalApproximation) { # stage-wise test statistics testStatistics[k] <- (dataInput$getEvent(k) / dataInput$getSampleSize(k) - thetaH0) / sqrt(thetaH0 * (1 - thetaH0)) * sqrt(dataInput$getSampleSize(k)) pValues[k] <- 1 - stats::pnorm(testStatistics[k]) if (!directionUpper) { pValues[k] <- 1 - pValues[k] } } else { testStatistics[k] <- NA_real_ if (directionUpper) { pValues[k] <- stats::pbinom(dataInput$getEvent(k) - 1, dataInput$getSampleSize(k), thetaH0, lower.tail = FALSE ) } else { pValues[k] <- stats::pbinom(dataInput$getEvent(k), dataInput$getSampleSize(k), thetaH0, lower.tail = TRUE ) } } } else if (dataInput$getNumberOfGroups() == 2) { if (normalApproximation) { # stage-wise test statistics if (thetaH0 == 0) { if ((dataInput$getEvent(k, 1) + dataInput$getEvent(k, 2) == 0) || (dataInput$getEvent(k, 1) + dataInput$getEvent(k, 2) == dataInput$getSampleSize(k, 1) + dataInput$getSampleSize(k, 2))) { testStatistics[k] <- 0 } else { rateH0 <- (dataInput$getEvent(k, 1) + dataInput$getEvent(k, 2)) / (dataInput$getSampleSize(k, 1) + dataInput$getSampleSize(k, 2)) testStatistics[k] <- (dataInput$getEvent(k, 1) / dataInput$getSampleSize(k, 1) - dataInput$getEvent(k, 2) / dataInput$getSampleSize(k, 2) - thetaH0) / sqrt(rateH0 * (1 - rateH0) * (1 / dataInput$getSampleSize(k, 1) + 1 / dataInput$getSampleSize(k, 2))) } } else { y <- .getFarringtonManningValues( rate1 = dataInput$getEvent(k, 1) / dataInput$getSampleSize(k, 1), rate2 = dataInput$getEvent(k, 2) / dataInput$getSampleSize(k, 2), theta = thetaH0, allocation = dataInput$getSampleSize(k, 1) / dataInput$getSampleSize(k, 2), method = "diff" ) testStatistics[k] <- (dataInput$getEvent(k, 1) / dataInput$getSampleSize(k, 1) - dataInput$getEvent(k, 2) / dataInput$getSampleSize(k, 2) - thetaH0) / sqrt(y$ml1 * (1 - y$ml1) / dataInput$getSampleSize(k, 1) + y$ml2 * (1 - y$ml2) / dataInput$getSampleSize(k, 2)) } if (directionUpper) { pValues[k] <- 1 - stats::pnorm(testStatistics[k]) } else { pValues[k] <- stats::pnorm(testStatistics[k]) } } else { testStatistics[k] <- NA_real_ if (directionUpper) { pValues[k] <- stats::phyper(dataInput$getEvent(k, 1) - 1, dataInput$getEvent(k, 1) + dataInput$getEvent(k, 2), dataInput$getSampleSize(k, 1) + dataInput$getSampleSize(k, 2) - dataInput$getEvent(k, 1) - dataInput$getEvent(k, 2), dataInput$getSampleSize(k, 1), lower.tail = FALSE ) } else { pValues[k] <- stats::phyper(dataInput$getEvent(k, 1), dataInput$getEvent(k, 1) + dataInput$getEvent(k, 2), dataInput$getSampleSize(k, 1) + dataInput$getSampleSize(k, 2) - dataInput$getEvent(k, 1) - dataInput$getEvent(k, 2), dataInput$getSampleSize(k, 1), lower.tail = TRUE ) } } } # inverse normal test combInverseNormal[k] <- (weightsInverseNormal[1:k] %*% .getOneMinusQNorm(pValues[1:k])) / sqrt(sum(weightsInverseNormal[1:k]^2)) # Fisher combination test combFisher[k] <- prod(pValues[1:k]^weightsFisher[1:k]) } direction <- ifelse(directionUpper, C_DIRECTION_UPPER, C_DIRECTION_LOWER) stageResults <- StageResultsRates( design = design, dataInput = dataInput, stage = as.integer(stage), overallTestStatistics = .fillWithNAs(overallTestStatistics, design$kMax), overallPValues = .fillWithNAs(overallPValues, design$kMax), effectSizes = effectSizes, overallEvents = .fillWithNAs(dataInput$getOverallEventsUpTo(stage, group = 1), design$kMax), overallSampleSizes = .fillWithNAs(dataInput$getOverallSampleSizesUpTo(stage, 1), design$kMax), testStatistics = testStatistics, pValues = pValues, combInverseNormal = combInverseNormal, combFisher = combFisher, weightsInverseNormal = weightsInverseNormal, weightsFisher = weightsFisher, thetaH0 = thetaH0, direction = ifelse(directionUpper, C_DIRECTION_UPPER, C_DIRECTION_LOWER), normalApproximation = normalApproximation ) if (dataInput$getNumberOfGroups() == 1) { stageResults$overallEvents <- .fillWithNAs(dataInput$getOverallEventsUpTo(stage, group = 1), design$kMax) stageResults$overallSampleSizes <- .fillWithNAs(dataInput$getOverallSampleSizesUpTo(stage, 1), design$kMax) stageResults$overallPi1 <- stageResults$overallEvents / stageResults$overallSampleSizes stageResults$.setParameterType("overallPi1", C_PARAM_GENERATED) } else if (dataInput$getNumberOfGroups() == 2) { stageResults$overallEvents1 <- .fillWithNAs(dataInput$getOverallEventsUpTo(stage, group <- 1), design$kMax) stageResults$overallEvents2 <- .fillWithNAs(dataInput$getOverallEventsUpTo(stage, group <- 2), design$kMax) stageResults$overallSampleSizes1 <- .fillWithNAs(dataInput$getOverallSampleSizesUpTo(stage, 1), design$kMax) stageResults$overallSampleSizes2 <- .fillWithNAs(dataInput$getOverallSampleSizesUpTo(stage, 2), design$kMax) stageResults$overallPi1 <- stageResults$overallEvents1 / stageResults$overallSampleSizes1 stageResults$overallPi2 <- stageResults$overallEvents2 / stageResults$overallSampleSizes2 stageResults$.setParameterType("overallPi1", C_PARAM_GENERATED) stageResults$.setParameterType("overallPi2", C_PARAM_GENERATED) } if (.isTrialDesignFisher(design)) { stageResults$.setParameterType("combFisher", C_PARAM_GENERATED) stageResults$.setParameterType("weightsFisher", C_PARAM_GENERATED) } else if (.isTrialDesignInverseNormal(design)) { stageResults$.setParameterType("combInverseNormal", C_PARAM_GENERATED) stageResults$.setParameterType("weightsInverseNormal", C_PARAM_GENERATED) } return(stageResults) } # # Calculation of lower and upper limits of repeated confidence intervals (RCIs) for Rates # .getRepeatedConfidenceIntervalsRates <- function(..., design) { if (.isTrialDesignGroupSequential(design)) { return(.getRepeatedConfidenceIntervalsRatesGroupSequential(design = design, ...)) } if (.isTrialDesignInverseNormal(design)) { return(.getRepeatedConfidenceIntervalsRatesInverseNormal(design = design, ...)) } if (.isTrialDesignFisher(design)) { return(.getRepeatedConfidenceIntervalsRatesFisher(design = design, ...)) } .stopWithWrongDesignMessage(design) } .getRootThetaRates <- function(..., design, dataInput, stage, directionUpper, normalApproximation, firstParameterName, secondValue, tolerance, acceptResultsOutOfTolerance, callingFunctionInformation) { if (dataInput$getNumberOfGroups() == 2) { thetaLow <- -1 + tolerance } else { thetaLow <- tolerance } thetaUp <- 1 - tolerance if (dataInput$getNumberOfGroups() == 1 && !normalApproximation) { acceptResultsOutOfTolerance <- FALSE } result <- .getOneDimensionalRoot( function(theta) { stageResults <- .getStageResultsRates( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, normalApproximation = normalApproximation ) firstValue <- stageResults[[firstParameterName]][stage] if (.isTrialDesignGroupSequential(design)) { firstValue <- .getOneMinusQNorm(firstValue) } return(firstValue - secondValue) }, lower = thetaLow, upper = thetaUp, tolerance = tolerance, acceptResultsOutOfTolerance = acceptResultsOutOfTolerance, callingFunctionInformation = callingFunctionInformation ) return(result) } .getRepeatedConfidenceIntervalsRatesAll <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, firstParameterName) { stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) if (!normalApproximation && dataInput$getNumberOfGroups() == 2) { normalApproximation <- TRUE message("Repeated confidence intervals will be calculated under the normal approximation") } futilityCorr <- rep(NA_real_, design$kMax) # necessary for adjustment for binding futility boundaries criticalValues <- design$criticalValues if (.isTrialDesignFisher(design)) { bounds <- design$alpha0Vec border <- C_ALPHA_0_VEC_DEFAULT conditionFunction <- .isFirstValueSmallerThanSecondValue } else { criticalValues[is.infinite(criticalValues) & criticalValues > 0] <- C_QNORM_MAXIMUM criticalValues[is.infinite(criticalValues) & criticalValues < 0] <- C_QNORM_MINIMUM bounds <- design$futilityBounds border <- C_FUTILITY_BOUNDS_DEFAULT conditionFunction <- .isFirstValueGreaterThanSecondValue } repeatedConfidenceIntervals <- matrix(NA_real_, 2, design$kMax) for (k in (1:stage)) { startTime <- Sys.time() # finding upper and lower RCI limits through root function if (dataInput$getNumberOfGroups() == 1) { if (dataInput$overallEvents[k] == 0) { repeatedConfidenceIntervals[1, k] <- 0 } else { repeatedConfidenceIntervals[1, k] <- .getRootThetaRates( design = design, dataInput = dataInput, stage = k, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = normalApproximation, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance, acceptResultsOutOfTolerance = TRUE, callingFunctionInformation = paste0("Repeated confidence interval [1, ", k, "]") ) } if (dataInput$overallEvents[k] == dataInput$overallSampleSizes[k]) { repeatedConfidenceIntervals[2, k] <- 1 } else { repeatedConfidenceIntervals[2, k] <- .getRootThetaRates( design = design, dataInput = dataInput, stage = k, directionUpper = FALSE, normalApproximation = normalApproximation, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance, acceptResultsOutOfTolerance = TRUE, callingFunctionInformation = paste0("Repeated confidence interval [2, ", k, "]") ) } } else if (dataInput$getNumberOfGroups() == 2) { repeatedConfidenceIntervals[1, k] <- .getRootThetaRates( design = design, dataInput = dataInput, stage = k, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = normalApproximation, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance, acceptResultsOutOfTolerance = TRUE, callingFunctionInformation = paste0("Repeated confidence interval [1, ", k, "]") ) repeatedConfidenceIntervals[2, k] <- .getRootThetaRates( design = design, dataInput = dataInput, stage = k, directionUpper = FALSE, normalApproximation = normalApproximation, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance, acceptResultsOutOfTolerance = TRUE, callingFunctionInformation = paste0("Repeated confidence interval [1, ", k, "]") ) } # adjustment for binding futility bounds if (k > 1 && conditionFunction(bounds[k - 1], border) && design$bindingFutility) { parameterName <- ifelse(.isTrialDesignFisher(design), "pValues", firstParameterName) futilityCorr[k] <- .getRootThetaRates( design = design, dataInput = dataInput, stage = k - 1, directionUpper = directionUpper, normalApproximation = normalApproximation, firstParameterName = parameterName, secondValue = bounds[k - 1], tolerance = tolerance, acceptResultsOutOfTolerance = TRUE, callingFunctionInformation = paste0("Repeated confidence interval, futility correction [", k, "]") ) if (directionUpper) { repeatedConfidenceIntervals[1, k] <- min(min(futilityCorr[2:k]), repeatedConfidenceIntervals[1, k]) } else { repeatedConfidenceIntervals[2, k] <- max(max(futilityCorr[2:k]), repeatedConfidenceIntervals[2, k]) } } .logProgress("Repeated confidence interval of stage %s calculated", startTime = startTime, k) } if (!is.na(repeatedConfidenceIntervals[1, k]) && !is.na(repeatedConfidenceIntervals[2, k]) && repeatedConfidenceIntervals[1, k] > repeatedConfidenceIntervals[2, k]) { repeatedConfidenceIntervals[, k] <- rep(NA_real_, 2) } return(repeatedConfidenceIntervals) } # # RCIs based on group sequential method # .getRepeatedConfidenceIntervalsRatesGroupSequential <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsRatesGroupSequential", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) return(.getRepeatedConfidenceIntervalsRatesAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, directionUpper = directionUpper, firstParameterName = "overallPValues", tolerance = tolerance, ... )) } # # RCIs based on inverse normal combination test # .getRepeatedConfidenceIntervalsRatesInverseNormal <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsRatesInverseNormal", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) return(.getRepeatedConfidenceIntervalsRatesAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, directionUpper = directionUpper, firstParameterName = "combInverseNormal", tolerance = tolerance, ... )) } # # RCIs based on Fisher's combination test # .getRepeatedConfidenceIntervalsRatesFisher <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsRatesFisher", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) return(.getRepeatedConfidenceIntervalsRatesAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, directionUpper = directionUpper, firstParameterName = "combFisher", tolerance = tolerance, ... )) } .calculateThetaH1 <- function(stageResults, pi1, pi2, stage, kMax, nPlanned, allocationRatioPlanned) { # Shifted decision region for use in getGroupSequentialProbabilities # Inverse normal method condError <- getConditionalRejectionProbabilities(stageResults = stageResults)[stage] if (stageResults$isOneSampleDataset()) { if (condError < 1e-12) { adjustment <- 0 } else { adjustment <- .getOneMinusQNorm(condError) * (1 - sqrt(stageResults$thetaH0 * (1 - stageResults$thetaH0)) / sqrt(pi1 * (1 - pi1))) / sqrt(sum(nPlanned[(stage + 1):kMax])) } if (stageResults$direction == "upper") { thetaH1 <- (pi1 - stageResults$thetaH0) / sqrt(pi1 * (1 - pi1)) + adjustment } else { thetaH1 <- -(pi1 - stageResults$thetaH0) / sqrt(pi1 * (1 - pi1)) + adjustment } return(list(thetaH1 = thetaH1, nPlanned = nPlanned)) } .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) x <- .getFarringtonManningValues( rate1 = pi1, rate2 = pi2, theta = stageResults$thetaH0, allocation = allocationRatioPlanned ) if (condError < 1e-12) { adjustment <- 0 } else { adjustment <- .getOneMinusQNorm(condError) * (1 - sqrt(x$ml1 * (1 - x$ml1) + allocationRatioPlanned * x$ml2 * (1 - x$ml2)) / sqrt(pi1 * (1 - pi1) + allocationRatioPlanned * pi2 * (1 - pi2))) * (1 + allocationRatioPlanned) / sqrt(allocationRatioPlanned * sum(nPlanned[(stage + 1):kMax])) } if (stageResults$direction == "upper") { thetaH1 <- (pi1 - pi2 - stageResults$thetaH0) / sqrt(pi1 * (1 - pi1) + allocationRatioPlanned * pi2 * (1 - pi2)) * sqrt(1 + allocationRatioPlanned) + adjustment } else { thetaH1 <- -(pi1 - pi2 - stageResults$thetaH0) / sqrt(pi1 * (1 - pi1) + allocationRatioPlanned * pi2 * (1 - pi2)) * sqrt(1 + allocationRatioPlanned) + adjustment } nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned return(list(thetaH1 = thetaH1, nPlanned = nPlanned)) } # # Calculation of conditional power based on group sequential / inverse normal method # .getConditionalPowerRatesInverseNormalOrGroupSequential <- function(..., stageResults, stage = stageResults$stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, pi1, pi2) { design <- stageResults$.design .assertIsTrialDesignInverseNormalOrGroupSequential(design) .assertIsValidStage(stage, design$kMax) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerRatesInverseNormalOrGroupSequential", ignore = c("design", "stageResultsName", "grid", "pi1H1", "pi2H1"), ... ) kMax <- design$kMax conditionalPower <- rep(NA_real_, kMax) weights <- stageResults$weightsInverseNormal informationRates <- design$informationRates nPlanned <- c(rep(NA, stage), nPlanned) if (stage == kMax) { .logDebug( "Conditional power will be calculated only for subsequent stages ", "(stage = ", stage, ", kMax = ", design$kMax, ")" ) return(list( nPlanned = nPlanned, conditionalPower = conditionalPower )) } criticalValuesInverseNormal <- design$criticalValues resultList <- .calculateThetaH1(stageResults, pi1, pi2, stage, kMax, nPlanned, allocationRatioPlanned) thetaH1 <- resultList$thetaH1 nPlanned <- resultList$nPlanned shiftedDecisionRegionUpper <- criticalValuesInverseNormal[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - c(weights[1:stage] %*% .getOneMinusQNorm(stageResults$pValues[1:stage])) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - thetaH1 * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) if (design$sided == 2) { shiftedDecisionRegionLower <- -criticalValuesInverseNormal[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - c(weights[1:stage] %*% .getOneMinusQNorm(stageResults$pValues[1:stage])) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - thetaH1 * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) } if (stage == kMax - 1) { shiftedFutilityBounds <- c() } else { shiftedFutilityBounds <- design$futilityBounds[(stage + 1):(kMax - 1)] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):(kMax - 1)]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - c(weights[1:stage] %*% .getOneMinusQNorm(stageResults$pValues[1:stage])) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - thetaH1 * cumsum(sqrt(nPlanned[(stage + 1):(kMax - 1)]) * weights[(stage + 1):(kMax - 1)]) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) } # Scaled information for use in getGroupSeqProbs scaledInformation <- (informationRates[(stage + 1):kMax] - informationRates[stage]) / (1 - informationRates[stage]) if (design$sided == 2) { decisionMatrix <- matrix(c(shiftedDecisionRegionLower, shiftedDecisionRegionUpper), nrow = 2, byrow = TRUE) } else { decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, shiftedDecisionRegionUpper ), nrow = 2, byrow = TRUE) } probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = scaledInformation ) if (design$twoSidedPower) { conditionalPower[(stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ] + probs[1, ]) } else { conditionalPower[(stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ]) } if (stageResults$isTwoSampleDataset()) { nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned } return(list( nPlanned = nPlanned, conditionalPower = conditionalPower )) } # # Calculation of conditional power based on Fisher combination test # .getConditionalPowerRatesFisher <- function(..., stageResults, stage = stageResults$stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, pi1, pi2, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { design <- stageResults$.design .assertIsTrialDesignFisher(design) .assertIsValidStage(stage, design$kMax) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerRatesFisher", ignore = c("design", "stageResultsName", "grid", "pi1H1", "pi2H1"), ... ) kMax <- design$kMax conditionalPower <- rep(NA_real_, kMax) seed <- .setSeed(seed) simulated <- FALSE nPlanned <- c(rep(NA, stage), nPlanned) resultList <- .calculateThetaH1(stageResults, pi1, pi2, stage, kMax, nPlanned, allocationRatioPlanned) thetaH1 <- resultList$thetaH1 nPlanned <- resultList$nPlanned criticalValues <- design$criticalValues weightsFisher <- stageResults$weightsFisher pValues <- stageResults$pValues if (stage < kMax - 1) { for (k in (stage + 1):kMax) { reject <- 0 for (i in 1:iterations) { reject <- reject + .getRejectValueConditionalPowerFisher( kMax = kMax, alpha0Vec = design$alpha0Vec, criticalValues = criticalValues, weightsFisher = weightsFisher, pValues = pValues, currentKMax = k, thetaH1 = thetaH1, stage = stage, nPlanned = nPlanned ) } conditionalPower[k] <- reject / iterations } simulated <- TRUE } if (stage == kMax - 1) { divisor <- prod(pValues[1:(kMax - 1)]^weightsFisher[1:(kMax - 1)]) result <- 1 - (criticalValues[kMax] / divisor)^(1 / weightsFisher[kMax]) if (result <= 0 || result >= 1) { warning("Calculation not possible: could not calculate conditional power for stage ", kMax, call. = FALSE) conditionalPower[kMax] <- NA_real_ } else { conditionalPower[kMax] <- 1 - stats::pnorm(.getQNorm(result) - thetaH1 * sqrt(nPlanned[kMax])) } } if (stageResults$isTwoSampleDataset()) { nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned } return(list( nPlanned = nPlanned, conditionalPower = conditionalPower, iterations = as.integer(iterations), seed = seed, simulated = simulated )) } .getConditionalPowerRates <- function(..., stageResults, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, pi1 = NA_real_, pi2 = NA_real_) { pi1H1 <- .getOptionalArgument("pi1H1", ...) if (!is.null(pi1H1) && !is.na(pi1H1)) { if (!is.na(pi1)) { warning(sQuote("pi1"), " will be ignored because ", sQuote("pi1H1"), " is defined", call. = FALSE) } pi1 <- pi1H1 } pi2H1 <- .getOptionalArgument("pi2H1", ...) if (!is.null(pi2H1) && !is.na(pi2H1)) { if (!is.na(pi2)) { warning(sQuote("pi2"), " will be ignored because ", sQuote("pi2H1"), " is defined", call. = FALSE) } pi2 <- pi2H1 } stage <- stageResults$stage pi1 <- .assertIsValidPi1(pi1, stageResults, stage) if (!stageResults$isOneSampleDataset()) { pi2 <- .assertIsValidPi2(pi2, stageResults, stage) } results <- ConditionalPowerResultsRates( .stageResults = stageResults, .design = stageResults$.design, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, pi1 = pi1, pi2 = pi2 ) if (any(is.na(nPlanned))) { return(results) } if (!.isValidNPlanned(nPlanned = nPlanned, kMax = stageResults$.design$kMax, stage = stage)) { return(results) } if (.isTrialDesignInverseNormalOrGroupSequential(stageResults$.design)) { cp <- .getConditionalPowerRatesInverseNormalOrGroupSequential(..., stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, pi1 = pi1, pi2 = pi2 ) } else if (.isTrialDesignFisher(stageResults$.design)) { cp <- .getConditionalPowerRatesFisher(..., stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, pi1 = pi1, pi2 = pi2 ) results$iterations <- cp$iterations results$seed <- cp$seed results$simulated <- cp$simulated if (results$simulated) { results$.setParameterType( "iterations", ifelse(is.null(.getOptionalArgument("iterations", ...)), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED ) ) results$.setParameterType( "seed", ifelse(is.null(.getOptionalArgument("seed", ...)), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED ) ) } } else { .stopWithWrongDesignMessage(stageResults$.design) } results$nPlanned <- cp$nPlanned results$conditionalPower <- cp$conditionalPower results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$.setParameterType( "allocationRatioPlanned", ifelse(allocationRatioPlanned == C_ALLOCATION_RATIO_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED) ) results$.setParameterType("pi1", ifelse(is.na(pi1), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) results$.setParameterType("pi2", ifelse(is.na(pi2), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) return(results) } .getConditionalPowerPlotRates <- function(..., stageResults, stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, piTreatmentRange, pi2) { if (stageResults$isOneSampleDataset()) { .associatedArgumentsAreDefined(nPlanned = nPlanned, piTreatmentRange = piTreatmentRange) pi2 <- NA_real_ } else { .associatedArgumentsAreDefined(nPlanned = nPlanned, pi2 = pi2, piTreatmentRange = piTreatmentRange) } .assertIsValidAllocationRatioPlanned( allocationRatioPlanned, stageResults$getDataInput()$getNumberOfGroups() ) .assertIsValidPi(pi2, "pi2") piTreatmentRange <- .assertIsValidPiTreatmentRange(piTreatmentRange = piTreatmentRange) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerPlotRates", ignore = c("iterations", "seed", "stageResultsName", "grid"), ... ) condPowerValues <- rep(NA, length(piTreatmentRange)) likelihoodValues <- rep(NA, length(piTreatmentRange)) design <- stageResults$.design warningMessages <- c() withCallingHandlers( if (stageResults$isOneSampleDataset()) { mu <- stageResults$effectSizes[stage] stdErr <- sqrt(stageResults$effectSizes[stage] * (1 - stageResults$effectSizes[stage]) / stageResults$overallSampleSizes[stage]) for (i in seq(along = piTreatmentRange)) { if (.isTrialDesignInverseNormalOrGroupSequential(design)) { condPowerValues[i] <- .getConditionalPowerRatesInverseNormalOrGroupSequential( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, pi1 = piTreatmentRange[i], pi2 = pi2 )$conditionalPower[design$kMax] } else if (.isTrialDesignFisher(design)) { condPowerValues[i] <- .getConditionalPowerRatesFisher( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, pi1 = piTreatmentRange[i], pi2 = pi2 )$conditionalPower[design$kMax] } likelihoodValues[i] <- stats::dnorm(piTreatmentRange[i], mu, stdErr) / stats::dnorm(0, 0, stdErr) } }, warning = function(w) { m <- w$message if (!(m %in% warningMessages)) { warningMessages <<- c(warningMessages, m) } invokeRestart("muffleWarning") }, error = function(e) { e } ) if (stageResults$isTwoSampleDataset()) { mu <- stageResults$overallEvents1[stage] / stageResults$overallSampleSizes1[stage] stdErr <- sqrt(stageResults$overallEvents1[stage] / stageResults$overallSampleSizes1[stage] * (1 - stageResults$overallEvents1[stage] / stageResults$overallSampleSizes1[stage]) / stageResults$overallSampleSizes1[stage]) withCallingHandlers( for (i in seq(along = piTreatmentRange)) { if (.isTrialDesignInverseNormalOrGroupSequential(design)) { condPowerValues[i] <- .getConditionalPowerRatesInverseNormalOrGroupSequential( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, pi1 = piTreatmentRange[i], pi2 = pi2 )$conditionalPower[design$kMax] } else if (.isTrialDesignFisher(design)) { condPowerValues[i] <- .getConditionalPowerRatesFisher( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, pi1 = piTreatmentRange[i], pi2 = pi2 )$conditionalPower[design$kMax] } likelihoodValues[i] <- stats::dnorm(piTreatmentRange[i], mu, stdErr) / stats::dnorm(0, 0, stdErr) }, warning = function(w) { m <- w$message if (!(m %in% warningMessages)) { warningMessages <<- c(warningMessages, m) } invokeRestart("muffleWarning") }, error = function(e) { e } ) } if (length(warningMessages) > 0) { for (m in warningMessages) { warning(m, call. = FALSE) } } if (stageResults$isOneSampleDataset()) { subtitle <- paste0("Stage = ", stage, ", # of remaining subjects = ", sum(nPlanned)) } else { subtitle <- paste0( "Stage = ", stage, ", # of remaining subjects = ", sum(nPlanned), ", pi2 = ", .formatSubTitleValue(pi2, "pi2"), ", allocation ratio = ", .formatSubTitleValue(allocationRatioPlanned, "allocationRatioPlanned") ) } return(list( xValues = piTreatmentRange, condPowerValues = condPowerValues, likelihoodValues = likelihoodValues, main = C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, xlab = "pi1", ylab = C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, sub = subtitle )) } # # Calculation of final confidence interval # based on group sequential test without SSR (general case). # .getFinalConfidenceIntervalRatesGroupSequential <- function(..., design, dataInput, stage, thetaH0 = C_THETA_H0_RATES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { stageResults <- .getStageResultsRates( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation ) finalConfidenceIntervalGeneral <- rep(NA_real_, 2) medianUnbiasedGeneral <- NA_real_ stageGroupSeq <- .getStageGroupSeq(design = design, stageResults = stageResults, stage = stage) finalStage <- min(stageGroupSeq, design$kMax) # early stopping or at end of study if (stageGroupSeq < design$kMax || stage == design$kMax) { if (stageGroupSeq == 1) { finalConfidenceIntervalGeneral[1] <- stageResults$overallTestStatistics[1] - .getOneMinusQNorm(design$alpha / design$sided) finalConfidenceIntervalGeneral[2] <- stageResults$overallTestStatistics[1] + .getOneMinusQNorm(design$alpha / design$sided) medianUnbiasedGeneral <- stageResults$overallTestStatistics[1] if (dataInput$getNumberOfGroups() == 1) { finalConfidenceIntervalGeneral <- finalConfidenceIntervalGeneral / sqrt(stageResults$overallSampleSizes[1]) medianUnbiasedGeneral <- medianUnbiasedGeneral / sqrt(stageResults$overallSampleSizes[1]) } else { finalConfidenceIntervalGeneral <- finalConfidenceIntervalGeneral * sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) medianUnbiasedGeneral <- medianUnbiasedGeneral * sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) } } else { finalConfidenceIntervalGeneral[1] <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "overallPValues", case = "finalConfidenceIntervalGeneralLower" ) finalConfidenceIntervalGeneral[2] <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "overallPValues", case = "finalConfidenceIntervalGeneralUpper" ) medianUnbiasedGeneral <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "overallPValues", case = "medianUnbiasedGeneral" ) } } if (is.na(finalConfidenceIntervalGeneral[1]) && (stageGroupSeq > 1)) { finalStage <- NA_integer_ } finalConfidenceInterval <- rep(NA_real_, 2) medianUnbiased <- NA_real_ if (!is.na(finalStage)) { # Retransformation if (dataInput$getNumberOfGroups() == 1) { stErrRates <- sqrt(stageResults$overallEvents[finalStage] / stageResults$overallSampleSizes[finalStage] * (1 - stageResults$overallEvents[finalStage] / stageResults$overallSampleSizes[finalStage])) / sqrt(stageResults$overallSampleSizes[finalStage]) } else { stErrRates <- sqrt(stageResults$overallEvents1[finalStage] / stageResults$overallSampleSizes1[finalStage] * (1 - stageResults$overallEvents1[finalStage] / stageResults$overallSampleSizes1[finalStage]) / stageResults$overallSampleSizes1[finalStage] + stageResults$overallEvents2[finalStage] / stageResults$overallSampleSizes2[finalStage] * (1 - stageResults$overallEvents2[finalStage] / stageResults$overallSampleSizes2[finalStage]) / stageResults$overallSampleSizes2[finalStage]) } directionUpperSign <- ifelse(directionUpper, 1, -1) if (stageGroupSeq == 1) { finalConfidenceInterval[1] <- .getRootThetaRates( design = design, dataInput = dataInput, stage = 1, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, firstParameterName = "overallPValues", secondValue = .getOneMinusQNorm(design$alpha / design$sided), tolerance = tolerance, acceptResultsOutOfTolerance = TRUE, callingFunctionInformation = "Final confidence interval [1]" ) finalConfidenceInterval[2] <- .getRootThetaRates( design = design, dataInput = dataInput, stage = 1, directionUpper = FALSE, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, firstParameterName = "overallPValues", secondValue = .getOneMinusQNorm(design$alpha / design$sided), tolerance = tolerance, acceptResultsOutOfTolerance = TRUE, callingFunctionInformation = "Final confidence interval [2]" ) medianUnbiased <- stageResults$effectSizes[1] } else { if (dataInput$getNumberOfGroups() == 1) { finalConfidenceInterval[1] <- finalConfidenceIntervalGeneral[1] * sqrt(stageResults$overallSampleSizes[finalStage]) * stErrRates + directionUpperSign * thetaH0 finalConfidenceInterval[2] <- finalConfidenceIntervalGeneral[2] * sqrt(stageResults$overallSampleSizes[finalStage]) * stErrRates + directionUpperSign * thetaH0 medianUnbiased <- medianUnbiasedGeneral * sqrt(stageResults$overallSampleSizes[finalStage]) * stErrRates + directionUpperSign * thetaH0 } else { finalConfidenceInterval[1] <- finalConfidenceIntervalGeneral[1] / sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) * stErrRates + directionUpperSign * thetaH0 finalConfidenceInterval[2] <- finalConfidenceIntervalGeneral[2] / sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) * stErrRates + directionUpperSign * thetaH0 medianUnbiased <- medianUnbiasedGeneral / sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) * stErrRates + directionUpperSign * thetaH0 } } } if (!directionUpper) { medianUnbiasedGeneral <- -medianUnbiasedGeneral finalConfidenceIntervalGeneral <- -finalConfidenceIntervalGeneral if (stageGroupSeq > 1) { medianUnbiased <- -medianUnbiased finalConfidenceInterval <- -finalConfidenceInterval } } finalConfidenceIntervalGeneral <- sort(finalConfidenceIntervalGeneral) finalConfidenceInterval <- sort(finalConfidenceInterval) if (dataInput$getNumberOfGroups() == 1) { finalConfidenceInterval[1] <- max(0, finalConfidenceInterval[1]) finalConfidenceInterval[2] <- min(1, finalConfidenceInterval[2]) } else { finalConfidenceInterval[1] <- max(-1, finalConfidenceInterval[1]) finalConfidenceInterval[2] <- min(1, finalConfidenceInterval[2]) } return(list( finalStage = finalStage, medianUnbiasedGeneral = medianUnbiasedGeneral, finalConfidenceIntervalGeneral = finalConfidenceIntervalGeneral, medianUnbiased = medianUnbiased, finalConfidenceInterval = finalConfidenceInterval )) } # # Calculation of final confidence interval # based on inverse normal method, only valid for kMax <= 2 or no SSR. # .getFinalConfidenceIntervalRatesInverseNormal <- function(..., design, dataInput, stage, thetaH0 = C_THETA_H0_RATES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { stageResults <- .getStageResultsRates( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation ) finalConfidenceIntervalGeneral <- rep(NA_real_, 2) medianUnbiasedGeneral <- NA_real_ stageInverseNormal <- .getStageInverseNormal(design = design, stageResults = stageResults, stage = stage) finalStage <- min(stageInverseNormal, design$kMax) # Early stopping or at end of study if (stageInverseNormal < design$kMax || stage == design$kMax) { if (stageInverseNormal == 1) { finalConfidenceIntervalGeneral[1] <- stageResults$combInverseNormal[1] - .getOneMinusQNorm(design$alpha / design$sided) finalConfidenceIntervalGeneral[2] <- stageResults$combInverseNormal[1] + .getOneMinusQNorm(design$alpha / design$sided) medianUnbiasedGeneral <- stageResults$combInverseNormal[1] if (dataInput$getNumberOfGroups() == 1) { finalConfidenceIntervalGeneral <- finalConfidenceIntervalGeneral / sqrt(stageResults$overallSampleSizes[1]) medianUnbiasedGeneral <- medianUnbiasedGeneral / sqrt(stageResults$overallSampleSizes[1]) } else { finalConfidenceIntervalGeneral <- finalConfidenceIntervalGeneral * sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) medianUnbiasedGeneral <- medianUnbiasedGeneral * sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) } } else { if ((design$kMax > 2) && !.isNoEarlyEfficacy(design)) { message( "Calculation of final confidence interval performed for kMax = ", design$kMax, " (for kMax > 2, it is theoretically shown that it is valid only ", "if no sample size change was performed)" ) } finalConfidenceIntervalGeneral[1] <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "combInverseNormal", case = "finalConfidenceIntervalGeneralLower" ) finalConfidenceIntervalGeneral[2] <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "combInverseNormal", case = "finalConfidenceIntervalGeneralUpper" ) medianUnbiasedGeneral <- .getDecisionMatrixRoot( design = design, stage = finalStage, stageResults = stageResults, tolerance = tolerance, firstParameterName = "combInverseNormal", case = "medianUnbiasedGeneral" ) } } if (is.na(finalConfidenceIntervalGeneral[1]) && (stageInverseNormal > 1)) { finalStage <- NA_integer_ } finalConfidenceInterval <- rep(NA_real_, 2) medianUnbiased <- NA_real_ if (!is.na(finalStage)) { # Retransformation if (dataInput$getNumberOfGroups() == 1) { stErrRates <- sqrt(stageResults$overallEvents[finalStage] / stageResults$overallSampleSizes[finalStage] * (1 - stageResults$overallEvents[finalStage] / stageResults$overallSampleSizes[finalStage])) / sqrt(stageResults$overallSampleSizes[finalStage]) } else { stErrRates <- sqrt(stageResults$overallEvents1[finalStage] / stageResults$overallSampleSizes1[finalStage] * (1 - stageResults$overallEvents1[finalStage] / stageResults$overallSampleSizes1[finalStage]) / stageResults$overallSampleSizes1[finalStage] + stageResults$overallEvents2[finalStage] / stageResults$overallSampleSizes2[finalStage] * (1 - stageResults$overallEvents2[finalStage] / stageResults$overallSampleSizes2[finalStage]) / stageResults$overallSampleSizes2[finalStage]) } directionUpperSign <- ifelse(directionUpper, 1, -1) if (stageInverseNormal == 1) { finalConfidenceInterval[1] <- .getRootThetaRates( design = design, dataInput = dataInput, stage = 1, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = TRUE, firstParameterName = "combInverseNormal", secondValue = .getOneMinusQNorm(design$alpha / design$sided), tolerance = tolerance, acceptResultsOutOfTolerance = TRUE, callingFunctionInformation = "Final confidence interval [1]" ) finalConfidenceInterval[2] <- .getRootThetaRates( design = design, dataInput = dataInput, stage = 1, directionUpper = FALSE, normalApproximation = TRUE, firstParameterName = "combInverseNormal", secondValue = .getOneMinusQNorm(design$alpha / design$sided), tolerance = tolerance, acceptResultsOutOfTolerance = TRUE, callingFunctionInformation = "Final confidence interval [1]" ) medianUnbiased <- stageResults$effectSizes[1] } else { if (dataInput$getNumberOfGroups() == 1) { finalConfidenceInterval[1] <- finalConfidenceIntervalGeneral[1] * sqrt(stageResults$overallSampleSizes[finalStage]) * stErrRates + directionUpperSign * thetaH0 finalConfidenceInterval[2] <- finalConfidenceIntervalGeneral[2] * sqrt(stageResults$overallSampleSizes[finalStage]) * stErrRates + directionUpperSign * thetaH0 medianUnbiased <- medianUnbiasedGeneral * sqrt(stageResults$overallSampleSizes[finalStage]) * stErrRates + directionUpperSign * thetaH0 } else { finalConfidenceInterval[1] <- finalConfidenceIntervalGeneral[1] / sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) * stErrRates + directionUpperSign * thetaH0 finalConfidenceInterval[2] <- finalConfidenceIntervalGeneral[2] / sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) * stErrRates + directionUpperSign * thetaH0 medianUnbiased <- medianUnbiasedGeneral / sqrt(1 / stageResults$overallSampleSizes1[finalStage] + 1 / stageResults$overallSampleSizes2[finalStage]) * stErrRates + directionUpperSign * thetaH0 } } } if (!directionUpper) { medianUnbiasedGeneral <- -medianUnbiasedGeneral finalConfidenceIntervalGeneral <- -finalConfidenceIntervalGeneral if (stageInverseNormal > 1) { medianUnbiased <- -medianUnbiased finalConfidenceInterval <- -finalConfidenceInterval } } finalConfidenceIntervalGeneral <- sort(finalConfidenceIntervalGeneral) finalConfidenceInterval <- sort(finalConfidenceInterval) if (dataInput$getNumberOfGroups() == 1) { finalConfidenceInterval[1] <- max(0, finalConfidenceInterval[1]) finalConfidenceInterval[2] <- min(1, finalConfidenceInterval[2]) } else { finalConfidenceInterval[1] <- max(-1, finalConfidenceInterval[1]) finalConfidenceInterval[2] <- min(1, finalConfidenceInterval[2]) } return(list( finalStage = finalStage, medianUnbiasedGeneral = medianUnbiasedGeneral, finalConfidenceIntervalGeneral = finalConfidenceIntervalGeneral, medianUnbiased = medianUnbiased, finalConfidenceInterval = finalConfidenceInterval )) } # # Calculation of final confidence interval # based on Fisher combination test, only valid for kMax <= 2. # .getFinalConfidenceIntervalRatesFisher <- function(..., design, dataInput, stage, thetaH0 = C_THETA_H0_RATES_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { stageResults <- .getStageResultsRates( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation ) finalConfidenceInterval <- rep(NA_real_, 2) medianUnbiased <- NA_real_ stageFisher <- .getStageFisher(design = design, stageResults = stageResults, stage = stage) finalStage <- min(stageFisher, design$kMax) # Early stopping or at end of study if (stageFisher < design$kMax || stage == design$kMax) { message( "Calculation of final confidence interval for Fisher's ", "design not implemented yet" ) return(list( finalStage = NA_integer_, medianUnbiased = NA_real_, finalConfidenceInterval = rep(NA_real_, design$kMax) )) } return(list( finalStage = finalStage, medianUnbiased = medianUnbiased, finalConfidenceInterval = finalConfidenceInterval )) } .getFinalConfidenceIntervalRates <- function(..., design, dataInput, thetaH0 = NA_real_, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .assertIsValidThetaH0DataInput(thetaH0, dataInput) .warnInCaseOfUnknownArguments( functionName = "getFinalConfidenceIntervalRates", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) if (design$kMax == 1) { return(list( finalStage = NA_integer_, medianUnbiasedGeneral = NA_real_, finalConfidenceIntervalGeneral = c(NA_real_, NA_real_), medianUnbiased = NA_real_, finalConfidenceInterval = c(NA_real_) )) } if (is.na(thetaH0)) { thetaH0 <- C_THETA_H0_RATES_DEFAULT } if (.isTrialDesignGroupSequential(design)) { return(.getFinalConfidenceIntervalRatesGroupSequential( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation, tolerance = tolerance )) } if (.isTrialDesignInverseNormal(design)) { return(.getFinalConfidenceIntervalRatesInverseNormal( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation, tolerance = tolerance )) } if (.isTrialDesignFisher(design)) { return(.getFinalConfidenceIntervalRatesFisher( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation, tolerance = tolerance )) } .stopWithWrongDesignMessage(design) } rpact/R/f_simulation_enrichment_rates.R0000644000175000017500000016314314154651323020160 0ustar nileshnilesh## | ## | *Simulation of enrichment design with binary data* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5644 $ ## | Last changed: $Date: 2021-12-10 14:14:55 +0100 (Fr, 10 Dez 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include f_simulation_enrichment.R NULL .getSimulationRatesEnrichmentStageSubjects <- function(..., stage, directionUpper, conditionalPower, conditionalCriticalValue, plannedSubjects, allocationRatioPlanned, selectedPopulations, piTreatmentH1, piControlH1, overallRatesTreatment, overallRatesControl, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage) { stage <- stage - 1 # to be consistent with non-enrichment situation gMax <- nrow(overallRatesTreatment) if (!is.na(conditionalPower)) { if (any(selectedPopulations[1:gMax, stage + 1], na.rm = TRUE)) { if (is.na(piControlH1)) { pi2H1 <- overallRatesControl[selectedPopulations[1:gMax, stage + 1], stage] } else { pi2H1 <- piControlH1 } if (is.na(piTreatmentH1)) { pi1H1 <- overallRatesTreatment[selectedPopulations[1:gMax, stage + 1], stage] } else { pi1H1 <- piTreatmentH1 } pim <- (allocationRatioPlanned * pi1H1 + pi2H1) / (1 + allocationRatioPlanned) if (conditionalCriticalValue[stage] > 8) { newSubjects <- maxNumberOfSubjectsPerStage[stage + 1] } else { newSubjects <- (1 + 1 / allocationRatioPlanned) * (max(0, conditionalCriticalValue[stage] * sqrt(pim * (1 - pim) * (1 + allocationRatioPlanned)) + .getQNorm(conditionalPower) * sqrt(pi1H1 * (1 - pi1H1) + pi2H1 * (1 - pi2H1) * allocationRatioPlanned), na.rm = TRUE))^2 / (max(1e-7, (2 * directionUpper - 1) * (pi1H1 - pi2H1), na.rm = TRUE))^2 newSubjects <- min( max(minNumberOfSubjectsPerStage[stage + 1], newSubjects), maxNumberOfSubjectsPerStage[stage + 1] ) } } else { newSubjects <- 0 } } else { newSubjects <- plannedSubjects[stage + 1] - plannedSubjects[stage] } return(newSubjects) } .getSimulatedStageRatesEnrichment <- function(..., design, subsets, prevalences, directionUpper, piTreatments, piControls, stratifiedAnalysis, plannedSubjects, typeOfSelection, effectMeasure, adaptations, epsilonValue, rValue, threshold, allocationRatioPlanned, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage, conditionalPower, piTreatmentH1, piControlH1, calcSubjectsFunction, calcSubjectsFunctionIsUserDefined, selectPopulationsFunction) { kMax <- length(plannedSubjects) pMax <- length(piTreatments) gMax <- log(length(piTreatments), 2) + 1 subjectsPerStage <- matrix(NA_real_, nrow = pMax, ncol = kMax) simEventsTreatment <- matrix(NA_real_, nrow = pMax, ncol = kMax) simEventsControl <- matrix(NA_real_, nrow = pMax, ncol = kMax) populationSubjectsPerStage <- matrix(NA_real_, nrow = gMax, ncol = kMax) testStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallTestStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) separatePValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) conditionalCriticalValue <- rep(NA_real_, kMax - 1) conditionalPowerPerStage <- rep(NA_real_, kMax) selectedPopulations <- matrix(FALSE, nrow = gMax, ncol = kMax) selectedSubsets <- matrix(FALSE, nrow = pMax, ncol = kMax) selectedPopulations[, 1] <- TRUE selectedSubsets[, 1] <- TRUE adjustedPValues <- rep(NA_real_, kMax) overallRatesTreatment <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallRatesControl <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallEffectSizes <- matrix(NA_real_, nrow = gMax, ncol = kMax) if (.isTrialDesignFisher(design)) { weights <- .getWeightsFisher(design) } else if (.isTrialDesignInverseNormal(design)) { weights <- .getWeightsInverseNormal(design) } const <- allocationRatioPlanned for (k in 1:kMax) { selectedSubsets[, k] <- .createSelectedSubsets(k, selectedPopulations) if (k == 1) { # subjectsPerStage[, k] <- stats::rmultinom(1, plannedSubjects[k], prevalences) subjectsPerStage[, k] <- plannedSubjects[k] * prevalences } else { prevSelected <- prevalences / sum(prevalences[selectedSubsets[, k]]) prevSelected[!selectedSubsets[, k]] <- 0 if (sum(prevSelected, na.rm = TRUE) > 0) { # subjectsPerStage[, k] <- stats::rmultinom(1, plannedSubjects[k] - plannedSubjects[k - 1], prevSelected) subjectsPerStage[, k] <- (plannedSubjects[k] - plannedSubjects[k - 1]) * prevSelected } else { break } } selsubs <- !is.na(subjectsPerStage[, k]) & subjectsPerStage[, k] > 0 simEventsTreatment[selsubs, k] <- stats::rbinom( rep(1, sum(selsubs)), round(subjectsPerStage[selsubs, k] * const / (1 + const)), piTreatments[selsubs] ) simEventsControl[selsubs, k] <- stats::rbinom( rep(1, sum(selsubs)), round(subjectsPerStage[selsubs, k] / (1 + const)), piControls[selsubs] ) if (gMax == 1) { rm <- (simEventsControl[1, k] + simEventsTreatment[1, k]) / subjectsPerStage[1, k] if (rm <= 0 || rm >= 1) { testStatistics[1, k] <- 0 } else { testStatistics[1, k] <- (2 * directionUpper - 1) * (simEventsTreatment[1, k] * (1 + const) / const - simEventsControl[1, k] * (1 + const)) / subjectsPerStage[1, k] / sqrt(rm * (1 - rm)) * sqrt(subjectsPerStage[1, k] * const / (1 + const)^2) } populationSubjectsPerStage[1, k] <- subjectsPerStage[1, k] overallRatesTreatment[1, k] <- sum(simEventsTreatment[1, 1:k]) * (1 + const) / const / sum(subjectsPerStage[1, 1:k]) overallRatesControl[1, k] <- sum(simEventsControl[1, 1:k]) * (1 + const) / sum(subjectsPerStage[1, 1:k]) overallEffectSizes[1, k] <- (2 * directionUpper - 1) * (overallRatesTreatment[1, k] - overallRatesControl[1, k]) rm <- sum(simEventsControl[1, 1:k] + simEventsTreatment[1, 1:k]) / sum(subjectsPerStage[1, 1:k]) if (rm == 0 || rm == 1) { overallTestStatistics[1, k] <- 0 } else { overallTestStatistics[1, k] <- overallEffectSizes[1, k] / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[1, 1:k]) * const / (1 + const)^2) } } else if (gMax == 2) { # Population S1 rm <- (simEventsControl[1, k] + simEventsTreatment[1, k]) / subjectsPerStage[1, k] if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { testStatistics[1, k] <- 0 } else { testStatistics[1, k] <- (2 * directionUpper - 1) * (simEventsTreatment[1, k] * (1 + const) / const - simEventsControl[1, k] * (1 + const)) / subjectsPerStage[1, k] / sqrt(rm * (1 - rm)) * sqrt(subjectsPerStage[1, k] * const / (1 + const)^2) } } populationSubjectsPerStage[1, k] <- subjectsPerStage[1, k] overallRatesTreatment[1, k] <- sum(simEventsTreatment[1, 1:k]) * (1 + const) / const / sum(subjectsPerStage[1, 1:k]) overallRatesControl[1, k] <- sum(simEventsControl[1, 1:k]) * (1 + const) / sum(subjectsPerStage[1, 1:k]) overallEffectSizes[1, k] <- (2 * directionUpper - 1) * (overallRatesTreatment[1, k] - overallRatesControl[1, k]) rm <- sum(simEventsControl[1, 1:k] + simEventsTreatment[1, 1:k]) / sum(subjectsPerStage[1, 1:k]) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { overallTestStatistics[1, k] <- 0 } else { overallTestStatistics[1, k] <- overallEffectSizes[1, k] / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[1, 1:k]) * const / (1 + const)^2) } } # Full population if (stratifiedAnalysis) { rm <- (simEventsControl[1:2, k] + simEventsTreatment[1:2, k]) / subjectsPerStage[1:2, k] rm[!is.na(rm) & (rm <= 0 | rm >= 1)] <- 0 if (!all(is.na(rm))) { if (all(na.omit(rm) == 0) || all(na.omit(rm) == 1)) { testStatistics[2, k] <- 0 } else { testStatistics[2, k] <- sqrt(const) / (1 + const) * (2 * directionUpper - 1) * sum(subjectsPerStage[1:2, k] * (simEventsTreatment[1:2, k] * (1 + const) / const - simEventsControl[1:2, k] * (1 + const)) / subjectsPerStage[1:2, k], na.rm = TRUE) / sqrt(sum(rm * (1 - rm) * subjectsPerStage[1:2, k], na.rm = TRUE)) } } } else { rm <- sum(simEventsControl[1:2, k] + simEventsTreatment[1:2, k], na.rm = TRUE) / sum(subjectsPerStage[1:2, k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { testStatistics[2, k] <- 0 } else { testStatistics[2, k] <- (2 * directionUpper - 1) * sum(simEventsTreatment[1:2, k] * (1 + const) / const - simEventsControl[1:2, k] * (1 + const), na.rm = TRUE) / sum(subjectsPerStage[1:2, k], na.rm = TRUE) / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[1:2, k], na.rm = TRUE) * const / (1 + const)^2) } } } populationSubjectsPerStage[2, k] <- sum(subjectsPerStage[1:2, k], na.rm = TRUE) overallRatesTreatment[2, k] <- sum(simEventsTreatment[1:2, 1:k], na.rm = TRUE) * (1 + const) / const / sum(subjectsPerStage[1:2, 1:k], na.rm = TRUE) overallRatesControl[2, k] <- sum(simEventsControl[1:2, 1:k], na.rm = TRUE) * (1 + const) / sum(subjectsPerStage[1:2, 1:k], na.rm = TRUE) overallEffectSizes[2, k] <- (2 * directionUpper - 1) * (overallRatesTreatment[2, k] - overallRatesControl[2, k]) rm <- sum(simEventsControl[1:2, 1:k] + simEventsTreatment[1:2, 1:k], na.rm = TRUE) / sum(subjectsPerStage[1:2, 1:k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { overallTestStatistics[2, k] <- 0 } else { overallTestStatistics[2, k] <- overallEffectSizes[2, k] / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[1:2, 1:k], na.rm = TRUE) * const / (1 + const)^2) } } } else if (gMax == 3) { # Population S1 if (stratifiedAnalysis) { rm <- (simEventsControl[c(1, 3), k] + simEventsTreatment[c(1, 3), k]) / subjectsPerStage[c(1, 3), k] rm[!is.na(rm) & (rm <= 0 | rm >= 1)] <- 0 if (!all(is.na(rm))) { if (all(na.omit(rm) == 0) || all(na.omit(rm) == 1)) { testStatistics[1, k] <- 0 } else { testStatistics[1, k] <- sqrt(const) / (1 + const) * (2 * directionUpper - 1) * sum(subjectsPerStage[c(1, 3), k] * (simEventsTreatment[c(1, 3), k] * (1 + const) / const - simEventsControl[c(1, 3), k] * (1 + const)) / subjectsPerStage[c(1, 3), k], na.rm = TRUE) / sqrt(sum(rm * (1 - rm) * subjectsPerStage[c(1, 3), k], na.rm = TRUE)) } } } else { rm <- sum(simEventsControl[c(1, 3), k] + simEventsTreatment[c(1, 3), k], na.rm = TRUE) / sum(subjectsPerStage[c(1, 3), k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { testStatistics[1, k] <- 0 } else { testStatistics[1, k] <- (2 * directionUpper - 1) * sum(simEventsTreatment[c(1, 3), k] * (1 + const) / const - simEventsControl[c(1, 3), k] * (1 + const), na.rm = TRUE) / sum(subjectsPerStage[c(1, 3), k], na.rm = TRUE) / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[c(1, 3), k], na.rm = TRUE) * const / (1 + const)^2) } } } populationSubjectsPerStage[1, k] <- sum(subjectsPerStage[c(1, 3), k], na.rm = TRUE) overallRatesTreatment[1, k] <- sum(simEventsTreatment[c(1, 3), 1:k], na.rm = TRUE) * (1 + const) / const / sum(subjectsPerStage[c(1, 3), 1:k], na.rm = TRUE) overallRatesControl[1, k] <- sum(simEventsControl[c(1, 3), 1:k], na.rm = TRUE) * (1 + const) / sum(subjectsPerStage[c(1, 3), 1:k], na.rm = TRUE) overallEffectSizes[1, k] <- (2 * directionUpper - 1) * (overallRatesTreatment[1, k] - overallRatesControl[1, k]) rm <- sum(simEventsControl[c(1, 3), 1:k] + simEventsTreatment[c(1, 3), 1:k], na.rm = TRUE) / sum(subjectsPerStage[c(1, 3), 1:k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { overallTestStatistics[1, k] <- 0 } else { overallTestStatistics[1, k] <- overallEffectSizes[1, k] / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[c(1, 3), 1:k], na.rm = TRUE) * const / (1 + const)^2) } } # Population S2 if (stratifiedAnalysis) { rm <- (simEventsControl[c(2, 3), k] + simEventsTreatment[c(2, 3), k]) / subjectsPerStage[c(2, 3), k] rm[!is.na(rm) & (rm <= 0 | rm >= 1)] <- 0 if (!all(is.na(rm))) { if (all(na.omit(rm) == 0) || all(na.omit(rm) == 1)) { testStatistics[2, k] <- 0 } else { testStatistics[2, k] <- sqrt(const) / (1 + const) * (2 * directionUpper - 1) * sum(subjectsPerStage[c(2, 3), k] * (simEventsTreatment[c(2, 3), k] * (1 + const) / const - simEventsControl[c(2, 3), k] * (1 + const)) / subjectsPerStage[c(2, 3), k], na.rm = TRUE) / sqrt(sum(rm * (1 - rm) * subjectsPerStage[c(2, 3), k], na.rm = TRUE)) } } } else { rm <- sum(simEventsControl[c(2, 3), k] + simEventsTreatment[c(2, 3), k], na.rm = TRUE) / sum(subjectsPerStage[c(2, 3), k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { testStatistics[2, k] <- 0 } else { testStatistics[2, k] <- (2 * directionUpper - 1) * sum(simEventsTreatment[c(2, 3), k] * (1 + const) / const - simEventsControl[c(2, 3), k] * (1 + const), na.rm = TRUE) / sum(subjectsPerStage[c(2, 3), k], na.rm = TRUE) / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[c(2, 3), k], na.rm = TRUE) * const / (1 + const)^2) } } } populationSubjectsPerStage[2, k] <- sum(subjectsPerStage[c(2, 3), k], na.rm = TRUE) overallRatesTreatment[2, k] <- sum(simEventsTreatment[c(2, 3), 1:k], na.rm = TRUE) * (1 + const) / const / sum(subjectsPerStage[c(2, 3), 1:k], na.rm = TRUE) overallRatesControl[2, k] <- sum(simEventsControl[c(2, 3), 1:k], na.rm = TRUE) * (1 + const) / sum(subjectsPerStage[c(2, 3), 1:k], na.rm = TRUE) overallEffectSizes[2, k] <- (2 * directionUpper - 1) * (overallRatesTreatment[2, k] - overallRatesControl[2, k]) rm <- sum(simEventsControl[c(2, 3), 1:k] + simEventsTreatment[c(2, 3), 1:k], na.rm = TRUE) / sum(subjectsPerStage[c(2, 3), 1:k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { overallTestStatistics[2, k] <- 0 } else { overallTestStatistics[2, k] <- overallEffectSizes[2, k] / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[c(2, 3), 1:k], na.rm = TRUE) * const / (1 + const)^2) } } # Full population if (stratifiedAnalysis) { rm <- (simEventsControl[1:4, k] + simEventsTreatment[1:4, k]) / subjectsPerStage[1:4, k] rm[!is.na(rm) & (rm <= 0 | rm >= 1)] <- 0 if (!all(is.na(rm))) { if (all(na.omit(rm) == 0) || all(na.omit(rm) == 1)) { testStatistics[3, k] <- 0 } else { testStatistics[3, k] <- sqrt(const) / (1 + const) * (2 * directionUpper - 1) * sum(subjectsPerStage[1:4, k] * (simEventsTreatment[1:4, k] * (1 + const) / const - simEventsControl[1:4, k] * (1 + const)) / subjectsPerStage[1:4, k], na.rm = TRUE) / sqrt(sum(rm * (1 - rm) * subjectsPerStage[1:4, k], na.rm = TRUE)) } } } else { rm <- sum(simEventsControl[1:4, k] + simEventsTreatment[1:4, k], na.rm = TRUE) / sum(subjectsPerStage[1:4, k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { testStatistics[3, k] <- 0 } else { testStatistics[3, k] <- (2 * directionUpper - 1) * sum(simEventsTreatment[1:4, k] * (1 + const) / const - simEventsControl[1:4, k] * (1 + const), na.rm = TRUE) / sum(subjectsPerStage[1:4, k], na.rm = TRUE) / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[1:4, k], na.rm = TRUE) * const / (1 + const)^2) } } } populationSubjectsPerStage[3, k] <- sum(subjectsPerStage[1:4, k], na.rm = TRUE) overallRatesTreatment[3, k] <- sum(simEventsTreatment[1:4, 1:k], na.rm = TRUE) * (1 + const) / const / sum(subjectsPerStage[1:4, 1:k], na.rm = TRUE) overallRatesControl[3, k] <- sum(simEventsControl[1:4, 1:k], na.rm = TRUE) * (1 + const) / sum(subjectsPerStage[1:4, 1:k], na.rm = TRUE) overallEffectSizes[3, k] <- (2 * directionUpper - 1) * (overallRatesTreatment[3, k] - overallRatesControl[3, k]) rm <- sum(simEventsControl[1:4, 1:k] + simEventsTreatment[1:4, 1:k], na.rm = TRUE) / sum(subjectsPerStage[1:4, 1:k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { overallTestStatistics[3, k] <- 0 } else { overallTestStatistics[3, k] <- overallEffectSizes[3, k] / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[1:4, 1:k], na.rm = TRUE) * const / (1 + const)^2) } } } else if (gMax == 4) { # Population S1 if (stratifiedAnalysis) { rm <- (simEventsControl[c(1, 4, 5, 7), k] + simEventsTreatment[c(1, 4, 5, 7), k]) / subjectsPerStage[c(1, 4, 5, 7), k] rm[!is.na(rm) & (rm <= 0 | rm >= 1)] <- 0 if (!all(is.na(rm))) { if (all(na.omit(rm) == 0) || all(na.omit(rm) == 1)) { testStatistics[1, k] <- 0 } else { testStatistics[1, k] <- sqrt(const) / (1 + const) * (2 * directionUpper - 1) * sum(subjectsPerStage[c(1, 4, 5, 7), k] * (simEventsTreatment[c(1, 4, 5, 7), k] * (1 + const) / const - simEventsControl[c(1, 4, 5, 7), k] * (1 + const)) / subjectsPerStage[c(1, 4, 5, 7), k], na.rm = TRUE) / sqrt(sum(rm * (1 - rm) * subjectsPerStage[c(1, 4, 5, 7), k], na.rm = TRUE)) } } } else { rm <- sum(simEventsControl[c(1, 4, 5, 7), k] + simEventsTreatment[c(1, 4, 5, 7), k], na.rm = TRUE) / sum(subjectsPerStage[c(1, 4, 5, 7), k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { testStatistics[1, k] <- 0 } else { testStatistics[1, k] <- (2 * directionUpper - 1) * sum(simEventsTreatment[c(1, 4, 5, 7), k] * (1 + const) / const - simEventsControl[c(1, 4, 5, 7), k] * (1 + const), na.rm = TRUE) / sum(subjectsPerStage[c(1, 4, 5, 7), k], na.rm = TRUE) / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[c(1, 4, 5, 7), k], na.rm = TRUE) * const / (1 + const)^2) } } } populationSubjectsPerStage[1, k] <- sum(subjectsPerStage[c(1, 4, 5, 7), k], na.rm = TRUE) overallRatesTreatment[1, k] <- sum(simEventsTreatment[c(1, 4, 5, 7), 1:k], na.rm = TRUE) * (1 + const) / const / sum(subjectsPerStage[c(1, 4, 5, 7), 1:k], na.rm = TRUE) overallRatesControl[1, k] <- sum(simEventsControl[c(1, 4, 5, 7), 1:k], na.rm = TRUE) * (1 + const) / sum(subjectsPerStage[c(1, 4, 5, 7), 1:k], na.rm = TRUE) overallEffectSizes[1, k] <- (2 * directionUpper - 1) * (overallRatesTreatment[1, k] - overallRatesControl[1, k]) rm <- sum(simEventsControl[c(1, 4, 5, 7), 1:k] + simEventsTreatment[c(1, 4, 5, 7), 1:k], na.rm = TRUE) / sum(subjectsPerStage[c(1, 4, 5, 7), 1:k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { overallTestStatistics[1, k] <- 0 } else { overallTestStatistics[1, k] <- overallEffectSizes[1, k] / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[c(1, 4, 5, 7), 1:k], na.rm = TRUE) * const / (1 + const)^2) } } # Population S2 if (stratifiedAnalysis) { rm <- (simEventsControl[c(2, 4, 6, 7), k] + simEventsTreatment[c(2, 4, 6, 7), k]) / subjectsPerStage[c(2, 4, 6, 7), k] rm[!is.na(rm) & (rm <= 0 | rm >= 1)] <- 0 if (!all(is.na(rm))) { if (all(na.omit(rm) == 0) || all(na.omit(rm) == 1)) { testStatistics[2, k] <- 0 } else { testStatistics[2, k] <- sqrt(const) / (1 + const) * (2 * directionUpper - 1) * sum(subjectsPerStage[c(2, 4, 6, 7), k] * (simEventsTreatment[c(2, 4, 6, 7), k] * (1 + const) / const - simEventsControl[c(2, 4, 6, 7), k] * (1 + const)) / subjectsPerStage[c(2, 4, 6, 7), k], na.rm = TRUE) / sqrt(sum(rm * (1 - rm) * subjectsPerStage[c(2, 4, 6, 7), k], na.rm = TRUE)) } } } else { rm <- sum(simEventsControl[c(2, 4, 6, 7), k] + simEventsTreatment[c(2, 4, 6, 7), k], na.rm = TRUE) / sum(subjectsPerStage[c(2, 4, 6, 7), k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { testStatistics[2, k] <- 0 } else { testStatistics[2, k] <- (2 * directionUpper - 1) * sum(simEventsTreatment[c(2, 4, 6, 7), k] * (1 + const) / const - simEventsControl[c(2, 4, 6, 7), k] * (1 + const), na.rm = TRUE) / sum(subjectsPerStage[c(2, 4, 6, 7), k], na.rm = TRUE) / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[c(2, 4, 6, 7), k], na.rm = TRUE) * const / (1 + const)^2) } } } populationSubjectsPerStage[2, k] <- sum(subjectsPerStage[c(2, 4, 6, 7), k], na.rm = TRUE) overallRatesTreatment[2, k] <- sum(simEventsTreatment[c(2, 4, 6, 7), 1:k], na.rm = TRUE) * (1 + const) / const / sum(subjectsPerStage[c(2, 4, 6, 7), 1:k], na.rm = TRUE) overallRatesControl[2, k] <- sum(simEventsControl[c(2, 4, 6, 7), 1:k], na.rm = TRUE) * (1 + const) / sum(subjectsPerStage[c(2, 4, 6, 7), 1:k], na.rm = TRUE) overallEffectSizes[2, k] <- (2 * directionUpper - 1) * (overallRatesTreatment[2, k] - overallRatesControl[2, k]) rm <- sum(simEventsControl[c(2, 4, 6, 7), 1:k] + simEventsTreatment[c(2, 4, 6, 7), 1:k], na.rm = TRUE) / sum(subjectsPerStage[c(2, 4, 6, 7), 1:k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { overallTestStatistics[2, k] <- 0 } else { overallTestStatistics[2, k] <- overallEffectSizes[2, k] / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[c(2, 4, 6, 7), 1:k], na.rm = TRUE) * const / (1 + const)^2) } } # Population S3 if (stratifiedAnalysis) { rm <- (simEventsControl[c(3, 5, 6, 7), k] + simEventsTreatment[c(3, 5, 6, 7), k]) / subjectsPerStage[c(3, 5, 6, 7), k] rm[!is.na(rm) & (rm <= 0 | rm >= 1)] <- 0 if (!all(is.na(rm))) { if (all(na.omit(rm) == 0) || all(na.omit(rm) == 1)) { testStatistics[3, k] <- 0 } else { testStatistics[3, k] <- sqrt(const) / (1 + const) * (2 * directionUpper - 1) * sum(subjectsPerStage[c(3, 5, 6, 7), k] * (simEventsTreatment[c(3, 5, 6, 7), k] * (1 + const) / const - simEventsControl[c(3, 5, 6, 7), k] * (1 + const)) / subjectsPerStage[c(3, 5, 6, 7), k], na.rm = TRUE) / sqrt(sum(rm * (1 - rm) * subjectsPerStage[c(3, 5, 6, 7), k], na.rm = TRUE)) } } } else { rm <- sum(simEventsControl[c(3, 5, 6, 7), k] + simEventsTreatment[c(3, 5, 6, 7), k], na.rm = TRUE) / sum(subjectsPerStage[c(3, 5, 6, 7), k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { testStatistics[3, k] <- 0 } else { testStatistics[3, k] <- (2 * directionUpper - 1) * sum(simEventsTreatment[c(3, 5, 6, 7), k] * (1 + const) / const - simEventsControl[c(3, 5, 6, 7), k] * (1 + const), na.rm = TRUE) / sum(subjectsPerStage[c(3, 5, 6, 7), k], na.rm = TRUE) / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[c(3, 5, 6, 7), k], na.rm = TRUE) * const / (1 + const)^2) } } } populationSubjectsPerStage[3, k] <- sum(subjectsPerStage[c(3, 5, 6, 7), k], na.rm = TRUE) overallRatesTreatment[3, k] <- sum(simEventsTreatment[c(3, 5, 6, 7), 1:k], na.rm = TRUE) * (1 + const) / const / sum(subjectsPerStage[c(3, 5, 6, 7), 1:k], na.rm = TRUE) overallRatesControl[3, k] <- sum(simEventsControl[c(3, 5, 6, 7), 1:k], na.rm = TRUE) * (1 + const) / sum(subjectsPerStage[c(3, 5, 6, 7), 1:k], na.rm = TRUE) overallEffectSizes[3, k] <- (2 * directionUpper - 1) * (overallRatesTreatment[3, k] - overallRatesControl[3, k]) rm <- sum(simEventsControl[c(3, 5, 6, 7), 1:k] + simEventsTreatment[c(3, 5, 6, 7), 1:k], na.rm = TRUE) / sum(subjectsPerStage[c(3, 5, 6, 7), 1:k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { overallTestStatistics[3, k] <- 0 } else { overallTestStatistics[3, k] <- overallEffectSizes[3, k] / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[c(3, 5, 6, 7), 1:k], na.rm = TRUE) * const / (1 + const)^2) } } # Full population if (stratifiedAnalysis) { rm <- (simEventsControl[1:8, k] + simEventsTreatment[1:8, k]) / subjectsPerStage[1:8, k] rm[!is.na(rm) & (rm <= 0 | rm >= 1)] <- 0 if (!all(is.na(rm))) { if (all(na.omit(rm) == 0) || all(na.omit(rm) == 1)) { testStatistics[4, k] <- 0 } else { testStatistics[4, k] <- sqrt(const) / (1 + const) * (2 * directionUpper - 1) * sum(subjectsPerStage[1:8, k] * (simEventsTreatment[1:8, k] * (1 + const) / const - simEventsControl[1:8, k] * (1 + const)) / subjectsPerStage[1:8, k], na.rm = TRUE) / sqrt(sum(rm * (1 - rm) * subjectsPerStage[1:8, k], na.rm = TRUE)) } } } else { rm <- sum(simEventsControl[1:8, k] + simEventsTreatment[1:8, k], na.rm = TRUE) / sum(subjectsPerStage[1:8, k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { testStatistics[4, k] <- 0 } else { testStatistics[4, k] <- (2 * directionUpper - 1) * sum(simEventsTreatment[1:8, k] * (1 + const) / const - simEventsControl[1:8, k] * (1 + const), na.rm = TRUE) / sum(subjectsPerStage[1:8, k], na.rm = TRUE) / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[1:8, k], na.rm = TRUE) * const / (1 + const)^2) } } } populationSubjectsPerStage[4, k] <- sum(subjectsPerStage[1:8, k], na.rm = TRUE) overallRatesTreatment[4, k] <- sum(simEventsTreatment[1:8, 1:k], na.rm = TRUE) * (1 + const) / const / sum(subjectsPerStage[1:8, 1:k], na.rm = TRUE) overallRatesControl[4, k] <- sum(simEventsControl[1:8, 1:k], na.rm = TRUE) * (1 + const) / sum(subjectsPerStage[1:8, 1:k], na.rm = TRUE) overallEffectSizes[4, k] <- (2 * directionUpper - 1) * (overallRatesTreatment[4, k] - overallRatesControl[4, k]) rm <- sum(simEventsControl[1:8, 1:k] + simEventsTreatment[1:8, 1:k], na.rm = TRUE) / sum(subjectsPerStage[1:8, 1:k], na.rm = TRUE) if (!is.na(rm)) { if (rm <= 0 || rm >= 1) { overallTestStatistics[4, k] <- 0 } else { overallTestStatistics[4, k] <- overallEffectSizes[4, k] / sqrt(rm * (1 - rm)) * sqrt(sum(subjectsPerStage[1:8, 1:k], na.rm = TRUE) * const / (1 + const)^2) } } } testStatistics[!selectedPopulations[, k], k] <- NA_real_ overallEffectSizes[!selectedPopulations[, k], k] <- NA_real_ overallTestStatistics[!selectedPopulations[, k], k] <- NA_real_ separatePValues[, k] <- 1 - stats::pnorm(testStatistics[, k]) if (k < kMax) { if (colSums(selectedPopulations)[k] == 0) { break } # Bonferroni adjustment adjustedPValues[k] <- min(min(separatePValues[, k], na.rm = TRUE) * colSums(selectedPopulations)[k], 1 - 1e-12) # conditional critical value to reject the null hypotheses at the next stage of the trial if (.isTrialDesignFisher(design)) { conditionalCriticalValue[k] <- .getOneMinusQNorm(min((design$criticalValues[k + 1] / prod(adjustedPValues[1:k]^weights[1:k]))^(1 / weights[k + 1]), 1 - 1e-7)) } else { if (design$criticalValues[k + 1] >= 6) { conditionalCriticalValue[k] <- Inf } else { conditionalCriticalValue[k] <- (design$criticalValues[k + 1] * sqrt(design$informationRates[k + 1]) - .getOneMinusQNorm(adjustedPValues[1:k]) %*% weights[1:k]) / sqrt(design$informationRates[k + 1] - design$informationRates[k]) } } if (adaptations[k]) { if (effectMeasure == "testStatistic") { selectedPopulations[, k + 1] <- (selectedPopulations[, k] & .selectPopulations( k, overallTestStatistics[, k] + runif(gMax, -1e-05, 1e-05), typeOfSelection, epsilonValue, rValue, threshold, selectPopulationsFunction )) } else if (effectMeasure == "effectEstimate") { selectedPopulations[, k + 1] <- (selectedPopulations[, k] & .selectPopulations( k, overallEffectSizes[, k] + runif(gMax, -1e-05, 1e-05), typeOfSelection, epsilonValue, rValue, threshold, selectPopulationsFunction )) } newSubjects <- calcSubjectsFunction( stage = k + 1, # to be consistent with non-enrichment situation, cf. line 40 directionUpper = directionUpper, conditionalPower = conditionalPower, conditionalCriticalValue = conditionalCriticalValue, plannedSubjects = plannedSubjects, allocationRatioPlanned = allocationRatioPlanned, selectedPopulations = selectedPopulations, piTreatmentH1 = piTreatmentH1, piControlH1 = piControlH1, overallRatesTreatment = overallRatesTreatment, overallRatesControl = overallRatesControl, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage ) if (is.null(newSubjects) || length(newSubjects) != 1 || !is.numeric(newSubjects) || is.na(newSubjects)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'calcSubjectsFunction' returned an illegal or undefined result (", newSubjects, "); ", "the output must be a single numeric value" ) } if (!is.na(conditionalPower) || calcSubjectsFunctionIsUserDefined) { plannedSubjects[(k + 1):kMax] <- plannedSubjects[k] + cumsum(rep(newSubjects, kMax - k)) } } else { selectedPopulations[, k + 1] <- selectedPopulations[, k] } if (is.na(piControlH1)) { pi2H1 <- overallRatesControl[, k] } else { pi2H1 <- piControlH1 } if (is.na(piTreatmentH1)) { pi1H1 <- overallRatesTreatment[, k] } else { pi1H1 <- piTreatmentH1 } pim <- (allocationRatioPlanned * pi1H1 + pi2H1) / (1 + allocationRatioPlanned) if (any(pi1H1 * (1 - pi1H1) + pi2H1 * (1 - pi2H1) == 0)) { thetaStandardized <- 0 } else { thetaStandardized <- sqrt(allocationRatioPlanned) / (1 + allocationRatioPlanned) * ( (pi1H1 - pi2H1) * sqrt(1 + allocationRatioPlanned) / sqrt(pi1H1 * (1 - pi1H1) + allocationRatioPlanned * pi2H1 * (1 - pi2H1)) + sign(pi1H1 - pi2H1) * conditionalCriticalValue[k] * (1 - sqrt(pim * (1 - pim) + allocationRatioPlanned * pim * (1 - pim)) / sqrt(pi1H1 * (1 - pi1H1) + allocationRatioPlanned * pi2H1 * (1 - pi2H1))) * (1 + allocationRatioPlanned) / sqrt(allocationRatioPlanned * (plannedSubjects[k + 1] - plannedSubjects[k])) ) } thetaStandardized <- (2 * directionUpper - 1) * thetaStandardized thetaStandardized <- min(thetaStandardized, na.rm = TRUE) conditionalPowerPerStage[k] <- 1 - stats::pnorm(conditionalCriticalValue[k] - thetaStandardized * sqrt(plannedSubjects[k + 1] - plannedSubjects[k])) } } return(list( subjectsPerStage = subjectsPerStage, populationSubjectsPerStage = populationSubjectsPerStage, allocationRatioPlanned = allocationRatioPlanned, overallEffectSizes = overallEffectSizes, testStatistics = testStatistics, directionUpper = directionUpper, overallTestStatistics = overallTestStatistics, overallRatesControl = overallRatesControl, overallRatesTreatment = overallRatesTreatment, separatePValues = separatePValues, conditionalCriticalValue = conditionalCriticalValue, conditionalPowerPerStage = conditionalPowerPerStage, selectedPopulations = selectedPopulations )) } #' #' @title #' Get Simulation Enrichment Rates #' #' @description #' Returns the simulated power, stopping and selection probabilities, conditional power, #' and expected sample size for testing rates in an enrichment design testing situation. #' #' @param piControlH1 If specified, the assumed probabilities in the control arm #' under which the sample size recalculation was performed #' and the conditional power was calculated. #' @param piTreatmentH1 If specified, the assumed probabilities in the active arm #' under which the sample size recalculation was performed #' and the conditional power was calculated. #' @inheritParams param_intersectionTest_Enrichment #' @inheritParams param_typeOfSelection #' @inheritParams param_effectMeasure #' @inheritParams param_adaptations #' @inheritParams param_threshold #' @inheritParams param_effectList #' @inheritParams param_populations #' @inheritParams param_successCriterion #' @inheritParams param_typeOfSelection #' @inheritParams param_design_with_default #' @inheritParams param_directionUpper #' @inheritParams param_allocationRatioPlanned #' @inheritParams param_plannedSubjects #' @inheritParams param_minNumberOfSubjectsPerStage #' @inheritParams param_maxNumberOfSubjectsPerStage #' @inheritParams param_conditionalPowerSimulation #' @inheritParams param_maxNumberOfIterations #' @inheritParams param_calcSubjectsFunction #' @inheritParams param_selectPopulationsFunction #' @inheritParams param_rValue #' @inheritParams param_epsilonValue #' @inheritParams param_seed #' @inheritParams param_three_dots #' @inheritParams param_showStatistics #' @inheritParams param_stratifiedAnalysis #' #' @details #' At given design the function simulates the power, stopping probabilities, #' selection probabilities, and expected sample size at given number of subjects, #' parameter configuration, and treatment arm selection rule in the enrichment situation. #' An allocation ratio can be specified referring to the ratio of number of #' subjects in the active treatment groups as compared to the control group. #' #' The definition of \code{piTreatmentH1} and/or \code{piControlH1} makes only sense if \code{kMax} > 1 #' and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and #' \code{maxNumberOfSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. #' #' \code{calcSubjectsFunction}\cr #' This function returns the number of subjects at given conditional power and #' conditional critical value for specified testing situation. #' The function might depend on the variables #' \code{stage}, #' \code{selectedPopulations}, #' \code{directionUpper}, #' \code{plannedSubjects}, #' \code{allocationRatioPlanned}, #' \code{minNumberOfSubjectsPerStage}, #' \code{maxNumberOfSubjectsPerStage}, #' \code{conditionalPower}, #' \code{conditionalCriticalValue}, #' \code{overallRatesTreatment}, #' \code{overallRatesControl}, #' \code{piTreatmentH1}, and #' \code{piControlH1}. #' The function has to contain the three-dots argument '...' (see examples). #' #' @template return_object_simulation_results #' @template how_to_get_help_for_generics #' #' @template examples_get_simulation_enrichment_rates #' #' @export #' getSimulationEnrichmentRates <- function(design = NULL, ..., populations = NA_integer_, # C_POPULATIONS_DEFAULT effectList = NULL, intersectionTest = c("Simes", "SpiessensDebois", "Bonferroni", "Sidak"), # C_INTERSECTION_TEST_ENRICHMENT_DEFAULT stratifiedAnalysis = TRUE, # C_STRATIFIED_ANALYSIS_DEFAULT, directionUpper = TRUE, # C_DIRECTION_UPPER_DEFAULT adaptations = NA, typeOfSelection = c("best", "rBest", "epsilon", "all", "userDefined"), # C_TYPE_OF_SELECTION_DEFAULT effectMeasure = c("effectEstimate", "testStatistic"), # C_EFFECT_MEASURE_DEFAULT successCriterion = c("all", "atLeastOne"), # C_SUCCESS_CRITERION_DEFAULT epsilonValue = NA_real_, rValue = NA_real_, threshold = -Inf, plannedSubjects = NA_real_, allocationRatioPlanned = NA_real_, minNumberOfSubjectsPerStage = NA_real_, maxNumberOfSubjectsPerStage = NA_real_, conditionalPower = NA_real_, piTreatmentH1 = NA_real_, piControlH1 = NA_real_, maxNumberOfIterations = 1000L, # C_MAX_SIMULATION_ITERATIONS_DEFAULT seed = NA_real_, calcSubjectsFunction = NULL, selectPopulationsFunction = NULL, showStatistics = FALSE) { if (is.null(design)) { design <- .getDefaultDesign(..., type = "simulation") .warnInCaseOfUnknownArguments( functionName = "getSimulationEnrichmentRates", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "showStatistics"), ... ) } else { .assertIsTrialDesignInverseNormalOrFisher(design) .warnInCaseOfUnknownArguments(functionName = "getSimulationEnrichmentRates", ignore = "showStatistics", ...) .warnInCaseOfTwoSidedPowerArgument(...) } .assertIsOneSidedDesign(design, designType = "enrichment", engineType = "simulation") calcSubjectsFunctionIsUserDefined <- !is.null(calcSubjectsFunction) simulationResults <- .createSimulationResultsEnrichmentObject( design = design, populations = populations, effectList = effectList, intersectionTest = intersectionTest, stratifiedAnalysis = stratifiedAnalysis, directionUpper = directionUpper, # rates + survival only adaptations = adaptations, typeOfSelection = typeOfSelection, effectMeasure = effectMeasure, successCriterion = successCriterion, epsilonValue = epsilonValue, rValue = rValue, threshold = threshold, plannedSubjects = plannedSubjects, # means + rates only allocationRatioPlanned = allocationRatioPlanned, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, # means + rates only maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage, # means + rates only conditionalPower = conditionalPower, piTreatmentH1 = piTreatmentH1, # rates only piControlH1 = piControlH1, # rates only maxNumberOfIterations = maxNumberOfIterations, seed = seed, calcSubjectsFunction = calcSubjectsFunction, # means + rates only selectPopulationsFunction = selectPopulationsFunction, showStatistics = showStatistics, endpoint = "rates" ) design <- simulationResults$.design successCriterion <- simulationResults$successCriterion effectMeasure <- simulationResults$effectMeasure adaptations <- simulationResults$adaptations gMax <- simulationResults$populations kMax <- simulationResults$.design$kMax intersectionTest <- simulationResults$intersectionTest typeOfSelection <- simulationResults$typeOfSelection effectList <- simulationResults$effectList piTreatmentH1 <- simulationResults$piTreatmentH1 # rates only piControlH1 <- simulationResults$piControlH1 # rates only conditionalPower <- simulationResults$conditionalPower minNumberOfSubjectsPerStage <- simulationResults$minNumberOfSubjectsPerStage maxNumberOfSubjectsPerStage <- simulationResults$maxNumberOfSubjectsPerStage allocationRatioPlanned <- simulationResults$allocationRatioPlanned calcSubjectsFunction <- simulationResults$calcSubjectsFunction indices <- .getIndicesOfClosedHypothesesSystemForSimulation(gMax = gMax) cols <- nrow(effectList$piTreatments) simulatedSelections <- array(0, dim = c(kMax, cols, gMax)) simulatedRejections <- array(0, dim = c(kMax, cols, gMax)) simulatedNumberOfPopulations <- matrix(0, nrow = kMax, ncol = cols) simulatedSubjectsPerStage <- array(0, dim = c(kMax, cols, 2^(gMax - 1))) simulatedSuccessStopping <- matrix(0, nrow = kMax, ncol = cols) simulatedFutilityStopping <- matrix(0, nrow = kMax - 1, ncol = cols) simulatedConditionalPower <- matrix(0, nrow = kMax, ncol = cols) simulatedRejectAtLeastOne <- rep(0, cols) expectedNumberOfSubjects <- rep(0, cols) iterations <- matrix(0, nrow = kMax, ncol = cols) len <- maxNumberOfIterations * kMax * gMax * cols dataIterationNumber <- rep(NA_real_, len) dataStageNumber <- rep(NA_real_, len) dataPopulationNumber <- rep(NA_real_, len) dataEffect <- rep(NA_real_, len) dataSubjectsPopulation <- rep(NA_real_, len) dataSubjectsActivePopulation <- rep(NA_real_, len) dataNumberOfSubjects <- rep(NA_real_, len) dataNumberOfCumulatedSubjects <- rep(NA_real_, len) dataRejectPerStage <- rep(NA, len) dataFutilityStop <- rep(NA_real_, len) dataSuccessStop <- rep(NA, len) dataFutilityStop <- rep(NA, len) dataTestStatistics <- rep(NA_real_, len) dataConditionalCriticalValue <- rep(NA_real_, len) dataConditionalPowerAchieved <- rep(NA_real_, len) dataEffectEstimate <- rep(NA_real_, len) dataPValuesSeparate <- rep(NA_real_, len) piControls <- effectList$piControls if (length(piControls) == 1) { piControls <- rep(piControls, ncol(effectList$piTreatments)) } index <- 1 for (i in 1:cols) { for (j in 1:maxNumberOfIterations) { stageResults <- .getSimulatedStageRatesEnrichment( design = design, subsets = effectList$subsets, prevalences = effectList$prevalences, piTreatments = effectList$piTreatments[i, ], piControls = piControls, directionUpper = directionUpper, stratifiedAnalysis = stratifiedAnalysis, plannedSubjects = plannedSubjects, typeOfSelection = typeOfSelection, effectMeasure = effectMeasure, adaptations = adaptations, epsilonValue = epsilonValue, rValue = rValue, threshold = threshold, allocationRatioPlanned = allocationRatioPlanned, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage, conditionalPower = conditionalPower, piTreatmentH1 = piTreatmentH1, piControlH1 = piControlH1, calcSubjectsFunction = calcSubjectsFunction, calcSubjectsFunctionIsUserDefined = calcSubjectsFunctionIsUserDefined, selectPopulationsFunction = selectPopulationsFunction ) closedTest <- .performClosedCombinationTestForSimulationEnrichment( stageResults = stageResults, design = design, indices = indices, intersectionTest = intersectionTest, successCriterion = successCriterion ) rejectAtSomeStage <- FALSE rejectedPopulationsBefore <- rep(FALSE, gMax) for (k in 1:kMax) { simulatedRejections[k, i, ] <- simulatedRejections[k, i, ] + (closedTest$rejected[, k] & closedTest$selectedPopulations[1:gMax, k] | rejectedPopulationsBefore) simulatedSelections[k, i, ] <- simulatedSelections[k, i, ] + closedTest$selectedPopulations[, k] simulatedNumberOfPopulations[k, i] <- simulatedNumberOfPopulations[k, i] + sum(closedTest$selectedPopulations[, k]) if (!any(is.na(closedTest$successStop))) { simulatedSuccessStopping[k, i] <- simulatedSuccessStopping[k, i] + closedTest$successStop[k] } if ((kMax > 1) && (k < kMax)) { if (!any(is.na(closedTest$futilityStop))) { simulatedFutilityStopping[k, i] <- simulatedFutilityStopping[k, i] + (closedTest$futilityStop[k] && !closedTest$successStop[k]) } if (!closedTest$successStop[k] && !closedTest$futilityStop[k]) { simulatedConditionalPower[k + 1, i] <- simulatedConditionalPower[k + 1, i] + stageResults$conditionalPowerPerStage[k] } } iterations[k, i] <- iterations[k, i] + 1 for (p in 1:2^(gMax - 1)) { if (!is.na(stageResults$subjectsPerStage[p, k])) { simulatedSubjectsPerStage[k, i, p] <- simulatedSubjectsPerStage[k, i, p] + stageResults$subjectsPerStage[p, k] } } for (g in 1:gMax) { dataIterationNumber[index] <- j dataStageNumber[index] <- k dataPopulationNumber[index] <- g dataEffect[index] <- i dataSubjectsPopulation[index] <- stageResults$populationSubjectsPerStage[g, k] dataNumberOfSubjects[index] <- round(sum(stageResults$subjectsPerStage[, k], na.rm = TRUE), 1) dataNumberOfCumulatedSubjects[index] <- sum(stageResults$subjectsPerStage[, 1:k], na.rm = TRUE) dataRejectPerStage[index] <- closedTest$rejected[g, k] dataTestStatistics[index] <- stageResults$testStatistics[g, k] dataSuccessStop[index] <- closedTest$successStop[k] if (k < kMax) { dataFutilityStop[index] <- closedTest$futilityStop[k] dataConditionalCriticalValue[index] <- stageResults$conditionalCriticalValue[k] dataConditionalPowerAchieved[index + 1] <- stageResults$conditionalPowerPerStage[k] } dataEffectEstimate[index] <- stageResults$overallEffectSizes[g, k] dataPValuesSeparate[index] <- closedTest$separatePValues[g, k] index <- index + 1 } if (!rejectAtSomeStage && any(closedTest$rejected[, k] & closedTest$selectedPopulations[1:gMax, k] | rejectedPopulationsBefore)) { simulatedRejectAtLeastOne[i] <- simulatedRejectAtLeastOne[i] + 1 rejectAtSomeStage <- TRUE } if ((k < kMax) && (closedTest$successStop[k] || closedTest$futilityStop[k])) { # rejected hypotheses remain rejected also in case of early stopping simulatedRejections[(k + 1):kMax, i, ] <- simulatedRejections[(k + 1):kMax, i, ] + matrix((closedTest$rejected[, k] & closedTest$selectedPopulations[1:gMax, k] | rejectedPopulationsBefore), kMax - k, gMax, byrow = TRUE ) break } rejectedPopulationsBefore <- closedTest$rejected[, k] & closedTest$selectedPopulations[1:gMax, k] | rejectedPopulationsBefore } } simulatedSubjectsPerStage[is.na(simulatedSubjectsPerStage)] <- 0 simulatedSubjectsPerStage[, i, ] <- simulatedSubjectsPerStage[, i, ] / iterations[, i] if (kMax > 1) { simulatedRejections[2:kMax, i, ] <- simulatedRejections[2:kMax, i, ] - simulatedRejections[1:(kMax - 1), i, ] stopping <- cumsum(simulatedSuccessStopping[1:(kMax - 1), i] + simulatedFutilityStopping[, i]) / maxNumberOfIterations expectedNumberOfSubjects[i] <- sum(simulatedSubjectsPerStage[1, i, ] + t(1 - stopping) %*% simulatedSubjectsPerStage[2:kMax, i, ]) } else { expectedNumberOfSubjects[i] <- sum(simulatedSubjectsPerStage[1, i, ]) } } simulatedConditionalPower[1, ] <- NA_real_ if (kMax > 1) { simulatedConditionalPower[2:kMax, ] <- as.matrix(simulatedConditionalPower[2:kMax, ] / iterations[2:kMax, ]) } simulationResults$rejectAtLeastOne <- simulatedRejectAtLeastOne / maxNumberOfIterations simulationResults$numberOfPopulations <- simulatedNumberOfPopulations / iterations simulationResults$selectedPopulations <- simulatedSelections / maxNumberOfIterations simulationResults$rejectedPopulationsPerStage <- simulatedRejections / maxNumberOfIterations simulationResults$successPerStage <- simulatedSuccessStopping / maxNumberOfIterations simulationResults$futilityPerStage <- simulatedFutilityStopping / maxNumberOfIterations simulationResults$futilityStop <- base::colSums(simulatedFutilityStopping / maxNumberOfIterations) if (kMax > 1) { simulationResults$earlyStop <- simulationResults$futilityPerStage + simulationResults$successPerStage[1:(kMax - 1), ] simulationResults$conditionalPowerAchieved <- simulatedConditionalPower } simulationResults$sampleSizes <- simulatedSubjectsPerStage simulationResults$expectedNumberOfSubjects <- expectedNumberOfSubjects simulationResults$iterations <- iterations if (!all(is.na(simulationResults$conditionalPowerAchieved))) { simulationResults$.setParameterType("conditionalPowerAchieved", C_PARAM_GENERATED) } if (any(simulationResults$rejectedPopulationsPerStage < 0)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "internal error, simulation not possible due to numerical overflow") } data <- data.frame( iterationNumber = dataIterationNumber, stageNumber = dataStageNumber, armNumber = dataPopulationNumber, effect = dataEffect, numberOfSubjects = dataNumberOfSubjects, numberOfCumulatedSubjects = dataNumberOfCumulatedSubjects, subjectsPopulation = dataSubjectsPopulation, effectEstimate = dataEffectEstimate, testStatistics = dataTestStatistics, pValue = dataPValuesSeparate, conditionalCriticalValue = round(dataConditionalCriticalValue, 6), conditionalPowerAchieved = round(dataConditionalPowerAchieved, 6), rejectPerStage = dataRejectPerStage, successStop = dataSuccessStop, futilityPerStage = dataFutilityStop ) data <- data[!is.na(data$effectEstimate), ] simulationResults$.data <- data return(simulationResults) } rpact/R/f_simulation_enrichment_means.R0000644000175000017500000010760714150167045020147 0ustar nileshnilesh## | ## | *Simulation of enrichment design with continuous data* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5594 $ ## | Last changed: $Date: 2021-11-26 15:24:35 +0100 (Fr, 26 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include f_simulation_enrichment.R NULL .getSimulationMeansEnrichmentStageSubjects <- function(..., stage, conditionalPower, conditionalCriticalValue, plannedSubjects, allocationRatioPlanned, selectedPopulations, thetaH1, overallEffects, stDevH1, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage) { stage <- stage - 1 # to be consistent with non-enrichment situation gMax <- nrow(overallEffects) if (!is.na(conditionalPower)) { if (any(selectedPopulations[1:gMax, stage + 1], na.rm = TRUE)) { if (is.na(thetaH1)) { thetaStandardized <- max(min(overallEffects[ selectedPopulations[1:gMax, stage + 1], stage ] / stDevH1, na.rm = TRUE), 1e-07) } else { max(thetaStandardized <- thetaH1 / stDevH1, 1e-07) } if (conditionalCriticalValue[stage] > 8) { newSubjects <- maxNumberOfSubjectsPerStage[stage + 1] } else { newSubjects <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * (max(0, conditionalCriticalValue[stage] + .getQNorm(conditionalPower)))^2 / thetaStandardized^2 newSubjects <- min( max(minNumberOfSubjectsPerStage[stage + 1], newSubjects), maxNumberOfSubjectsPerStage[stage + 1] ) } } else { newSubjects <- 0 } } else { newSubjects <- plannedSubjects[stage + 1] - plannedSubjects[stage] } return(newSubjects) } .getSimulatedStageMeansEnrichment <- function(..., design, subsets, prevalences, effects, stDevs, stratifiedAnalysis, plannedSubjects, typeOfSelection, effectMeasure, adaptations, epsilonValue, rValue, threshold, allocationRatioPlanned, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage, conditionalPower, thetaH1, stDevH1, calcSubjectsFunction, calcSubjectsFunctionIsUserDefined, selectPopulationsFunction) { kMax <- length(plannedSubjects) pMax <- length(effects) gMax <- log(length(effects), 2) + 1 subjectsPerStage <- matrix(NA_real_, nrow = pMax, ncol = kMax) simEffects <- matrix(NA_real_, nrow = pMax, ncol = kMax) populationSubjectsPerStage <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallEffects <- matrix(NA_real_, nrow = gMax, ncol = kMax) testStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallTestStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) separatePValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) conditionalCriticalValue <- rep(NA_real_, kMax - 1) conditionalPowerPerStage <- rep(NA_real_, kMax) selectedPopulations <- matrix(FALSE, nrow = gMax, ncol = kMax) selectedSubsets <- matrix(FALSE, nrow = pMax, ncol = kMax) selectedPopulations[, 1] <- TRUE selectedSubsets[, 1] <- TRUE adjustedPValues <- rep(NA_real_, kMax) if (.isTrialDesignFisher(design)) { weights <- .getWeightsFisher(design) } else if (.isTrialDesignInverseNormal(design)) { weights <- .getWeightsInverseNormal(design) } const <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 for (k in 1:kMax) { selectedSubsets[, k] <- .createSelectedSubsets(k, selectedPopulations) if (k == 1) { # subjectsPerStage[, k] <- stats::rmultinom(1, plannedSubjects[k], prevalences) subjectsPerStage[, k] <- plannedSubjects[k] * prevalences } else { prevSelected <- prevalences / sum(prevalences[selectedSubsets[, k]]) prevSelected[!selectedSubsets[, k]] <- 0 if (sum(prevSelected, na.rm = TRUE) > 0) { # subjectsPerStage[, k] <- stats::rmultinom(1, plannedSubjects[k] - plannedSubjects[k - 1], prevSelected) subjectsPerStage[, k] <- (plannedSubjects[k] - plannedSubjects[k - 1]) * prevSelected } else { break } } selsubs <- !is.na(subjectsPerStage[, k]) & subjectsPerStage[, k] > 0 simEffects[selsubs, k] <- stats::rnorm(rep(1, sum(selsubs)), effects[selsubs], stDevs[selsubs] / sqrt(subjectsPerStage[selsubs, k] * const)) if (gMax == 1) { testStatistics[1, k] <- simEffects[1, k] / stDevs[1] * sqrt(subjectsPerStage[1, k] * const) populationSubjectsPerStage[1, k] <- subjectsPerStage[1, k] overallEffects[1, k] <- sum(subjectsPerStage[1, 1:k] * simEffects[1, 1:k]) / sum(subjectsPerStage[1, 1:k]) overallTestStatistics[1, k] <- overallEffects[1, k] / (stDevs[1] / sqrt(sum(subjectsPerStage[1, 1:k]) * const)) } else if (gMax == 2) { # Population S1 testStatistics[1, k] <- simEffects[1, k] / stDevs[1] * sqrt(subjectsPerStage[1, k] * const) populationSubjectsPerStage[1, k] <- subjectsPerStage[1, k] overallEffects[1, k] <- sum(subjectsPerStage[1, 1:k] * simEffects[1, 1:k]) / sum(subjectsPerStage[1, 1:k]) overallTestStatistics[1, k] <- overallEffects[1, k] / (stDevs[1] / sqrt(sum(subjectsPerStage[1, 1:k]) * const)) # Full population testStatistics[2, k] <- sum(subjectsPerStage[1:2, k] * simEffects[1:2, k], na.rm = TRUE) * sqrt(const) / sqrt(sum(subjectsPerStage[1:2, k] * stDevs[1:2]^2, na.rm = TRUE)) populationSubjectsPerStage[2, k] <- sum(subjectsPerStage[1:2, k], na.rm = TRUE) overallEffects[2, k] <- sum(subjectsPerStage[1:2, 1:k] * simEffects[1:2, 1:k], na.rm = TRUE) / sum(subjectsPerStage[1:2, 1:k], na.rm = TRUE) sd <- sqrt(sum(subjectsPerStage[1:2, 1:k] * stDevs[1:2]^2, na.rm = TRUE) / sum(subjectsPerStage[1:2, 1:k], na.rm = TRUE)) overallTestStatistics[2, k] <- overallEffects[2, k] / sd * sqrt(sum(subjectsPerStage[1:2, 1:k], na.rm = TRUE) * const) } else if (gMax == 3) { # Population S1 testStatistics[1, k] <- sum(subjectsPerStage[c(1, 3), k] * simEffects[c(1, 3), k], na.rm = TRUE) * sqrt(const) / sqrt(sum(subjectsPerStage[c(1, 3), k] * stDevs[c(1, 3)]^2, na.rm = TRUE)) populationSubjectsPerStage[1, k] <- sum(subjectsPerStage[c(1, 3), k], na.rm = TRUE) overallEffects[1, k] <- sum(subjectsPerStage[c(1, 3), 1:k] * simEffects[c(1, 3), 1:k], na.rm = TRUE) / sum(subjectsPerStage[c(1, 3), 1:k], na.rm = TRUE) sd <- sqrt(sum(subjectsPerStage[c(1, 3), 1:k] * stDevs[c(1, 3)]^2, na.rm = TRUE) / sum(subjectsPerStage[c(1, 3), 1:k], na.rm = TRUE)) overallTestStatistics[1, k] <- overallEffects[1, k] / sd * sqrt(sum(subjectsPerStage[c(1, 3), 1:k], na.rm = TRUE) * const) # Population S2 testStatistics[2, k] <- sum(subjectsPerStage[c(2, 3), k] * simEffects[c(2, 3), k], na.rm = TRUE) * sqrt(const) / sqrt(sum(subjectsPerStage[c(2, 3), k] * stDevs[c(2, 3)]^2, na.rm = TRUE)) populationSubjectsPerStage[2, k] <- sum(subjectsPerStage[c(2, 3), k]) overallEffects[2, k] <- sum(subjectsPerStage[c(2, 3), 1:k] * simEffects[c(2, 3), 1:k], na.rm = TRUE) / sum(subjectsPerStage[c(2, 3), 1:k], na.rm = TRUE) sd <- sqrt(sum(subjectsPerStage[c(2, 3), 1:k] * stDevs[c(2, 3)]^2, na.rm = TRUE) / sum(subjectsPerStage[c(2, 3), 1:k], na.rm = TRUE)) overallTestStatistics[2, k] <- overallEffects[2, k] / sd * sqrt(sum(subjectsPerStage[c(2, 3), 1:k], na.rm = TRUE) * const) # Full population testStatistics[3, k] <- sum(subjectsPerStage[1:4, k] * simEffects[1:4, k], na.rm = TRUE) * sqrt(const) / sqrt(sum(subjectsPerStage[1:4, k] * stDevs[1:4]^2, na.rm = TRUE)) populationSubjectsPerStage[3, k] <- sum(subjectsPerStage[1:4, k]) overallEffects[3, k] <- sum(subjectsPerStage[1:4, 1:k] * simEffects[1:4, 1:k], na.rm = TRUE) / sum(subjectsPerStage[1:4, 1:k], na.rm = TRUE) sd <- sqrt(sum(subjectsPerStage[1:4, 1:k] * stDevs[1:4]^2, na.rm = TRUE) / sum(subjectsPerStage[1:4, 1:k], na.rm = TRUE)) overallTestStatistics[3, k] <- overallEffects[3, k] / sd * sqrt(sum(subjectsPerStage[1:4, 1:k], na.rm = TRUE) * const) } else if (gMax == 4) { # Population S1 testStatistics[1, k] <- sum(subjectsPerStage[c(1, 4, 5, 7), k] * simEffects[c(1, 4, 5, 7), k], na.rm = TRUE) * sqrt(const) / sqrt(sum(subjectsPerStage[c(1, 4, 5, 7), k] * stDevs[c(1, 4, 5, 7)]^2, na.rm = TRUE)) populationSubjectsPerStage[1, k] <- sum(subjectsPerStage[c(1, 4, 5, 7), k], na.rm = TRUE) overallEffects[1, k] <- sum(subjectsPerStage[c(1, 4, 5, 7), 1:k] * simEffects[c(1, 4, 5, 7), 1:k], na.rm = TRUE) / sum(subjectsPerStage[c(1, 4, 5, 7), 1:k], na.rm = TRUE) sd <- sqrt(sum(subjectsPerStage[c(1, 4, 5, 7), 1:k] * stDevs[c(1, 4, 5, 7)]^2, na.rm = TRUE) / sum(subjectsPerStage[c(1, 4, 5, 7), 1:k], na.rm = TRUE)) overallTestStatistics[1, k] <- overallEffects[1, k] / sd * sqrt(sum(subjectsPerStage[c(1, 4, 5, 7), 1:k], na.rm = TRUE) * const) # Population S2 testStatistics[2, k] <- sum(subjectsPerStage[c(2, 4, 6, 7), k] * simEffects[c(2, 4, 6, 7), k], na.rm = TRUE) * sqrt(const) / sqrt(sum(subjectsPerStage[c(2, 4, 6, 7), k] * stDevs[c(2, 4, 6, 7)]^2, na.rm = TRUE)) populationSubjectsPerStage[2, k] <- sum(subjectsPerStage[c(2, 4, 6, 7), k]) overallEffects[2, k] <- sum(subjectsPerStage[c(2, 4, 6, 7), 1:k] * simEffects[c(2, 4, 6, 7), 1:k], na.rm = TRUE) / sum(subjectsPerStage[c(2, 4, 6, 7), 1:k], na.rm = TRUE) sd <- sqrt(sum(subjectsPerStage[c(2, 4, 6, 7), 1:k] * stDevs[c(2, 4, 6, 7)]^2, na.rm = TRUE) / sum(subjectsPerStage[c(2, 4, 6, 7), 1:k], na.rm = TRUE)) overallTestStatistics[2, k] <- overallEffects[2, k] / sd * sqrt(sum(subjectsPerStage[c(2, 4, 6, 7), 1:k], na.rm = TRUE) * const) # Population S3 testStatistics[3, k] <- sum(subjectsPerStage[c(3, 5, 6, 7), k] * simEffects[c(3, 5, 6, 7), k], na.rm = TRUE) * sqrt(const) / sqrt(sum(subjectsPerStage[c(3, 5, 6, 7), k] * stDevs[c(3, 5, 6, 7)]^2, na.rm = TRUE)) populationSubjectsPerStage[3, k] <- sum(subjectsPerStage[c(3, 5, 6, 7), k]) overallEffects[3, k] <- sum(subjectsPerStage[c(3, 5, 6, 7), 1:k] * simEffects[c(3, 5, 6, 7), 1:k], na.rm = TRUE) / sum(subjectsPerStage[c(3, 5, 6, 7), 1:k], na.rm = TRUE) sd <- sqrt(sum(subjectsPerStage[c(3, 5, 6, 7), 1:k] * stDevs[c(3, 5, 6, 7)]^2, na.rm = TRUE) / sum(subjectsPerStage[c(3, 5, 6, 7), 1:k], na.rm = TRUE)) overallTestStatistics[3, k] <- overallEffects[3, k] / sd * sqrt(sum(subjectsPerStage[c(3, 5, 6, 7), 1:k], na.rm = TRUE) * const) # Full population testStatistics[4, k] <- sum(subjectsPerStage[1:8, k] * simEffects[1:8, k], na.rm = TRUE) * sqrt(const) / sqrt(sum(subjectsPerStage[1:8, k] * stDevs[1:8]^2, na.rm = TRUE)) populationSubjectsPerStage[4, k] <- sum(subjectsPerStage[1:8, k]) overallEffects[4, k] <- sum(subjectsPerStage[1:8, 1:k] * simEffects[1:8, 1:k], na.rm = TRUE) / sum(subjectsPerStage[1:8, 1:k], na.rm = TRUE) sd <- sqrt(sum(subjectsPerStage[1:8, 1:k] * stDevs[1:8]^2, na.rm = TRUE) / sum(subjectsPerStage[1:8, 1:k], na.rm = TRUE)) overallTestStatistics[4, k] <- overallEffects[4, k] / sd * sqrt(sum(subjectsPerStage[1:8, 1:k], na.rm = TRUE) * const) } testStatistics[!selectedPopulations[, k], k] <- NA_real_ overallEffects[!selectedPopulations[, k], k] <- NA_real_ overallTestStatistics[!selectedPopulations[, k], k] <- NA_real_ separatePValues[, k] <- 1 - stats::pnorm(testStatistics[, k]) if (k < kMax) { if (colSums(selectedPopulations)[k] == 0) { break } # Bonferroni adjustment adjustedPValues[k] <- min(min(separatePValues[, k], na.rm = TRUE) * colSums(selectedPopulations)[k], 1 - 1e-7) # conditional critical value to reject the null hypotheses at the next stage of the trial if (.isTrialDesignFisher(design)) { conditionalCriticalValue[k] <- .getOneMinusQNorm(min((design$criticalValues[k + 1] / prod(adjustedPValues[1:k]^weights[1:k]))^(1 / weights[k + 1]), 1 - 1e-7)) } else { conditionalCriticalValue[k] <- (design$criticalValues[k + 1] * sqrt(design$informationRates[k + 1]) - .getOneMinusQNorm(adjustedPValues[1:k]) %*% weights[1:k]) / sqrt(design$informationRates[k + 1] - design$informationRates[k]) } if (adaptations[k]) { if (effectMeasure == "testStatistic") { selectedPopulations[, k + 1] <- (selectedPopulations[, k] & .selectPopulations( k, overallTestStatistics[, k], typeOfSelection, epsilonValue, rValue, threshold, selectPopulationsFunction )) } else if (effectMeasure == "effectEstimate") { selectedPopulations[, k + 1] <- (selectedPopulations[, k] & .selectPopulations( k, overallEffects[, k], typeOfSelection, epsilonValue, rValue, threshold, selectPopulationsFunction )) } newSubjects <- calcSubjectsFunction( stage = k + 1, # to be consistent with non-enrichment situation, cf. line 36 conditionalPower = conditionalPower, conditionalCriticalValue = conditionalCriticalValue, plannedSubjects = plannedSubjects, allocationRatioPlanned = allocationRatioPlanned, selectedPopulations = selectedPopulations, thetaH1 = thetaH1, stDevH1 = stDevH1, overallEffects = overallEffects, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage ) if (is.null(newSubjects) || length(newSubjects) != 1 || !is.numeric(newSubjects) || is.na(newSubjects) || newSubjects < 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'calcSubjectsFunction' returned an illegal or undefined result (", newSubjects, "); ", "the output must be a single numeric value >= 0" ) } if (!is.na(conditionalPower) || calcSubjectsFunctionIsUserDefined) { plannedSubjects[(k + 1):kMax] <- plannedSubjects[k] + cumsum(rep(newSubjects, kMax - k)) } } else { selectedPopulations[, k + 1] <- selectedPopulations[, k] } if (is.na(thetaH1)) { thetaStandardized <- min(overallEffects[selectedPopulations[1:gMax, k], k] / stDevH1, na.rm = TRUE) } else { thetaStandardized <- thetaH1 / stDevH1 } conditionalPowerPerStage[k] <- 1 - stats::pnorm(conditionalCriticalValue[k] - thetaStandardized * sqrt(plannedSubjects[k + 1] - plannedSubjects[k]) * sqrt(allocationRatioPlanned) / (1 + allocationRatioPlanned)) } } return(list( subjectsPerStage = subjectsPerStage, populationSubjectsPerStage = populationSubjectsPerStage, allocationRatioPlanned = allocationRatioPlanned, overallEffects = overallEffects, testStatistics = testStatistics, overallTestStatistics = overallTestStatistics, separatePValues = separatePValues, conditionalCriticalValue = conditionalCriticalValue, conditionalPowerPerStage = conditionalPowerPerStage, selectedPopulations = selectedPopulations )) } #' #' @title #' Get Simulation Enrichment Means #' #' @description #' Returns the simulated power, stopping and selection probabilities, conditional power, #' and expected sample size or testing means in an enrichment design testing situation. #' #' @inheritParams param_intersectionTest_Enrichment #' @inheritParams param_typeOfSelection #' @inheritParams param_effectMeasure #' @inheritParams param_adaptations #' @inheritParams param_threshold #' @inheritParams param_effectList #' @inheritParams param_stDevSimulation #' @inheritParams param_populations #' @inheritParams param_successCriterion #' @inheritParams param_typeOfSelection #' @inheritParams param_design_with_default #' @inheritParams param_allocationRatioPlanned #' @inheritParams param_plannedSubjects #' @inheritParams param_minNumberOfSubjectsPerStage #' @inheritParams param_maxNumberOfSubjectsPerStage #' @inheritParams param_conditionalPowerSimulation #' @inheritParams param_thetaH1 #' @inheritParams param_stDevH1 #' @inheritParams param_maxNumberOfIterations #' @inheritParams param_calcSubjectsFunction #' @inheritParams param_selectPopulationsFunction #' @inheritParams param_rValue #' @inheritParams param_epsilonValue #' @inheritParams param_seed #' @inheritParams param_three_dots #' @inheritParams param_showStatistics #' @inheritParams param_stratifiedAnalysis #' #' @details #' At given design the function simulates the power, stopping probabilities, selection probabilities, #' and expected sample size at given number of subjects, parameter configuration, and population #' selection rule in the enrichment situation. #' An allocation ratio can be specified referring to the ratio of number of subjects in the active #' treatment groups as compared to the control group. #' #' The definition of \code{thetaH1} and/or \code{stDevH1} makes only sense if \code{kMax} > 1 #' and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and #' \code{maxNumberOfSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. #' #' \code{calcSubjectsFunction}\cr #' This function returns the number of subjects at given conditional power and conditional #' critical value for specified testing situation. The function might depend on the variables #' \code{stage}, #' \code{selectedPopulations}, #' \code{plannedSubjects}, #' \code{allocationRatioPlanned}, #' \code{minNumberOfSubjectsPerStage}, #' \code{maxNumberOfSubjectsPerStage}, #' \code{conditionalPower}, #' \code{conditionalCriticalValue}, #' \code{overallEffects}, and #' \code{stDevH1}. #' The function has to contain the three-dots argument '...' (see examples). #' #' @template return_object_simulation_results #' @template how_to_get_help_for_generics #' #' @template examples_get_simulation_enrichment_means #' #' @export #' getSimulationEnrichmentMeans <- function(design = NULL, ..., populations = NA_integer_, # C_POPULATIONS_DEFAULT effectList = NULL, intersectionTest = c("Simes", "SpiessensDebois", "Bonferroni", "Sidak"), # C_INTERSECTION_TEST_ENRICHMENT_DEFAULT stratifiedAnalysis = TRUE, # C_STRATIFIED_ANALYSIS_DEFAULT, adaptations = NA, typeOfSelection = c("best", "rBest", "epsilon", "all", "userDefined"), # C_TYPE_OF_SELECTION_DEFAULT effectMeasure = c("effectEstimate", "testStatistic"), # C_EFFECT_MEASURE_DEFAULT successCriterion = c("all", "atLeastOne"), # C_SUCCESS_CRITERION_DEFAULT epsilonValue = NA_real_, rValue = NA_real_, threshold = -Inf, plannedSubjects = NA_integer_, allocationRatioPlanned = NA_real_, minNumberOfSubjectsPerStage = NA_real_, maxNumberOfSubjectsPerStage = NA_real_, conditionalPower = NA_real_, thetaH1 = NA_real_, stDevH1 = NA_real_, maxNumberOfIterations = 1000L, # C_MAX_SIMULATION_ITERATIONS_DEFAULT seed = NA_real_, calcSubjectsFunction = NULL, selectPopulationsFunction = NULL, showStatistics = FALSE) { if (is.null(design)) { design <- .getDefaultDesign(..., type = "simulation") .warnInCaseOfUnknownArguments( functionName = "getSimulationEnrichmentMeans", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "showStatistics"), ... ) } else { .assertIsTrialDesignInverseNormalOrFisher(design) .warnInCaseOfUnknownArguments(functionName = "getSimulationEnrichmentMeans", ignore = "showStatistics", ...) .warnInCaseOfTwoSidedPowerArgument(...) } .assertIsOneSidedDesign(design, designType = "enrichment", engineType = "simulation") calcSubjectsFunctionIsUserDefined <- !is.null(calcSubjectsFunction) simulationResults <- .createSimulationResultsEnrichmentObject( design = design, populations = populations, effectList = effectList, intersectionTest = intersectionTest, stratifiedAnalysis = stratifiedAnalysis, adaptations = adaptations, typeOfSelection = typeOfSelection, effectMeasure = effectMeasure, successCriterion = successCriterion, epsilonValue = epsilonValue, rValue = rValue, threshold = threshold, plannedSubjects = plannedSubjects, # means + rates only allocationRatioPlanned = allocationRatioPlanned, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, # means + rates only maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage, # means + rates only conditionalPower = conditionalPower, thetaH1 = thetaH1, # means + survival only stDevH1 = stDevH1, # means only maxNumberOfIterations = maxNumberOfIterations, seed = seed, calcSubjectsFunction = calcSubjectsFunction, # means + rates only selectPopulationsFunction = selectPopulationsFunction, showStatistics = showStatistics, endpoint = "means" ) design <- simulationResults$.design successCriterion <- simulationResults$successCriterion effectMeasure <- simulationResults$effectMeasure adaptations <- simulationResults$adaptations kMax <- simulationResults$.design$kMax intersectionTest <- simulationResults$intersectionTest typeOfSelection <- simulationResults$typeOfSelection effectList <- simulationResults$effectList thetaH1 <- simulationResults$thetaH1 # means + survival only stDevH1 <- simulationResults$stDevH1 # means only conditionalPower <- simulationResults$conditionalPower minNumberOfSubjectsPerStage <- simulationResults$minNumberOfSubjectsPerStage maxNumberOfSubjectsPerStage <- simulationResults$maxNumberOfSubjectsPerStage allocationRatioPlanned <- simulationResults$allocationRatioPlanned calcSubjectsFunction <- simulationResults$calcSubjectsFunction gMax <- simulationResults$populations indices <- .getIndicesOfClosedHypothesesSystemForSimulation(gMax = gMax) cols <- nrow(effectList$effects) simulatedSelections <- array(0, dim = c(kMax, cols, gMax)) simulatedRejections <- array(0, dim = c(kMax, cols, gMax)) simulatedNumberOfPopulations <- matrix(0, nrow = kMax, ncol = cols) simulatedSubjectsPerStage <- array(0, dim = c(kMax, cols, 2^(gMax - 1))) simulatedSuccessStopping <- matrix(0, nrow = kMax, ncol = cols) simulatedFutilityStopping <- matrix(0, nrow = kMax - 1, ncol = cols) simulatedConditionalPower <- matrix(0, nrow = kMax, ncol = cols) simulatedRejectAtLeastOne <- rep(0, cols) expectedNumberOfSubjects <- rep(0, cols) iterations <- matrix(0, nrow = kMax, ncol = cols) len <- maxNumberOfIterations * kMax * gMax * cols dataIterationNumber <- rep(NA_real_, len) dataStageNumber <- rep(NA_real_, len) dataPopulationNumber <- rep(NA_real_, len) dataEffect <- rep(NA_real_, len) dataSubjectsPopulation <- rep(NA_real_, len) dataSubjectsActivePopulation <- rep(NA_real_, len) dataNumberOfSubjects <- rep(NA_real_, len) dataNumberOfCumulatedSubjects <- rep(NA_real_, len) dataRejectPerStage <- rep(NA, len) dataFutilityStop <- rep(NA_real_, len) dataSuccessStop <- rep(NA, len) dataFutilityStop <- rep(NA, len) dataTestStatistics <- rep(NA_real_, len) dataConditionalCriticalValue <- rep(NA_real_, len) dataConditionalPowerAchieved <- rep(NA_real_, len) dataEffectEstimate <- rep(NA_real_, len) dataPValuesSeparate <- rep(NA_real_, len) stDevs <- effectList$stDevs if (length(stDevs) == 1) { stDevs <- rep(stDevs, ncol(effectList$effects)) } if (is.na(stDevH1)) { stDevH1 <- max(stDevs, na.rm = TRUE) } index <- 1 for (i in 1:cols) { for (j in 1:maxNumberOfIterations) { stageResults <- .getSimulatedStageMeansEnrichment( design = design, subsets = effectList$subsets, prevalences = effectList$prevalences, effects = effectList$effects[i, ], stDevs = stDevs, stratifiedAnalysis = stratifiedAnalysis, plannedSubjects = plannedSubjects, typeOfSelection = typeOfSelection, effectMeasure = effectMeasure, adaptations = adaptations, epsilonValue = epsilonValue, rValue = rValue, threshold = threshold, allocationRatioPlanned = allocationRatioPlanned, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage, conditionalPower = conditionalPower, thetaH1 = thetaH1, stDevH1 = stDevH1, calcSubjectsFunction = calcSubjectsFunction, calcSubjectsFunctionIsUserDefined = calcSubjectsFunctionIsUserDefined, selectPopulationsFunction = selectPopulationsFunction ) closedTest <- .performClosedCombinationTestForSimulationEnrichment( stageResults = stageResults, design = design, indices = indices, intersectionTest = intersectionTest, successCriterion = successCriterion ) rejectAtSomeStage <- FALSE rejectedPopulationsBefore <- rep(FALSE, gMax) for (k in 1:kMax) { simulatedRejections[k, i, ] <- simulatedRejections[k, i, ] + (closedTest$rejected[, k] & closedTest$selectedPopulations[1:gMax, k] | rejectedPopulationsBefore) simulatedSelections[k, i, ] <- simulatedSelections[k, i, ] + closedTest$selectedPopulations[, k] simulatedNumberOfPopulations[k, i] <- simulatedNumberOfPopulations[k, i] + sum(closedTest$selectedPopulations[, k]) if (!any(is.na(closedTest$successStop))) { simulatedSuccessStopping[k, i] <- simulatedSuccessStopping[k, i] + closedTest$successStop[k] } if ((kMax > 1) && (k < kMax)) { if (!any(is.na(closedTest$futilityStop))) { simulatedFutilityStopping[k, i] <- simulatedFutilityStopping[k, i] + (closedTest$futilityStop[k] && !closedTest$successStop[k]) } if (!closedTest$successStop[k] && !closedTest$futilityStop[k]) { simulatedConditionalPower[k + 1, i] <- simulatedConditionalPower[k + 1, i] + stageResults$conditionalPowerPerStage[k] } } iterations[k, i] <- iterations[k, i] + 1 for (p in 1:2^(gMax - 1)) { if (!is.na(stageResults$subjectsPerStage[p, k])) { simulatedSubjectsPerStage[k, i, p] <- simulatedSubjectsPerStage[k, i, p] + stageResults$subjectsPerStage[p, k] } } for (g in 1:gMax) { dataIterationNumber[index] <- j dataStageNumber[index] <- k dataPopulationNumber[index] <- g dataEffect[index] <- i dataSubjectsPopulation[index] <- round(stageResults$populationSubjectsPerStage[g, k], 1) dataSubjectsActivePopulation[index] <- round(stageResults$populationSubjectsPerStage[g, k], 1) dataNumberOfSubjects[index] <- round(sum(stageResults$populationSubjectsPerStage[, k], na.rm = TRUE), 1) dataNumberOfCumulatedSubjects[index] <- round(sum( stageResults$populationSubjectsPerStage[, 1:k], na.rm = TRUE ), 1) dataRejectPerStage[index] <- closedTest$rejected[g, k] dataTestStatistics[index] <- stageResults$testStatistics[g, k] dataSuccessStop[index] <- closedTest$successStop[k] if (k < kMax) { dataFutilityStop[index] <- closedTest$futilityStop[k] dataConditionalCriticalValue[index] <- stageResults$conditionalCriticalValue[k] dataConditionalPowerAchieved[index + 1] <- stageResults$conditionalPowerPerStage[k] } dataEffectEstimate[index] <- stageResults$overallEffects[g, k] dataPValuesSeparate[index] <- closedTest$separatePValues[g, k] index <- index + 1 } if (!rejectAtSomeStage && any(closedTest$rejected[, k] & closedTest$selectedPopulations[1:gMax, k] | rejectedPopulationsBefore)) { simulatedRejectAtLeastOne[i] <- simulatedRejectAtLeastOne[i] + 1 rejectAtSomeStage <- TRUE } if ((k < kMax) && (closedTest$successStop[k] || closedTest$futilityStop[k])) { # rejected hypotheses remain rejected also in case of early stopping simulatedRejections[(k + 1):kMax, i, ] <- simulatedRejections[(k + 1):kMax, i, ] + matrix((closedTest$rejected[, k] & closedTest$selectedPopulations[1:gMax, k] | rejectedPopulationsBefore), kMax - k, gMax, byrow = TRUE ) break } rejectedPopulationsBefore <- closedTest$rejected[, k] & closedTest$selectedPopulations[1:gMax, k] | rejectedPopulationsBefore } } simulatedSubjectsPerStage[is.na(simulatedSubjectsPerStage)] <- 0 simulatedSubjectsPerStage[, i, ] <- simulatedSubjectsPerStage[, i, ] / iterations[, i] if (kMax > 1) { simulatedRejections[2:kMax, i, ] <- simulatedRejections[2:kMax, i, ] - simulatedRejections[1:(kMax - 1), i, ] stopping <- cumsum(simulatedSuccessStopping[1:(kMax - 1), i] + simulatedFutilityStopping[, i]) / maxNumberOfIterations expectedNumberOfSubjects[i] <- sum(simulatedSubjectsPerStage[1, i, ] + t(1 - stopping) %*% simulatedSubjectsPerStage[2:kMax, i, ]) } else { expectedNumberOfSubjects[i] <- sum(simulatedSubjectsPerStage[1, i, ]) } } simulatedConditionalPower[1, ] <- NA_real_ if (kMax > 1) { simulatedConditionalPower[2:kMax, ] <- simulatedConditionalPower[2:kMax, ] / iterations[2:kMax, ] } simulationResults$numberOfPopulations <- simulatedNumberOfPopulations / iterations simulationResults$rejectAtLeastOne <- simulatedRejectAtLeastOne / maxNumberOfIterations simulationResults$selectedPopulations <- simulatedSelections / maxNumberOfIterations simulationResults$rejectedPopulationsPerStage <- simulatedRejections / maxNumberOfIterations simulationResults$successPerStage <- simulatedSuccessStopping / maxNumberOfIterations simulationResults$futilityPerStage <- simulatedFutilityStopping / maxNumberOfIterations simulationResults$futilityStop <- base::colSums(simulatedFutilityStopping / maxNumberOfIterations) if (kMax > 1) { simulationResults$earlyStop <- simulationResults$futilityPerStage + simulationResults$successPerStage[1:(kMax - 1), ] simulationResults$conditionalPowerAchieved <- simulatedConditionalPower } simulationResults$sampleSizes <- simulatedSubjectsPerStage simulationResults$expectedNumberOfSubjects <- expectedNumberOfSubjects simulationResults$iterations <- iterations if (!all(is.na(simulationResults$conditionalPowerAchieved))) { simulationResults$.setParameterType("conditionalPowerAchieved", C_PARAM_GENERATED) } if (any(simulationResults$rejectedPopulationsPerStage < 0)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "internal error, simulation not possible due to numerical overflow") } data <- data.frame( iterationNumber = dataIterationNumber, stageNumber = dataStageNumber, populationNumber = dataPopulationNumber, effect = dataEffect, numberOfSubjects = dataNumberOfSubjects, numberOfCumulatedSubjects = dataNumberOfCumulatedSubjects, subjectsPopulation = dataSubjectsPopulation, effectEstimate = dataEffectEstimate, testStatistic = dataTestStatistics, pValue = dataPValuesSeparate, conditionalCriticalValue = round(dataConditionalCriticalValue, 6), conditionalPowerAchieved = round(dataConditionalPowerAchieved, 6), rejectPerStage = dataRejectPerStage, successStop = dataSuccessStop, futilityPerStage = dataFutilityStop ) data <- data[!is.na(data$effectEstimate), ] simulationResults$.data <- data return(simulationResults) } rpact/R/class_time.R0000644000175000017500000024227514145656364014216 0ustar nileshnilesh## | ## | *Time classes* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | C_REGEXP_GREATER_OR_EQUAL <- ">= ?" C_REGEXP_SMALLER <- "< ?" C_REGEXP_SMALLER_OR_EQUAL <- "<= ?" C_REGEXP_DECIMAL_NUMBER <- "\\d*(\\.{1}\\d*)?" TimeDefinition <- setRefClass("TimeDefinition", contains = "ParameterSet", methods = list( initialize = function(...) { callSuper(...) .parameterNames <<- C_PARAMETER_NAMES .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS }, .getRegexpFromTo = function(..., from, to, fromPrefix = "", toPrefix = "") { return(paste0("(^ *", fromPrefix, from, " *- *", toPrefix, to, " *$)")) }, .getRegexpSmallerThan = function() { return(paste0("(^ *", C_REGEXP_SMALLER, C_REGEXP_DECIMAL_NUMBER, " *$)")) }, .getRegexpDecimalNumber = function() { return(paste0("(^ *", C_REGEXP_DECIMAL_NUMBER, " *$)")) }, .getRegexpGreaterOrEqualThan = function() { return(paste0("(^ *", C_REGEXP_GREATER_OR_EQUAL, C_REGEXP_DECIMAL_NUMBER, " *$)")) }, .getRegexpDecimalRangeStart = function() { return(.getRegexpFromTo(from = "0", to = C_REGEXP_DECIMAL_NUMBER, toPrefix = C_REGEXP_SMALLER)) }, .getRegexpDecimalRange = function() { return(.getRegexpFromTo(from = C_REGEXP_DECIMAL_NUMBER, to = C_REGEXP_DECIMAL_NUMBER, toPrefix = C_REGEXP_SMALLER)) }, .getRegexpDecimalRangeEnd = function() { return(.getRegexpFromTo(from = C_REGEXP_DECIMAL_NUMBER, to = "(Inf|x|\\?)", toPrefix = paste0("(", C_REGEXP_SMALLER, " *)?"))) }, .getRegexpDecimalRangeFiniteEnd = function() { return(.getRegexpFromTo(from = C_REGEXP_DECIMAL_NUMBER, to = C_REGEXP_DECIMAL_NUMBER, toPrefix = "<=? ?")) }, .getRegexpOr = function(...) { args <- list(...) if (length(args) == 0) { return("") } if (length(args) == 1) { return(args[[1]]) } return(paste(unlist(args, recursive = FALSE, use.names = FALSE), collapse = "|")) }, .validateTimePeriod = function(timePeriod, i, n, accrualTimeMode = FALSE) { endOfAccrualIsUndefined = FALSE if (i == 1 && (n > 1 || !accrualTimeMode)) { if (!grepl(.getRegexpOr(.getRegexpSmallerThan(), .getRegexpDecimalRangeStart()), timePeriod, perl = TRUE)) { if (!accrualTimeMode && n == 1 && !grepl("(0 *- ?)?=time\", \"time - Inf\" or \"time1 - <=time2\", ", "e.g., \"20\", \">=20\" or \"20 - Inf\" or \"20 - <=30\"") } if (grepl(.getRegexpOr(.getRegexpGreaterOrEqualThan(), .getRegexpDecimalRangeEnd()), timePeriod, perl = TRUE)) { endOfAccrualIsUndefined <- TRUE } timePeriod <- gsub("([Inf >=\\?x]*)|-", "", timePeriod) } else { if (!grepl(.getRegexpOr(.getRegexpGreaterOrEqualThan(), .getRegexpDecimalRangeEnd()), timePeriod, perl = TRUE)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the name of the last region must have the format ", "\">=time\" or \"time - Inf\", e.g., \">=20\" or \"20 - Inf\"") } } } else { if (!grepl(.getRegexpDecimalRange(), timePeriod, perl = TRUE)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the name of the inner regions must have the format \"time_1 - 0 && !all(is.na(median1))) { .self$lambda1 <<- getLambdaByMedian(median1, kappa = kappa) .setParameterType("median1", C_PARAM_USER_DEFINED) .setParameterType("lambda1", C_PARAM_GENERATED) } else { .setParameterType("median1", C_PARAM_NOT_APPLICABLE) .setParameterType("lambda1", ifelse(length(lambda1) == 1 && is.na(lambda1), C_PARAM_NOT_APPLICABLE, C_PARAM_USER_DEFINED)) } if (length(median2) > 0 && !all(is.na(median2))) { .self$lambda2 <<- getLambdaByMedian(median2, kappa = kappa) .setParameterType("median2", C_PARAM_USER_DEFINED) .setParameterType("lambda2", C_PARAM_GENERATED) } else { .setParameterType("median2", C_PARAM_NOT_APPLICABLE) .setParameterType("lambda2", C_PARAM_NOT_APPLICABLE) } args <- list(...) if (!is.null(args[[".pi1Default"]])) { .pi1Default <<- args[[".pi1Default"]] } if (!is.null(args[[".lambdaBased"]])) { .lambdaBased <<- args[[".lambdaBased"]] } if (!is.null(args[[".silent"]])) { .silent <<- args[[".silent"]] } else { .silent <<- FALSE } piecewiseSurvivalEnabled <<- FALSE delayedResponseEnabled <<- FALSE .setParameterType("piecewiseSurvivalTime", C_PARAM_NOT_APPLICABLE) .setParameterType("piecewiseSurvivalEnabled", C_PARAM_GENERATED) .setParameterType("delayedResponseEnabled", ifelse(isTRUE(delayedResponseAllowed), C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE)) .setParameterType("delayedResponseAllowed", ifelse(isTRUE(delayedResponseAllowed), C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE)) .setParameterType("pi1", C_PARAM_NOT_APPLICABLE) .setParameterType("pi2", C_PARAM_NOT_APPLICABLE) .setParameterType("eventTime", ifelse(length(eventTime) == 1 && is.na(eventTime), C_PARAM_NOT_APPLICABLE, ifelse(eventTime == C_EVENT_TIME_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED))) .setParameterType("kappa", ifelse(length(kappa) == 1 && !is.na(kappa) && kappa == 1, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) .init(piecewiseSurvivalTime) if (.getParameterType("median1") == C_PARAM_USER_DEFINED && .getParameterType("lambda1") == C_PARAM_USER_DEFINED) { .setParameterType("lambda1", C_PARAM_GENERATED) } if (.getParameterType("median2") == C_PARAM_USER_DEFINED && .getParameterType("lambda2") == C_PARAM_USER_DEFINED) { .setParameterType("lambda2", C_PARAM_GENERATED) } if (!is.na(eventTime) && .getParameterType("pi1") != C_PARAM_USER_DEFINED && .getParameterType("pi1") != C_PARAM_DEFAULT_VALUE && .getParameterType("pi2") != C_PARAM_USER_DEFINED && .getParameterType("pi2") != C_PARAM_DEFAULT_VALUE) { if (.getParameterType("eventTime") == C_PARAM_USER_DEFINED) { warning("'eventTime' (", round(eventTime, 3), ") will be ignored", call. = FALSE) } .setParameterType("eventTime", C_PARAM_NOT_APPLICABLE) eventTime <<- NA_real_ } .validateCalculatedArguments() }, .validateCalculatedArguments = function() { if (.getParameterType("median1") == C_PARAM_USER_DEFINED) { if (!isTRUE(all.equal(getLambdaByMedian(median1, kappa = kappa), lambda1, tolerance = 1e-05))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'lambda1' must be ", round(getLambdaByMedian(median1, kappa = kappa), 5), ", but is ", round(lambda1, 5)) } if (!any(is.na(pi1)) && !isTRUE(all.equal(getPiByMedian(median1, eventTime = eventTime, kappa = kappa), pi1, tolerance = 1e-05))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi1' must be ", round(getPiByMedian(median1, eventTime = eventTime, kappa = kappa), 5), ", but is ", round(pi1, 5)) } } if (.getParameterType("median2") == C_PARAM_USER_DEFINED) { if (!isTRUE(all.equal(getLambdaByMedian(median2, kappa = kappa), lambda2, tolerance = 1e-05))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'lambda2' must be ", round(getLambdaByMedian(median2, kappa = kappa), 5), ", but is ", round(lambda2, 5)) } if (!is.na(pi2) && !isTRUE(all.equal(getPiByMedian(median2, eventTime = eventTime, kappa = kappa), pi2, tolerance = 1e-05))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi2' must be ", round(getPiByMedian(median2, eventTime = eventTime, kappa = kappa), 5), ", but is ", round(pi2, 5)) } } if (.getParameterType("lambda1") == C_PARAM_USER_DEFINED || .getParameterType("median1") == C_PARAM_USER_DEFINED || .getParameterType("lambda2") == C_PARAM_USER_DEFINED || .getParameterType("median2") == C_PARAM_USER_DEFINED) { if (!any(is.na(pi1))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi1' (", pi1, ") must be NA_real_") } if (.getParameterType("pi1") != C_PARAM_NOT_APPLICABLE) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'pi1' (", .getParameterType("pi1") , ") must be C_PARAM_NOT_APPLICABLE") } if (!any(is.na(pi1))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi2' (", pi2, ") must be NA_real_") } if (.getParameterType("pi2") != C_PARAM_NOT_APPLICABLE) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'pi2' (", .getParameterType("pi2") , ") must be C_PARAM_NOT_APPLICABLE") } if (!any(is.na(eventTime))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'eventTime' (", eventTime, ") must be NA_real_") } if (.getParameterType("eventTime") != C_PARAM_NOT_APPLICABLE) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'eventTime' (", .getParameterType("eventTime") , ") must be C_PARAM_NOT_APPLICABLE") } } if (.getParameterType("hazardRatio") == C_PARAM_TYPE_UNKNOWN) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'hazardRatio' (", hazardRatio, ") must be != C_PARAM_TYPE_UNKNOWN") } }, .stopInCaseOfConflictingArguments = function(arg1, argName1, arg2, argName2) { if (length(arg1) > 0 && !all(is.na(arg1)) && length(arg2) > 0 && !all(is.na(arg2))) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "it is not allowed to specify '", argName1, "' (", .arrayToString(arg1), ")", " and '", argName2, "' (", .arrayToString(arg2), ") concurrently") } }, .asDataFrame = function() { data <- data.frame( piecewiseSurvivalTime = piecewiseSurvivalTime, lambda1 = lambda1, lambda2 = lambda2 ) rownames(data) <- as.character(1:nrow(data)) colnames(data) <- c("Start time", C_PARAMETER_NAMES["lambda1"], # Hazard rate (1) C_PARAMETER_NAMES["lambda2"]) # Hazard rate (2) return(data) }, .isPiBased = function() { return(!.isLambdaBased()) }, .isLambdaBased = function(minNumberOfLambdas = 2) { if (.getParameterType("lambda2") == C_PARAM_USER_DEFINED || .getParameterType("median2") == C_PARAM_USER_DEFINED) { if (length(lambda2) >= minNumberOfLambdas && !any(is.na(lambda2))) { return(TRUE) } } return((length(pi1) == 0 || any(is.na(pi1))) && (length(pi2) == 0 || any(is.na(pi2)))) }, show = function(showType = 1, digits = NA_integer_) { .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { 'Method for automatically printing piecewise survival time objects' .resetCat() if (showType == 2) { callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { .cat("Piecewise exponential survival times:\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) if (!piecewiseSurvivalEnabled) { .cat(" Piecewise exponential survival is disabled.\n\n", consoleOutputEnabled = consoleOutputEnabled) } else if (length(piecewiseSurvivalTime) == 1) { .cat(" At all times:", lambda2[1], "\n\n", consoleOutputEnabled = consoleOutputEnabled) } else { piecewiseSurvivalTimeStr <- format(piecewiseSurvivalTime) lambda2Str <- format(lambda2) for (i in 1:length(piecewiseSurvivalTime)) { if (i < length(piecewiseSurvivalTime)) { .cat(" ", piecewiseSurvivalTimeStr[i], " - <", piecewiseSurvivalTimeStr[i + 1], ": ", lambda2Str[i], "\n", sep ="", consoleOutputEnabled = consoleOutputEnabled) } else { .cat(" ", rep(" ", 2 + max(nchar(piecewiseSurvivalTimeStr))), ">=", piecewiseSurvivalTimeStr[i], ": ", lambda2Str[i], "\n", sep ="", consoleOutputEnabled = consoleOutputEnabled) } } if (delayedResponseEnabled) { .cat("Delayed response is enabled.\n", consoleOutputEnabled = consoleOutputEnabled) } .cat("\n", consoleOutputEnabled = consoleOutputEnabled) } .cat("Details:\n\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getGeneratedParameters(), "Generated parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) } }, .toString = function(startWithUpperCase = FALSE) { s <- "piecewise survival time" return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) }, isDelayedResponseEnabled = function() { return(delayedResponseEnabled) }, isPiecewiseSurvivalEnabled = function() { if (length(piecewiseSurvivalTime) == 0) { return(FALSE) } if (length(piecewiseSurvivalTime) == 1 && is.na(piecewiseSurvivalTime)) { return(FALSE) } return(TRUE) }, .initFromList = function(pwSurvTimeList) { if (!is.list(pwSurvTimeList)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' must be a list") } if (length(pwSurvTimeList) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' must contain at least one entry") } if (!all(is.na(lambda2))) { warning("'lambda2' (", .arrayToString(lambda2), ") will be ignored because 'piecewiseSurvivalTime' is a list", call. = FALSE) } pwSurvStartTimes <- c(0) pwSurvLambda2 <- c() pwSurvTimeNames <- names(pwSurvTimeList) for (i in 1:length(pwSurvTimeNames)) { timePeriod <- pwSurvTimeNames[i] lambdaValue <- pwSurvTimeList[[timePeriod]] .assertIsSingleNumber(lambdaValue, paste0("pwSurvLambda[", i, "]")) timePeriod <- .validateTimePeriod(timePeriod, i = i, n = length(pwSurvTimeNames)) if (i < length(pwSurvTimeNames)) { parts <- strsplit(timePeriod, "- *(< *)?", perl = TRUE)[[1]] if (length(parts) != 2) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all regions (", timePeriod, ") must have the format ", "\"time_1 - 1 && delayedResponseAllowed) { if (length(hazardRatio) != length(pwSurvLambda2)) { warning("Only the first 'hazardRatio' (", round(hazardRatio[1], 4), ") was used for piecewise survival time definition ", "(use a loop over the function to simulate different hazard ratios)", call. = FALSE) hazardRatio <<- hazardRatio[1] } else { delayedResponseEnabled <<- TRUE } lambda1 <<- pwSurvLambda2 * hazardRatio^(1 / kappa) .setParameterType("lambda1", C_PARAM_GENERATED) } else { lambda1 <<- NA_real_ .setParameterType("lambda1", C_PARAM_NOT_APPLICABLE) } lambda2 <<- pwSurvLambda2 .setParameterType("lambda2", C_PARAM_USER_DEFINED) piecewiseSurvivalEnabled <<- !identical(piecewiseSurvivalTime, 0) }, .init = function(pwSurvTime) { .logDebug("pwSurvTime %s, %s", ifelse(is.numeric(pwSurvTime), .arrayToString(pwSurvTime), pwSurvTime), class(pwSurvTime[1])) .logDebug("lambda1 %s, %s", lambda1, .getParameterType("lambda1")) .logDebug("lambda2 %s, %s", lambda2, .getParameterType("lambda2")) # case 1: lambda1 and lambda2 = NA or generated if (length(pwSurvTime) == 1 && (is.na(pwSurvTime) || is.numeric(pwSurvTime)) && (all(is.na(lambda1)) || .getParameterType("lambda1") == C_PARAM_GENERATED) && length(lambda2) == 1 && (is.na(lambda2) || .getParameterType("lambda2") == C_PARAM_GENERATED) ) { .logDebug(".init, case 1: lambda1 and lambda2 = NA") if (!is.null(.lambdaBased) && isTRUE(.lambdaBased)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'lambda1' and 'lambda2' must be specified") } if (!any(is.na(hazardRatio))) { .setParameterType("hazardRatio", C_PARAM_USER_DEFINED) } if (!is.na(pwSurvTime)) { warning("'piecewiseSurvivalTime' (", pwSurvTime, ") will be ignored") } if (is.na(pi2)) { if (!is.na(median2) || !any(is.na(median1))) { .logDebug(".init: set pi2 to 'not applicable'") .setParameterType("pi2", C_PARAM_NOT_APPLICABLE) } else { .logDebug(".init: set pi2 to default") pi2 <<- C_PI_2_DEFAULT .setParameterType("pi2", C_PARAM_DEFAULT_VALUE) } } else { .assertIsSingleNumber(pi2, "pi2") .setParameterType("pi2", ifelse(pi2 == C_PI_2_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) if (!any(is.na(median2))) { warning("'median2' (", .arrayToString(median2), ") will be ignored") median2 <<- NA_real_ } } hazardRatioCalculationEnabled <- TRUE if (all(is.na(pi1))) { if (length(hazardRatio) > 0 && !all(is.na(hazardRatio))) { .setParameterType("hazardRatio", C_PARAM_USER_DEFINED) hazardRatioCalculationEnabled <- FALSE } if (!any(is.na(median1))) { .logDebug(".init: set pi1 to 'not applicable'") .setParameterType("pi1", C_PARAM_NOT_APPLICABLE) if (is.na(median2)) { if (any(is.na(hazardRatio))) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'hazardRatio', 'lambda2', or 'median2' must be specified") } if (length(hazardRatio) != length(median1)) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "length of 'hazardRatio' (", .arrayToString(hazardRatio), ") must be ", "equal to length of 'median1' (", .arrayToString(median1), ")") } .logDebug(".init: calculate lambda2 and median2 by median1") lambda2 <<- getLambdaByMedian(median1, kappa) / hazardRatio^(1 / kappa) if (!delayedResponseAllowed && length(unique(round(lambda2, 8))) > 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'lambda2' can only be calculated if 'unique(lambda1 / hazardRatio^(1 / kappa))' ", "result in a single value; current result = ", .arrayToString(round(lambda2, 4), vectorLookAndFeelEnabled = TRUE), " (delayed response is not allowed)") } median2 <<- getMedianByLambda(lambda2, kappa) .setParameterType("lambda2", C_PARAM_GENERATED) .setParameterType("median2", C_PARAM_GENERATED) } } else if (length(hazardRatio) > 0 && !all(is.na(hazardRatio))) { .setParameterType("pi1", C_PARAM_NOT_APPLICABLE) if (!any(is.na(lambda1))) { .logDebug(".init: calculate median1 by lambda1") median1 <<- getMedianByLambda(lambda1, kappa) .setParameterType("median1", C_PARAM_GENERATED) } else if (!is.na(median2)) { .logDebug(".init: calculate lambda1 and median1 by median2") lambda1 <<- getLambdaByMedian(median2, kappa) * hazardRatio^(1 / kappa) median1 <<- getMedianByLambda(lambda1, kappa) .setParameterType("lambda1", C_PARAM_GENERATED) .setParameterType("median1", C_PARAM_GENERATED) } } else { .logDebug(".init: set pi1 to default") if (!is.null(.pi1Default) && is.numeric(.pi1Default) && length(.pi1Default) > 0) { pi1 <<- .pi1Default } else { pi1 <<- C_PI_1_SAMPLE_SIZE_DEFAULT } .setParameterType("pi1", C_PARAM_DEFAULT_VALUE) } } else { .assertIsNumericVector(pi1, "pi1") if (!any(is.na(median1))) { .logDebug(".init: set median1 to NA") warning("'median1' (", .arrayToString(median1), ") will be ignored") median1 <<- NA_real_ } } if (hazardRatioCalculationEnabled) { if (length(hazardRatio) > 0 && !all(is.na(hazardRatio))) { warning("'hazardRatio' (", .arrayToString(hazardRatio), ") will be ignored because it will be calculated", call. = FALSE) } if (!any(is.na(lambda1)) && !is.na(lambda2)) { .logDebug(".init: calculate hazardRatio by lambda1 and lambda2") hazardRatio <<- (lambda1 / lambda2)^kappa .setParameterType("hazardRatio", C_PARAM_GENERATED) } else if (!any(is.na(pi1)) && !is.na(pi2)) { .logDebug(".init: calculate hazardRatio by pi1 and pi2") hazardRatio <<- getHazardRatioByPi(pi1, pi2, eventTime, kappa = kappa) .setParameterType("hazardRatio", C_PARAM_GENERATED) } } if (length(pi1) > 0 && !any(is.na(pi1))) { pi1Default <- C_PI_1_SAMPLE_SIZE_DEFAULT if (!is.null(.pi1Default) && is.numeric(.pi1Default) && length(.pi1Default) > 0) { pi1Default <- .pi1Default } if (identical(pi1, pi1Default)) { .setParameterType("pi1", C_PARAM_DEFAULT_VALUE) } else if (hazardRatioCalculationEnabled && .getParameterType("pi1") != C_PARAM_GENERATED) { .setParameterType("pi1", C_PARAM_USER_DEFINED) } } if (length(pi2) == 1 && !is.na(pi2)) { if (length(eventTime) == 1 && !is.na(eventTime)) { lambda2 <<- getLambdaByPi(pi2, eventTime, kappa = kappa) .setParameterType("lambda2", C_PARAM_GENERATED) } if (length(pi1) == 1 && is.na(pi1) && !any(is.na(hazardRatio))) { pi1 <<- getPiByLambda(getLambdaByPi( pi2, eventTime, kappa = kappa) * hazardRatio^(1 / kappa), eventTime, kappa = kappa) .setParameterType("pi1", C_PARAM_GENERATED) } if (length(pi1) > 0 && !any(is.na(pi1)) && length(eventTime) == 1 && !is.na(eventTime)) { lambda1 <<- getLambdaByPi(pi1, eventTime, kappa = kappa) .setParameterType("lambda1", C_PARAM_GENERATED) } } .initMedian() return(invisible()) } if (length(pwSurvTime) == 1 && is.na(pwSurvTime)) { pwSurvTime <- NA_real_ } if (is.list(pwSurvTime)) { .assertIsValidHazardRatioVector(hazardRatio) .initFromList(pwSurvTime) .initHazardRatio() if (!piecewiseSurvivalEnabled) { .initPi() .initMedian() } } else if (delayedResponseAllowed && length(lambda2) == 1 && !is.na(lambda2) && length(hazardRatio) > 0 && (all(is.na(pwSurvTime)) || identical(pwSurvTime, 0))) { .logDebug(".init, case 2: delayedResponseAllowed") piecewiseSurvivalEnabled <<- FALSE if (!all(is.na(pwSurvTime)) && !identical(pwSurvTime, 0)) { warning("'piecewiseSurvivalTime' (", .arrayToString(pwSurvTime), ") will be ignored") } piecewiseSurvivalTime <<- 0 .initPi() .initHazardRatio() .initMedian() } else if (!is.numeric(pwSurvTime)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' must be a list, a numeric value, or vector") } else { piecewiseSurvivalTime <<- pwSurvTime if ((all(is.na(piecewiseSurvivalTime)) || identical(piecewiseSurvivalTime, 0)) && length(lambda2) == 1 && !is.na(lambda2)) { .logDebug(".init, case 3: piecewise survival is disabled") if (!all(is.na(piecewiseSurvivalTime)) && !identical(piecewiseSurvivalTime, 0)) { warning("'piecewiseSurvivalTime' (", .arrayToString(piecewiseSurvivalTime), ") will be ignored") } piecewiseSurvivalTime <<- 0 .setParameterType("piecewiseSurvivalTime", C_PARAM_DEFAULT_VALUE) piecewiseSurvivalEnabled <<- FALSE .initHazardRatio() .initPi() .initMedian() } else { .logDebug(".init, case 3: piecewise survival is enabled") if (all(is.na(piecewiseSurvivalTime))) { if (.getParameterType("median1") == C_PARAM_USER_DEFINED) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "'median1' (", .arrayToString(median1), ") with length > 1 can only ", "defined together with a single 'median2', 'lambda2' or 'pi2'") } if (delayedResponseAllowed && length(lambda1 > 0) && !all(is.na(lambda1)) && length(lambda1) != length(lambda2) && delayedResponseAllowed) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'lambda1' (", length(lambda1), "), 'lambda2' (", length(lambda2), "), and ", "'piecewiseSurvivalTime' (", length(piecewiseSurvivalTime), ") must be equal") } stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'piecewiseSurvivalTime' must be specified") } .setParameterType("piecewiseSurvivalTime", C_PARAM_USER_DEFINED) piecewiseSurvivalEnabled <<- TRUE .initHazardRatio() .initPi() } } if (piecewiseSurvivalEnabled) { for (param in c("pi", "median")) { for (group in 1:2) { paramName <- paste0(param, group) if (.getParameterType(paramName) == C_PARAM_USER_DEFINED) { warning("'", paramName, "' (", .arrayToString(.self[[paramName]]), ") ", "was converted to 'lambda", group, "' ", "and is not available in output because piecewise ", "exponential survival time is enabled") } } } pi1 <<- NA_real_ pi2 <<- NA_real_ median1 <<- NA_real_ median2 <<- NA_real_ .setParameterType("pi1", C_PARAM_NOT_APPLICABLE) .setParameterType("pi2", C_PARAM_NOT_APPLICABLE) .setParameterType("median1", C_PARAM_NOT_APPLICABLE) .setParameterType("median2", C_PARAM_NOT_APPLICABLE) .setParameterType("eventTime", C_PARAM_NOT_APPLICABLE) if (!is.na(eventTime) && eventTime != C_EVENT_TIME_DEFAULT) { warning("Event time (", eventTime, ") will be ignored because it is not ", "applicable for piecewise exponential survival time", call. = FALSE) eventTime <<- C_EVENT_TIME_DEFAULT } } .validateInitialization() }, .initMedian = function() { if (length(eventTime) == 1 && !is.na(eventTime)) { if (length(pi1) > 0 && !all(is.na(pi1)) && .getParameterType("median1") != C_PARAM_USER_DEFINED) { median1 <<- getMedianByPi(pi1, eventTime, kappa = kappa) .setParameterType("median1", C_PARAM_GENERATED) } if (length(pi2) == 1 && !is.na(pi2) && .getParameterType("median2") != C_PARAM_USER_DEFINED) { median2 <<- getMedianByPi(pi2, eventTime, kappa = kappa) .setParameterType("median2", C_PARAM_GENERATED) } } else { if (length(lambda1) > 0 && !all(is.na(lambda1)) && .getParameterType("median1") != C_PARAM_USER_DEFINED) { median1 <<- getMedianByLambda(lambda1, kappa = kappa) .setParameterType("median1", C_PARAM_GENERATED) } if (length(lambda2) == 1 && !is.na(lambda2) && .getParameterType("median2") != C_PARAM_USER_DEFINED) { median2 <<- getMedianByLambda(lambda2, kappa = kappa) .setParameterType("median2", C_PARAM_GENERATED) } } }, .initPi = function() { .logDebug(".initPi: set pi1, pi2, and eventTime to NA") if (!is.na(eventTime) && .getParameterType("eventTime") == C_PARAM_USER_DEFINED) { warning("'eventTime' (", round(eventTime, 3), ") will be ignored", call. = FALSE) } if (!is.na(pi1) && !identical(pi2, C_PI_1_DEFAULT) && !identical(pi2, C_PI_1_SAMPLE_SIZE_DEFAULT)) { warning("'pi1' (", .arrayToString(pi1), ") will be ignored", call. = FALSE) } if (!is.na(pi2) && pi2 != C_PI_2_DEFAULT) { warning("'pi2' (", pi2, ") will be ignored", call. = FALSE) } .setParameterType("eventTime", C_PARAM_NOT_APPLICABLE) .setParameterType("pi1", C_PARAM_NOT_APPLICABLE) .setParameterType("pi2", C_PARAM_NOT_APPLICABLE) eventTime <<- NA_real_ pi1 <<- NA_real_ pi2 <<- NA_real_ if (length(lambda2) == 0 || any(is.na(lambda2))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'lambda2' must be defined before .initPi() can be called") } .setParameterType("lambda2", C_PARAM_USER_DEFINED) if (piecewiseSurvivalEnabled && length(hazardRatio) > 1) { return(invisible()) } if (length(lambda1) == 0 || any(is.na(lambda1))) { if (length(hazardRatio) > 0 && !any(is.na(hazardRatio))) { .logDebug(".initPi: calculate lambda1 by hazardRatio") lambda1 <<- lambda2 * hazardRatio^(1 / kappa) .setParameterType("lambda1", C_PARAM_GENERATED) } else if (length(lambda1) == 0) { lambda1 <<- NA_real_ } else if (delayedResponseAllowed) { .setParameterType("lambda1", C_PARAM_USER_DEFINED) } } }, .initHazardRatio = function() { .logDebug(".initHazardRatio") if (!is.null(hazardRatio) && length(hazardRatio) > 0 && !all(is.na(hazardRatio))) { if ((length(lambda1) == 1 && is.na(lambda1)) || .getParameterType("lambda1") == C_PARAM_GENERATED) { .setParameterType("hazardRatio", C_PARAM_USER_DEFINED) return(invisible()) } if (!.silent) { warning("'hazardRatio' (", .arrayToString(hazardRatio), ") will be ignored because it will be calculated", call. = FALSE) } } if (any(is.na(lambda2))) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lambda2' must be specified") } if (any(is.na(lambda1))) { if (delayedResponseAllowed && any(is.na(hazardRatio) && !any(is.na(piecewiseSurvivalTime)) && length(lambda2) == length(piecewiseSurvivalTime))) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'hazardRatio' must be specified") } if (any(is.na(hazardRatio))) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'hazardRatio', 'lambda1' or 'median1' must be specified") } stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lambda1' must be specified") } .setParameterType("lambda1", C_PARAM_USER_DEFINED) hr <- unique(round(lambda1 / lambda2, 8)^kappa) if (length(hr) != 1) { if (length(lambda2) == 1 && length(lambda1) > 1) { hazardRatio <<- (lambda1 / lambda2)^kappa .setParameterType("hazardRatio", C_PARAM_GENERATED) return(invisible()) } else if (delayedResponseAllowed) { hazardRatio <<- (lambda1 / lambda2)^kappa .setParameterType("hazardRatio", C_PARAM_GENERATED) delayedResponseEnabled <<- TRUE return(invisible()) } else { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'hazardRatio' can only be calculated if 'unique(lambda1 / lambda2)' ", "result in a single value; current result = ", .arrayToString(round(hr, 4), vectorLookAndFeelEnabled = TRUE), " (delayed response is not allowed)") } } hazardRatio <<- ((lambda1 / lambda2)^kappa)[1] .setParameterType("hazardRatio", C_PARAM_GENERATED) }, .validateInitialization = function() { if (length(piecewiseSurvivalTime) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' must contain at least one survival start time") } if (any(is.na(piecewiseSurvivalTime))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' must contain valid survival start times") } if (piecewiseSurvivalTime[1] != 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the first value of 'piecewiseSurvivalTime' must be 0") } if (length(piecewiseSurvivalTime) != length(lambda2)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'piecewiseSurvivalTime' (", length(piecewiseSurvivalTime), ") and length of 'lambda2' (", length(lambda2), ") must be equal") } .assertValuesAreStrictlyIncreasing(piecewiseSurvivalTime, "piecewiseSurvivalTime") if ((length(lambda1) != 1 || is.na(lambda1)) && !(.getParameterType("lambda1") %in% c(C_PARAM_GENERATED, C_PARAM_USER_DEFINED))) { if (length(hazardRatio) == 1 && !is.na(hazardRatio)) { lambda1 <<- lambda2 * hazardRatio^(1 / kappa) .setParameterType("lambda1", C_PARAM_GENERATED) } else if (length(hazardRatio) > 1 && delayedResponseAllowed && !is.na(hazardRatio[1])) { if (!delayedResponseEnabled && .isLambdaBased()) { if (delayedResponseAllowed) { if (length(hazardRatio) != length(lambda2)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'hazardRatio' (", length(hazardRatio), ") and length of 'lambda2' (", length(lambda2), ") must be equal") } delayedResponseEnabled <<- TRUE } else { warning("Only the first 'hazardRatio' (", round(hazardRatio[1], 4), ") was used for piecewise survival time definition", call. = FALSE) hazardRatio <<- hazardRatio[1] } lambda1 <<- lambda2 * hazardRatio^(1 / kappa) .setParameterType("lambda1", C_PARAM_GENERATED) } } else if (!delayedResponseEnabled && !(length(lambda2) == 1 && length(lambda1) > 1)) { if (length(lambda1) > 1) { warning("'lambda1' (", .arrayToString(lambda1), ") will be ignored", call. = FALSE) } lambda1 <<- NA_real_ .setParameterType("lambda1", C_PARAM_NOT_APPLICABLE) } } else if (length(hazardRatio) == 1 && !is.na(hazardRatio) && length(lambda1) > 0 && !any(is.na(lambda1)) && length(lambda2) > 0 && !any(is.na(lambda2))) { target <- lambda2 * hazardRatio^(1 / kappa) if (length(lambda1) > 0 && !all(is.na(lambda1)) && !isTRUE(all.equal(target, lambda1))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'lambda1' (", .arrayToString(lambda1), ") ", "is not as expected (", .arrayToString(target), ") for given hazard ratio ", hazardRatio) } } if (piecewiseSurvivalEnabled && !(length(lambda1) == 1 && is.na(lambda1)) && length(piecewiseSurvivalTime) != length(lambda1)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'piecewiseSurvivalTime' (", length(piecewiseSurvivalTime), ") and length of 'lambda1' (", length(lambda1), ") must be equal") } } ) ) #' #' @name AccrualTime #' #' @title #' Accrual Time #' #' @description #' Class for the definition of accrual time and accrual intensity. #' #' @details #' \code{AccrualTime} is a class for the definition of accrual time and accrual intensity. #' #' @include f_core_constants.R #' @include f_core_utilities.R #' @include class_core_parameter_set.R #' #' @keywords internal #' #' @importFrom methods new #' AccrualTime <- setRefClass("AccrualTime", contains = "TimeDefinition", fields = list( .showWarnings = "logical", endOfAccrualIsUserDefined = "logical", followUpTimeMustBeUserDefined = "logical", maxNumberOfSubjectsIsUserDefined = "logical", maxNumberOfSubjectsCanBeCalculatedDirectly = "logical", absoluteAccrualIntensityEnabled = "logical", accrualTime = "numeric", accrualIntensity = "numeric", accrualIntensityRelative = "numeric", maxNumberOfSubjects = "numeric", remainingTime = "numeric", piecewiseAccrualEnabled = "logical" ), methods = list( initialize = function(accrualTime = NA_real_, ..., accrualIntensity = NA_real_, maxNumberOfSubjects = NA_real_, showWarnings = TRUE, absoluteAccrualIntensityEnabled = NA) { callSuper(accrualTime = NA_real_, accrualIntensity = accrualIntensity, maxNumberOfSubjects = maxNumberOfSubjects, .showWarnings = showWarnings, absoluteAccrualIntensityEnabled = absoluteAccrualIntensityEnabled, ...) endOfAccrualIsUserDefined <<- NA followUpTimeMustBeUserDefined <<- NA maxNumberOfSubjectsIsUserDefined <<- NA maxNumberOfSubjectsCanBeCalculatedDirectly <<- TRUE #absoluteAccrualIntensityEnabled <<- NA .setParameterType("endOfAccrualIsUserDefined", C_PARAM_GENERATED) .setParameterType("followUpTimeMustBeUserDefined", C_PARAM_GENERATED) .setParameterType("maxNumberOfSubjectsIsUserDefined", C_PARAM_GENERATED) .setParameterType("maxNumberOfSubjectsCanBeCalculatedDirectly", C_PARAM_GENERATED) .setParameterType("absoluteAccrualIntensityEnabled", ifelse(is.na(absoluteAccrualIntensityEnabled), C_PARAM_GENERATED, C_PARAM_USER_DEFINED)) accrualIntensityRelative <<- NA_real_ .setParameterType("accrualIntensityRelative", C_PARAM_NOT_APPLICABLE) remainingTime <<- NA_real_ .init(accrualTime) # case 6 correction if (!endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && !.self$absoluteAccrualIntensityEnabled) { remainingTime <<- NA_real_ .setParameterType("remainingTime", C_PARAM_NOT_APPLICABLE) .self$accrualTime <<- .self$accrualTime[1:length(.self$accrualIntensity)] } .initAccrualIntensityAbsolute() .validateFormula() .showWarningIfCaseIsNotAllowd() }, .asDataFrame = function() { accrualIntensityTemp <- accrualIntensity if (!all(is.na(accrualIntensityRelative))) { accrualIntensityTemp <- accrualIntensityRelative } if (length(accrualIntensityTemp) + 1 == length(accrualTime)) { accrualIntensityTemp <- c(accrualIntensityTemp, NA_real_) } data <- data.frame( accrualTime = accrualTime, accrualIntensity = accrualIntensityTemp ) rownames(data) <- as.character(1:nrow(data)) colnames(data) <- c("Start time", C_PARAMETER_NAMES["accrualIntensity"]) return(data) }, show = function(showType = 1, digits = NA_integer_) { .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .isAbsoluteAccrualIntensity = function(x) { return(!.isRelativeAccrualIntensity(x)) }, .isRelativeAccrualIntensity = function(x) { return(all(x < 1)) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { 'Method for automatically printing accrual time objects' .resetCat() if (showType == 2) { callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { .cat("Accrual time and intensity:\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) if (!isAccrualTimeEnabled()) { .cat(" Accrual time is disabled.\n", consoleOutputEnabled = consoleOutputEnabled) } else if (length(accrualTime) == 1) { .cat(" At all times:", accrualIntensity[1], "\n", consoleOutputEnabled = consoleOutputEnabled) } else { accrualTimeStr <- format(accrualTime) accrualIntensityStr <- format(accrualIntensity) for (i in 1:length(accrualTime)) { prefix <- ifelse(i == length(accrualTime) - 1, "<=", " <") suffix <- "" if (!maxNumberOfSubjectsIsUserDefined) { suffix <- " " } if (i < length(accrualTime)) { .cat(" ", accrualTimeStr[i], " - ", prefix, accrualTimeStr[i + 1], suffix, ": ", accrualIntensityStr[i], "\n", consoleOutputEnabled = consoleOutputEnabled) } else if (!maxNumberOfSubjectsIsUserDefined) { .cat(" ", accrualTimeStr[i], " - <=[?]: ", accrualIntensityStr[i], "\n", consoleOutputEnabled = consoleOutputEnabled) } } .cat("", consoleOutputEnabled = consoleOutputEnabled) } .cat("\n", consoleOutputEnabled = consoleOutputEnabled) if (isAccrualTimeEnabled()) { .showFormula(consoleOutputEnabled = consoleOutputEnabled) .cat("\n", consoleOutputEnabled = consoleOutputEnabled) .showCase(consoleOutputEnabled = consoleOutputEnabled) .cat("\n", consoleOutputEnabled = consoleOutputEnabled) } .cat("Details:\n\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getGeneratedParameters(), "Generated parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) } }, .getFormula = function() { s <- "" for (i in 1:length(accrualTime)) { if (i < length(accrualTime)) { s <- paste0(s, (round(accrualTime[i + 1], 4) - round(accrualTime[i], 4)), " * ", round(accrualIntensity[i], 4)) if (!absoluteAccrualIntensityEnabled && (!maxNumberOfSubjectsIsUserDefined || !endOfAccrualIsUserDefined)) { s <- paste0(s, " * c ") } if (i < length(accrualIntensity)) { s <- paste0(s, " + ") } } } return(s) }, .validateFormula = function() { if (is.na(maxNumberOfSubjects) || length(accrualTime) != length(accrualIntensity) + 1) { return(invisible()) } numberOfSubjects <- 0 for (i in 1:length(accrualTime)) { if (i < length(accrualTime)) { numberOfSubjects <- numberOfSubjects + (accrualTime[i + 1] - accrualTime[i]) * accrualIntensity[i] } } if (!isTRUE(all.equal(numberOfSubjects, maxNumberOfSubjects, tolerance = 1e-03)) && absoluteAccrualIntensityEnabled) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "'maxNumberOfSubjects' (", maxNumberOfSubjects, ") disagrees with ", "the defined accrual time and intensity: ", .getFormula(), " = ", numberOfSubjects) } }, .showWarningIfCaseIsNotAllowd = function() { caseIsAllowed <- TRUE if (!endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && !absoluteAccrualIntensityEnabled) { caseIsAllowed <- FALSE } else if (!endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined && followUpTimeMustBeUserDefined && !absoluteAccrualIntensityEnabled) { caseIsAllowed <- FALSE } if (!caseIsAllowed) { warning("The specified accrual time and intensity cannot be ", "supplemented automatically with the missing information; ", "therefore further calculations are not possible", call. = FALSE) } }, .showFormula = function(consoleOutputEnabled) { .cat("Formula:\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .cat(" ", consoleOutputEnabled = consoleOutputEnabled) .cat("maxNumberOfSubjects = ", consoleOutputEnabled = consoleOutputEnabled) if (!is.na(maxNumberOfSubjects)) { .cat(maxNumberOfSubjects, " = ", consoleOutputEnabled = consoleOutputEnabled) } .cat(.getFormula(), consoleOutputEnabled = consoleOutputEnabled) if (length(accrualTime) == length(accrualIntensity)) { .cat("(x - ", accrualTime[length(accrualTime)], ") * ", accrualIntensity[length(accrualIntensity)], consoleOutputEnabled = consoleOutputEnabled) if (!absoluteAccrualIntensityEnabled && (!maxNumberOfSubjectsIsUserDefined || !endOfAccrualIsUserDefined)) { .cat(" * c ", consoleOutputEnabled = consoleOutputEnabled) } .cat(", where 'x' is the unknown last accrual time", consoleOutputEnabled = consoleOutputEnabled) if (!absoluteAccrualIntensityEnabled && (!maxNumberOfSubjectsIsUserDefined || !endOfAccrualIsUserDefined)) { .cat(" and 'c' a constant factor", consoleOutputEnabled = consoleOutputEnabled) } } else if (!absoluteAccrualIntensityEnabled && (!maxNumberOfSubjectsIsUserDefined || !endOfAccrualIsUserDefined)) { .cat(", where 'c' is a constant factor", consoleOutputEnabled = consoleOutputEnabled) } .cat("\n", consoleOutputEnabled = consoleOutputEnabled) }, .showCase = function(consoleOutputEnabled = TRUE) { caseIsAllowed <- TRUE prefix <- " " # Case 1 # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33), # maxNumberOfSubjects = 1000) if (endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && absoluteAccrualIntensityEnabled) { .cat("Case (#1):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "End of accrual, absolute accrual intensity and 'maxNumberOfSubjects' are given, ", " 'followUpTime'** shall be calculated.\n", consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), ", "accrualIntensity = c(22, 33), maxNumberOfSubjects = 924)\n", consoleOutputEnabled = consoleOutputEnabled) } # Case 2 # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33), # maxNumberOfSubjects = 1000) else if (endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && !absoluteAccrualIntensityEnabled) { .cat("Case (#2):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "End of accrual, relative accrual intensity and 'maxNumberOfSubjects' are given, ", "absolute accrual intensity* and 'followUpTime'** shall be calculated.\n", consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), ", "accrualIntensity = c(0.22, 0.33), maxNumberOfSubjects = 1000)\n", consoleOutputEnabled = consoleOutputEnabled) } # Case 3 # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33)) else if (endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined && absoluteAccrualIntensityEnabled) { .cat("Case (#3):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "End of accrual and absolute accrual intensity are given, ", "'maxNumberOfSubjects'* and 'followUpTime'** shall be calculated.\n", consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33))\n", consoleOutputEnabled = consoleOutputEnabled) } # Case 4 # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33)) else if (endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined && !absoluteAccrualIntensityEnabled) { .cat("Case (#4):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "End of accrual, relative accrual intensity and 'followUpTime' are given, ", "absolute accrual intensity** and 'maxNumberOfSubjects'** shall be calculated.\n", consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33))\n", consoleOutputEnabled = consoleOutputEnabled) } # Case 5 # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33), # maxNumberOfSubjects = 1000) else if (!endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && absoluteAccrualIntensityEnabled) { .cat("Case (#5):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "'maxNumberOfSubjects' and absolute accrual intensity are given, ", "end of accrual* and 'followUpTime'** shall be calculated\n", consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), ", "accrualIntensity = c(22, 33), maxNumberOfSubjects = 1000)\n", consoleOutputEnabled = consoleOutputEnabled) } # Case 6 # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33), # maxNumberOfSubjects = 1000) else if (!endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && !absoluteAccrualIntensityEnabled) { caseIsAllowed <- FALSE .cat("Case (#6):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "'maxNumberOfSubjects' and relative accrual intensity are given, ", "absolute accrual intensity[x], end of accrual* and 'followUpTime'** shall be calculated\n", consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), ", "accrualIntensity = c(0.22, 0.33), maxNumberOfSubjects = 1000)\n", consoleOutputEnabled = consoleOutputEnabled) } # Case 7 # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33)) else if (!endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined && followUpTimeMustBeUserDefined && absoluteAccrualIntensityEnabled) { .cat("Case (#7):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "'followUpTime' and absolute accrual intensity are given, ", "end of accrual** and 'maxNumberOfSubjects'** shall be calculated\n", consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33))\n", consoleOutputEnabled = consoleOutputEnabled) } # Case 8 # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33)) else if (!endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined && followUpTimeMustBeUserDefined && !absoluteAccrualIntensityEnabled) { caseIsAllowed <- FALSE .cat("Case (#8):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "'followUpTime' and relative accrual intensity are given, ", "absolute accrual intensity[x], end of accrual and 'maxNumberOfSubjects' shall be calculated\n", consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33))\n", consoleOutputEnabled = consoleOutputEnabled) } .cat("\n", consoleOutputEnabled = consoleOutputEnabled) if (!caseIsAllowed) { .cat(prefix, "[x] Cannot be calculated.\n", consoleOutputEnabled = consoleOutputEnabled) } .cat(prefix, "(*) Can be calculated directly.\n", consoleOutputEnabled = consoleOutputEnabled) .cat(prefix, "(**) Cannot be calculated directly but with ", "'getSampleSizeSurvival()' or 'getPowerSurvival()'.\n", consoleOutputEnabled = consoleOutputEnabled) }, .followUpTimeShallBeCalculated = function() { # Case 1: 'followUpTime'** shall be calculated if (endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && absoluteAccrualIntensityEnabled) { return(TRUE) } # Case 2: 'followUpTime'** shall be calculated else if (endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && !absoluteAccrualIntensityEnabled) { return(TRUE) } # Case 3: 'followUpTime'** shall be calculated else if (endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined && absoluteAccrualIntensityEnabled) { return(TRUE) } # Case 5: 'followUpTime'** shall be calculated else if (!endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && absoluteAccrualIntensityEnabled) { return(TRUE) } # Case 6: 'followUpTime'** shall be calculated else if (!endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && !absoluteAccrualIntensityEnabled) { return(TRUE) } # (**) Cannot be calculated directly but with 'getSampleSizeSurvival()' or 'getPowerSurvival()' return(FALSE) }, .validate = function() { # Case 6 if (!endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && !absoluteAccrualIntensityEnabled) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the calulation of 'followUpTime' for given 'maxNumberOfSubjects' ", "and relative accrual intensities (< 1) ", "can only be done if end of accrual is defined") } # Case 8 else if (!endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined && followUpTimeMustBeUserDefined && !absoluteAccrualIntensityEnabled) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the calulation of 'maxNumberOfSubjects' for given 'followUpTime' ", "and relative accrual intensities (< 1) ", "can only be done if end of accrual is defined") } }, .toString = function(startWithUpperCase = FALSE) { s <- "accrual time" return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) }, .getAccrualTimeWithoutLeadingZero = function() { if (length(accrualTime) <= 1) { return(NA_real_) } return(accrualTime[2:length(accrualTime)]) }, isAccrualTimeEnabled = function() { if (length(accrualTime) == 0) { return(FALSE) } if (length(accrualTime) == 1 && is.na(accrualTime)) { return(FALSE) } return(TRUE) }, .initFromList = function(accrualTimeList) { if (!is.list(accrualTimeList)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualTime' must be a list") } if (length(accrualTimeList) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualTime' must contain at least one entry") } if (.showWarnings && !all(is.na(accrualIntensity))&& (length(accrualIntensity) != 1 || accrualIntensity != C_ACCRUAL_INTENSITY_DEFAULT)) { warning("'accrualIntensity' (", .arrayToString(accrualIntensity), ") will be ignored because 'accrualTime' is a list", call. = FALSE) } accrualTime <<- numeric(0) accrualIntensity <<- numeric(0) timeRegions <- names(accrualTimeList) endOfAccrualIsUndefined <- FALSE accrualTime <<- c(accrualTime, 0) for (i in 1:length(timeRegions)) { timePeriod <- timeRegions[i] accrualTimeValue <- accrualTimeList[[timePeriod]] .assertIsSingleNumber(accrualTimeValue, paste0("accrualTime[", i, "]")) settings <- .validateTimePeriod(timePeriod, i = i, n = length(timeRegions), accrualTimeMode = TRUE) timePeriod <- settings$timePeriod endOfAccrualIsUndefined <- settings$endOfAccrualIsUndefined if (i < length(timeRegions)) { parts <- strsplit(timePeriod, "- *(< *)?", perl = TRUE)[[1]] if (length(parts) != 2) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all regions (", timePeriod, ") must have the format ", "\"time_1 - = 2 && length(accrualTime) == length(accrualIntensity) + 1 && !any(is.na(accrualTime)) && !any(is.na(accrualIntensity))) { len <- length(accrualIntensity) accrualIntensityAbsolute <- maxNumberOfSubjects / sum((accrualTime[2:(len + 1)] - accrualTime[1:len]) * accrualIntensity) * accrualIntensity if (!isTRUE(all.equal(accrualIntensityAbsolute, accrualIntensity, tolerance = 1e-06)) && !isTRUE(all.equal(accrualIntensityAbsolute, 0, tolerance = 1e-06))) { .validateAccrualTimeAndIntensity() if (absoluteAccrualIntensityEnabled && .getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { if (.getParameterType("accrualTime") == C_PARAM_DEFAULT_VALUE) { accrualTime <<- maxNumberOfSubjects / accrualIntensity .setParameterType("accrualTime", C_PARAM_GENERATED) remainingTime <<- accrualTime accrualTime <<- c(0, accrualTime) } else { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "'maxNumberOfSubjects' (", maxNumberOfSubjects, ") disagrees with ", "the defined accrual time (", .arrayToString(accrualTime), ") and intensity: ", .getFormula(), " = ", .getSampleSize()) } } else { if (!absoluteAccrualIntensityEnabled && # .isRelativeAccrualIntensity(accrualIntensity) .getParameterType("accrualIntensity") == C_PARAM_USER_DEFINED && .getParameterType("accrualTime") == C_PARAM_DEFAULT_VALUE && .getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { if (.showWarnings) { warning("'accrualIntensity' (", accrualIntensity, ") will be ignored", call. = FALSE) } accrualIntensityRelative <<- C_ACCRUAL_INTENSITY_DEFAULT accrualIntensity <<- accrualIntensityAbsolute .setParameterType("accrualIntensity", C_PARAM_GENERATED) .setParameterType("remainingTime", C_PARAM_NOT_APPLICABLE) } else { accrualIntensityRelative <<- accrualIntensity accrualIntensity <<- accrualIntensityAbsolute .setParameterType("accrualIntensity", C_PARAM_GENERATED) .setParameterType("accrualIntensityRelative", C_PARAM_USER_DEFINED) } } } } }, .isNoPiecewiseAccrualTime = function(accrualTimeArg) { if (length(accrualTimeArg) == 0 || any(is.na(accrualTimeArg)) || !all(is.numeric(accrualTimeArg))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'accrualTimeArg' must a be valid numeric vector") } if (length(accrualTimeArg) == 1) { return(TRUE) } if (length(accrualTimeArg) == 2 && accrualTimeArg[1] == 0) { return(TRUE) } return(FALSE) }, .init = function(accrualTimeArg) { if (length(accrualTimeArg) == 0) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'accrualTime' must be defined") } if (length(accrualTimeArg) == 1 && is.numeric(accrualTimeArg) && is.na(accrualTimeArg)) { accrualTimeArg <- C_ACCRUAL_TIME_DEFAULT } calculateLastAccrualTimeEnabled <- FALSE if (is.list(accrualTimeArg)) { endOfAccrualIsUndefined <- .initFromList(accrualTimeArg) calculateLastAccrualTimeEnabled <- endOfAccrualIsUndefined && !is.null(maxNumberOfSubjects) && length(maxNumberOfSubjects) == 1 && !is.na(maxNumberOfSubjects) } else if (is.numeric(accrualTimeArg)) { .assertIsNumericVector(accrualTimeArg, "accrualTime") if (length(accrualIntensity) > 1) { .assertIsNumericVector(accrualIntensity, "accrualIntensity") } if (.isNoPiecewiseAccrualTime(accrualTimeArg) && (length(accrualIntensity) == 0 || is.null(accrualIntensity) || all(is.na(accrualIntensity)) || all(accrualIntensity == C_ACCRUAL_INTENSITY_DEFAULT))) { accrualTimeArg <- accrualTimeArg[length(accrualTimeArg)] accrualTime <<- c(0L, accrualTimeArg) .setParameterType("accrualTime", ifelse( identical(as.integer(accrualTime), C_ACCRUAL_TIME_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) accrualIntensity <<- C_ACCRUAL_INTENSITY_DEFAULT .setParameterType("accrualIntensity", C_PARAM_DEFAULT_VALUE) .setParameterType("maxNumberOfSubjects", ifelse(length(maxNumberOfSubjects) == 1 && is.na(maxNumberOfSubjects), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) endOfAccrualIsUserDefined <<- length(accrualTime) == length(accrualIntensity) + 1 maxNumberOfSubjectsIsUserDefined <<- .getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED followUpTimeMustBeUserDefined <<- !endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined absoluteAccrualIntensityEnabled <<- FALSE if (maxNumberOfSubjectsIsUserDefined) { accrualIntensity <<- maxNumberOfSubjects / accrualTime[length(accrualTime)] .setParameterType("accrualIntensity", C_PARAM_GENERATED) } return(invisible()) } accrualTime <<- accrualTimeArg if (length(accrualTime) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualTime' must contain at least one time value") } if (accrualTime[1] != 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the first value of 'accrualTime' (", .arrayToString(accrualTime), ") must be 0") } .setParameterType("accrualTime", ifelse( identical(as.integer(accrualTime), C_ACCRUAL_TIME_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) .setParameterType("accrualIntensity", C_PARAM_USER_DEFINED) } else { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualTime' must be a list or a numeric vector") } if (is.na(absoluteAccrualIntensityEnabled)) { absoluteAccrualIntensityEnabled <<- .isAbsoluteAccrualIntensity(accrualIntensity) } if (is.null(maxNumberOfSubjects) || length(maxNumberOfSubjects) == 0 || any(is.na(maxNumberOfSubjects))) { if (length(accrualTime) != length(accrualIntensity) + 1 || !absoluteAccrualIntensityEnabled) { maxNumberOfSubjectsCanBeCalculatedDirectly <<- FALSE } .setParameterType("maxNumberOfSubjects", C_PARAM_NOT_APPLICABLE) } else { if (!(length(accrualTime) %in% c(length(accrualIntensity), length(accrualIntensity) + 1))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'accrualTime' (", length(accrualTime), ") must be equal to length of 'accrualIntensity' if the last 'accrualTime' ", "shall be calculated ", "based on 'maxNumberOfSubjects' or length of 'accrualIntensity' (", length(accrualIntensity), ") + 1 otherwise") } if (length(accrualTime) == length(accrualIntensity)) { calculateLastAccrualTimeEnabled <- TRUE } .setParameterType("maxNumberOfSubjects", C_PARAM_USER_DEFINED) } endOfAccrualIsUserDefined <<- length(accrualTime) == length(accrualIntensity) + 1 if (calculateLastAccrualTimeEnabled) { .calculateRemainingTime() } else if (maxNumberOfSubjectsCanBeCalculatedDirectly) { if (length(accrualTime) == 1) { if (length(maxNumberOfSubjects) > 0 && !is.na(maxNumberOfSubjects) && maxNumberOfSubjects > 0 && maxNumberOfSubjects < accrualIntensity[1]) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjects' (", maxNumberOfSubjects, ") ", "must be >= ", accrualIntensity[1], " ('accrualIntensity')") } remainingTime <<- accrualTime .setParameterType("remainingTime", C_PARAM_USER_DEFINED) } else if (length(accrualTime) > 1) { sampleSize <- .getSampleSize() if (!isTRUE(all.equal(sampleSize, maxNumberOfSubjects, tolerance = 1e-04))) { if (length(maxNumberOfSubjects) == 1 && !is.na(maxNumberOfSubjects) && maxNumberOfSubjects > 0 && maxNumberOfSubjects < sampleSize) { if (length(accrualIntensity) == 1 && length(accrualTime) == 1) { .setParameterType("maxNumberOfSubjects", C_PARAM_USER_DEFINED) accrualTime <<- 0 .calculateRemainingTime() } else { if (length(accrualTime) == length(accrualIntensity) + 1 && absoluteAccrualIntensityEnabled) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "'maxNumberOfSubjects' (", maxNumberOfSubjects, ") disagrees with ", "the defined accrual time and intensity: ", .getFormula(), " = ", sampleSize) } else { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjects' (", maxNumberOfSubjects, ") ", "must be >= ", sampleSize) } } } else { if ((length(maxNumberOfSubjects) != 1 || is.na(maxNumberOfSubjects)) && absoluteAccrualIntensityEnabled) { maxNumberOfSubjects <<- sampleSize .setParameterType("maxNumberOfSubjects", C_PARAM_GENERATED) } remainingTime <<- accrualTime[length(accrualTime)] - accrualTime[length(accrualTime) - 1] .setParameterType("remainingTime", ifelse(!isTRUE(all.equal(0, remainingTime, tolerance = 1e-06)), C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE)) } } } } .validateInitialization() maxNumberOfSubjectsIsUserDefined <<- .getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED followUpTimeMustBeUserDefined <<- !endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined }, .getSampleSize = function() { if (length(accrualTime) < 2) { return(0) } sampleSize <- 0 for (i in 2:length(accrualTime)) { time <- accrualTime[i] - accrualTime[i - 1] sampleSize <- sampleSize + time * accrualIntensity[i - 1] } return(sampleSize) }, .getValuesAfterDecimalPoint = function(x) { values <- c() for (value in x) { baseLevel <- value - floor(value) if (baseLevel == 0) { baseLevel <- 1 } values <- c(values, baseLevel) } return(values) }, .getBaseLevel = function(x) { return(min(.getValuesAfterDecimalPoint(x[x > 0]))) }, .calcSampleSize = function() { if (length(accrualTime) <= 1) { return(0) } accrualTimeTemp <- accrualTime accrualIntensityTemp <- accrualIntensity sampleSize <- 0 for (i in 2:length(accrualTime)) { time <- accrualTime[i] - accrualTime[i - 1] sampleSize <- sampleSize + time * accrualIntensity[i - 1] if (sampleSize >= maxNumberOfSubjects && length(accrualTime) == length(accrualIntensity)) { if (sampleSize > maxNumberOfSubjects) { accrualTime <<- accrualTime[1:(i - 1)] } i2 <- i if (length(accrualTime) == length(accrualIntensity) + 1) { i2 <- i - 1 } accrualIntensity <<- accrualIntensity[1:(i2 - 1)] while (length(accrualTime) > length(accrualIntensity) + 1) { accrualTime <<- accrualTime[1:(length(accrualTime) - 1)] } sampleSize <- 0 if (length(accrualTime) > 1) { sampleSize <- .getSampleSize() } if (.showWarnings) { n1 <- length(accrualTimeTemp) - length(accrualTime) n2 <- length(accrualIntensityTemp) - length(accrualIntensity) if (n1 == 1) { warning("Last accrual time value (", accrualTimeTemp[length(accrualTimeTemp)], ") ignored", call. = FALSE) } else if (n1 > 1) { warning("Last ", n1, " accrual time values (", .arrayToString(accrualTimeTemp[(length(accrualTimeTemp) - n1 + 1):length(accrualTimeTemp)]), ") ignored", call. = FALSE) } if (n2 == 1) { warning("Last accrual intensity value (", accrualIntensityTemp[length(accrualIntensityTemp)], ") ignored", call. = FALSE) } else if (n2 > 1) { warning("Last ", n2, " accrual intensity values (", .arrayToString(accrualIntensityTemp[i2:length(accrualIntensityTemp)]), ") ignored", call. = FALSE) } } return(sampleSize) } } return(sampleSize) }, .calculateRemainingTime = function(stopInCaseOfError = TRUE) { .assertIsValidMaxNumberOfSubjects(maxNumberOfSubjects) sampleSize <- .calcSampleSize() remainingSubjects <- maxNumberOfSubjects - sampleSize if (remainingSubjects < 0) { if (!stopInCaseOfError) { return(invisible()) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjects' (", maxNumberOfSubjects, ") ", "is too small for the defined accrual time (minimum = ", sampleSize, ")") } lastAccrualIntensity <- accrualIntensity[length(accrualIntensity)] remainingTime <<- remainingSubjects / lastAccrualIntensity .setParameterType("remainingTime", ifelse(!isTRUE(all.equal(0, remainingTime, tolerance = 1e-06)), C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE)) if (length(accrualTime) == length(accrualIntensity)) { accrualTime <<- c(accrualTime, accrualTime[length(accrualTime)] + remainingTime) } #.setParameterType("accrualTime", C_PARAM_GENERATED) if (any(accrualTime < 0)) { if (!stopInCaseOfError) { return(invisible()) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjects' (", maxNumberOfSubjects, ") ", "is too small for the defined accrual time") } }, .validateAccrualTimeAndIntensity = function() { if ((length(accrualTime) >= 2 && any(accrualTime[2:length(accrualTime)] < 0))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualTime' (", .arrayToString(accrualTime), ") must be > 0") } .assertValuesAreStrictlyIncreasing(accrualTime, "accrualTime") if ((length(accrualTime) > 1) && any(accrualIntensity < 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualIntensity' (", .arrayToString(accrualIntensity), ") must be >= 0") } if (length(accrualIntensity) == 1 && !is.na(accrualIntensity) && accrualIntensity == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "at least one 'accrualIntensity' value must be > 0") } if (length(accrualIntensity) > 0 && accrualIntensity[1] == 0) { warning("It makes no sense to start 'accrualIntensity' (", .arrayToString(accrualIntensity), ") with 0") } }, .validateInitialization = function() { .validateAccrualTimeAndIntensity() piecewiseAccrualEnabled <<- !.isNoPiecewiseAccrualTime(accrualTime) } ) ) rpact/R/class_analysis_results.R0000644000175000017500000015246014145656364016660 0ustar nileshnilesh## | ## | *Analysis result classes* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' #' @name ConditionalPowerResults #' #' @title #' Conditional Power Results #' #' @description #' Class for conditional power calculations #' #' @details #' This object cannot be created directly; use \code{\link{getConditionalPower}} #' with suitable arguments to create the results of a group sequential or a combination test design. #' #' @keywords internal #' #' @importFrom methods new #' ConditionalPowerResults <- setRefClass("ConditionalPowerResults", contains = "ParameterSet", fields = list( .plotSettings = "PlotSettings", .design = "TrialDesign", .stageResults = "StageResults", .plotData = "list", nPlanned = "numeric", allocationRatioPlanned = "numeric", iterations = "integer", seed = "numeric", simulated = "logical" ), methods = list( initialize = function(...) { callSuper(...) .plotSettings <<- PlotSettings() .parameterNames <<- C_PARAMETER_NAMES .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS if (!is.null(.stageResults) && is.null(.design)) { .design <<- .stageResults$.design } if (is.null(simulated) || length(simulated) == 0 || is.na(simulated)) { .self$simulated <<- FALSE } if (!is.null(.design) && length(.design$kMax) == 1 && .design$kMax == 1L) { .setParameterType("nPlanned", C_PARAM_NOT_APPLICABLE) .setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) .setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) } else { .setParameterType("nPlanned", C_PARAM_GENERATED) .setParameterType("allocationRatioPlanned", C_PARAM_USER_DEFINED) .setParameterType("conditionalPower", C_PARAM_GENERATED) } .setParameterType("simulated", C_PARAM_NOT_APPLICABLE) }, show = function(showType = 1, digits = NA_integer_) { .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { 'Method for automatically printing conditional power result objects' .resetCat() if (showType == 2) { callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { if (!is.null(.design) && length(.design$kMax) == 1 && .design$kMax == 1) { .cat(.toString(), ": not applicable for fixed design (kMax = 1)\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled) } else { .cat(.toString(), ":\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled) } .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getGeneratedParameters(), "Output", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) } }, .toString = function(startWithUpperCase = FALSE) { return("Conditional power results") } ) ) ConditionalPowerResultsMeans <- setRefClass("ConditionalPowerResultsMeans", contains = "ConditionalPowerResults", fields = list( conditionalPower = "numeric", thetaH1 = "numeric", assumedStDev = "numeric" ), methods = list( initialize = function(...) { callSuper(...) if ((is.null(conditionalPower) || length(conditionalPower) == 0) && !is.null(.design) && !is.null(.design$kMax) && length(.design$kMax) > 0) { conditionalPower <<- rep(NA_real_, .design$kMax) } if (is.null(thetaH1) || length(thetaH1) == 0 || all(is.na(thetaH1))) { thetaH1 <<- NA_real_ } if (is.null(assumedStDev) || length(assumedStDev) == 0 || all(is.na(assumedStDev))) { assumedStDev <<- NA_real_ } }, .toString = function(startWithUpperCase = FALSE) { return("Conditional power results means") } ) ) ConditionalPowerResultsMultiHypotheses <- setRefClass("ConditionalPowerResultsMultiHypotheses", contains = "ConditionalPowerResults", fields = list( conditionalPower = "matrix" ), methods = list( initialize = function(...) { callSuper(...) if (.readyForInitialization()) { gMax <- getGMax() kMax <- .design$kMax if (is.null(conditionalPower) || (nrow(conditionalPower) == 0 && ncol(conditionalPower) == 0)) { conditionalPower <<- matrix(rep(NA_real_, gMax * kMax), nrow = gMax, ncol = kMax) } } }, .toString = function(startWithUpperCase = FALSE) { s <- "Conditional power results" s <- paste0(s, " ", ifelse(grepl("Enrichment", class(.stageResults)), "enrichment", "multi-arm")) if (grepl("Means", class(.self))) { s <- paste0(s, " means") } else if (grepl("Rates", class(.self))) { s <- paste0(s, " rates") } else if (grepl("Survival", class(.self))) { s <- paste0(s, " survival") } return(s) }, getGMax = function() { return(.stageResults$getGMax()) }, .readyForInitialization = function() { if (is.null(.design)) { return(FALSE) } if (length(.design$kMax) != 1) { return(FALSE) } if (class(.self) == "ConditionalPowerResults") { return(FALSE) } if (is.null(.stageResults)) { return(FALSE) } if (is.null(.stageResults$testStatistics)) { return(FALSE) } return(TRUE) } ) ) ConditionalPowerResultsMultiArmMeans <- setRefClass("ConditionalPowerResultsMultiArmMeans", contains = "ConditionalPowerResultsMultiHypotheses", fields = list( thetaH1 = "numeric", assumedStDevs = "numeric" ), methods = list( initialize = function(...) { callSuper(...) if (.readyForInitialization()) { gMax <- getGMax() if (is.null(thetaH1) || length(thetaH1) == 0 || all(is.na(thetaH1))) { thetaH1 <<- rep(NA_real_, gMax) } if (is.null(assumedStDevs) || length(assumedStDevs) == 0 || all(is.na(assumedStDevs))) { assumedStDevs <<- rep(NA_real_, gMax) } } } ) ) ConditionalPowerResultsRates <- setRefClass("ConditionalPowerResultsRates", contains = "ConditionalPowerResults", fields = list( conditionalPower = "numeric", pi1 = "numeric", pi2 = "numeric" ), methods = list( initialize = function(...) { callSuper(...) if ((is.null(conditionalPower) || length(conditionalPower) == 0) && !is.null(.design) && !is.null(.design$kMax) && length(.design$kMax) > 0) { conditionalPower <<- rep(NA_real_, .design$kMax) } if (is.null(pi1) || length(pi1) == 0 || all(is.na(pi1))) { pi1 <<- NA_real_ } if (is.null(pi2) || length(pi2) == 0 || all(is.na(pi2))) { pi2 <<- NA_real_ } }, .toString = function(startWithUpperCase = FALSE) { return("Conditional power results rates") } ) ) ConditionalPowerResultsMultiArmRates <- setRefClass("ConditionalPowerResultsMultiArmRates", contains = "ConditionalPowerResultsMultiHypotheses", fields = list( piTreatments = "numeric", piControl = "numeric" ), methods = list( initialize = function(...) { callSuper(...) if (.readyForInitialization()) { gMax <- getGMax() if (is.null(piControl) || length(piControl) == 0 || all(is.na(piControl))) { piControl <<- NA_real_ } if (is.null(piTreatments) || length(piTreatments) == 0 || all(is.na(piTreatments))) { piTreatments <<- rep(NA_real_, gMax) } } } ) ) ConditionalPowerResultsSurvival <- setRefClass("ConditionalPowerResultsSurvival", contains = "ConditionalPowerResults", fields = list( conditionalPower = "numeric", thetaH1 = "numeric" ), methods = list( initialize = function(...) { callSuper(...) if ((is.null(conditionalPower) || length(conditionalPower) == 0) && !is.null(.design) && !is.null(.design$kMax) && length(.design$kMax) > 0) { conditionalPower <<- rep(NA_real_, .design$kMax) } if (is.null(thetaH1) || length(thetaH1) == 0 || all(is.na(thetaH1))) { thetaH1 <<- NA_real_ } }, .toString = function(startWithUpperCase = FALSE) { return("Conditional power results survival") } ) ) ConditionalPowerResultsMultiArmSurvival <- setRefClass("ConditionalPowerResultsMultiArmSurvival", contains = "ConditionalPowerResultsMultiHypotheses", fields = list( thetaH1 = "numeric" ), methods = list( initialize = function(...) { callSuper(...) if (.readyForInitialization()) { gMax <- getGMax() if (is.null(thetaH1) || length(thetaH1) == 0 || all(is.na(thetaH1))) { thetaH1 <<- rep(NA_real_, gMax) } } } ) ) ConditionalPowerResultsEnrichmentMeans <- setRefClass("ConditionalPowerResultsEnrichmentMeans", contains = "ConditionalPowerResultsMultiArmMeans") ConditionalPowerResultsEnrichmentRates <- setRefClass("ConditionalPowerResultsEnrichmentRates", contains = "ConditionalPowerResultsMultiHypotheses", fields = list( piTreatments = "numeric", piControls = "numeric" ), methods = list( initialize = function(...) { callSuper(...) if (.readyForInitialization()) { gMax <- getGMax() if (is.null(piControls) || length(piControls) == 0 || all(is.na(piControls))) { piControls <<- rep(NA_real_, gMax) } if (is.null(piTreatments) || length(piTreatments) == 0 || all(is.na(piTreatments))) { piTreatments <<- rep(NA_real_, gMax) } } } ) ) ConditionalPowerResultsEnrichmentSurvival <- setRefClass("ConditionalPowerResultsEnrichmentSurvival", contains = "ConditionalPowerResultsMultiArmSurvival") #' #' @name ClosedCombinationTestResults #' #' @title #' Analysis Results Closed Combination Test #' #' @description #' Class for multi-arm analysis results based on a closed combination test. #' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the multi-arm analysis results of a closed combination test design. #' #' @keywords internal #' #' @importFrom methods new #' ClosedCombinationTestResults <- setRefClass("ClosedCombinationTestResults", contains = "ParameterSet", fields = list( .plotSettings = "PlotSettings", .design = "TrialDesign", .enrichment = "logical", intersectionTest = "character", indices = "matrix", adjustedStageWisePValues = "matrix", overallAdjustedTestStatistics = "matrix", separatePValues = "matrix", conditionalErrorRate = "matrix", secondStagePValues = "matrix", rejected = "matrix", rejectedIntersections = "matrix" ), methods = list( initialize = function(...) { callSuper(...) .plotSettings <<- PlotSettings() .parameterNames <<- C_PARAMETER_NAMES .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS .setParameterType("intersectionTest", C_PARAM_USER_DEFINED) parametersGenerated <- c( "indices", "separatePValues", "rejected", "rejectedIntersections" ) if (inherits(.design, "TrialDesignConditionalDunnett")) { parametersGenerated <- c(parametersGenerated, "conditionalErrorRate", "secondStagePValues" ) } else { parametersGenerated <- c(parametersGenerated, "adjustedStageWisePValues", "overallAdjustedTestStatistics" ) } for (param in parametersGenerated) { .setParameterType(param, C_PARAM_GENERATED) } if (!is.null(.design) && inherits(.design, C_CLASS_NAME_TRIAL_DESIGN_FISHER)) { .parameterFormatFunctions$overallAdjustedTestStatistics <<- ".formatTestStatisticsFisher" } }, show = function(showType = 1, digits = NA_integer_) { .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { 'Method for automatically printing closed combination test result objects' .resetCat() if (showType == 2) { callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { .cat(.toString(), ":\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) designParametersToShow <- c( ".design$stages", ".design$alpha") if (inherits(.design, "TrialDesignConditionalDunnett")) { designParametersToShow <- c(designParametersToShow, ".design$informationAtInterim", ".design$secondStageConditioning") } .showParametersOfOneGroup(designParametersToShow, "Design parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getGeneratedParameters(), "Output", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) if (isTRUE(.enrichment)) { .cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) .cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) } else { .cat(paste0(" (i): results of treatment arm i vs. control group ", (nrow(separatePValues) + 1),"\n"), consoleOutputEnabled = consoleOutputEnabled) .cat(" [i]: hypothesis number\n", consoleOutputEnabled = consoleOutputEnabled) } } }, .toString = function(startWithUpperCase = FALSE) { s <- "Closed combination test results" if (inherits(.design, "TrialDesignConditionalDunnett")) { s <- paste0(s, " (Conditional Dunnett)") } return(s) }, .getHypothesisTreatmentArms = function(number) { result <- c() for (i in 1:ncol(indices)) { if (indices[number, i] == 1) { result <- c(result, i) } } return(result) }, .getHypothesisTreatmentArmVariants = function() { result <- c() for (number in 1:nrow(indices)) { arms <- .getHypothesisTreatmentArms(number) result <- c(result, paste0(arms, collapse = ", ")) } return(result) }, .getHypothesisPopulationVariants = function() { result <- c() gMax <- 1 for (number in 1:nrow(indices)) { arms <- .getHypothesisTreatmentArms(number) if (number == 1) { gMax <- length(arms) } arms <- paste0("S", arms) arms[arms == paste0("S", gMax)] <- "F" result <- c(result, paste0(arms, collapse = ", ")) } return(result) } ) ) #' #' @name AnalysisResults #' #' @title #' Basic Class for Analysis Results #' #' @description #' A basic class for analysis results. #' #' @details #' \code{AnalysisResults} is the basic class for #' \itemize{ #' \item \code{\link{AnalysisResultsFisher}}, #' \item \code{\link{AnalysisResultsGroupSequential}}, and #' \item \code{\link{AnalysisResultsInverseNormal}}. #' } #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_analysis_dataset.R #' @include class_design.R #' @include f_core_constants.R #' @include class_analysis_stage_results.R #' #' @keywords internal #' #' @importFrom methods new #' AnalysisResults <- setRefClass("AnalysisResults", contains = "ParameterSet", fields = list( .plotSettings = "PlotSettings", .design = "TrialDesign", .dataInput = "Dataset", .stageResults = "StageResults", .conditionalPowerResults = "ConditionalPowerResults", normalApproximation = "logical", directionUpper = "logical", thetaH0 = "numeric", pi1 = "numeric", pi2 = "numeric", nPlanned = "numeric", allocationRatioPlanned = "numeric" ), methods = list( initialize = function(design, dataInput, ...) { callSuper(.design = design, .dataInput = dataInput, ...) .plotSettings <<- PlotSettings() .parameterNames <<- .getParameterNames(design = design, analysisResults = .self) .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS }, .setStageResults = function(stageResults) { .stageResults <<- stageResults .parameterNames <<- .getParameterNames(design = .design, stageResults = stageResults, analysisResults = .self) }, getPlotSettings = function() { return(.plotSettings) }, show = function(showType = 1, digits = NA_integer_) { .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .getStageResultParametersToShow = function() { stageResultParametersToShow <- c() if (.design$kMax > 1) { if (!grepl("Rates", class(.dataInput)) || .dataInput$getNumberOfGroups() > 1) { stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$effectSizes") } if (grepl("Means", class(.dataInput))) { stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallStDevs") } if (grepl("Rates", class(.dataInput))) { if (.isMultiArmAnalysisResults(.self)) { stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPiTreatments") stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPiControl") } else if (.isEnrichmentAnalysisResults(.self)) { stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPisTreatment") stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPisControl") } else { stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPi1") if (.dataInput$getNumberOfGroups() > 1) { stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPi2") } } } } stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$testStatistics") if (grepl("(MultiArm|Dunnett|Enrichment)", class(.self))) { stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$separatePValues") } else { stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$pValues") } if (.design$kMax == 1) { #return(stageResultParametersToShow) } # show combination test statistics if (.isTrialDesignInverseNormal(.design)) { stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$combInverseNormal") } else if (.isTrialDesignGroupSequential(.design)) { stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallTestStatistics") stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPValues") } else if (.isTrialDesignFisher(.design)) { stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$combFisher") } return(stageResultParametersToShow) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { 'Method for automatically printing analysis result objects' .resetCat() if (showType == 2) { callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { .cat(.toString(startWithUpperCase = TRUE), ":\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getDesignParametersToShow(.self), "Design parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) if (grepl("Fisher", class(.self))) { if (!is.null(.self[["seed"]]) && length(.self$seed) == 1 && !is.na(.self$seed)) { .showParametersOfOneGroup(c("iterations", "seed"), "Simulation parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) } else if (!is.null(.conditionalPowerResults[["seed"]]) && length(.conditionalPowerResults$seed) == 1 && !is.na(.conditionalPowerResults$seed)) { .showParametersOfOneGroup(c(".conditionalPowerResults$iterations", ".conditionalPowerResults$seed"), "Simulation parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) } } .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getStageResultParametersToShow(), "Stage results", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) # show multi-arm parameters if (grepl("(MultiArm|Dunnett|Enrichment)", class(.self))) { if (.isTrialDesignConditionalDunnett(.design)) { .showParametersOfOneGroup(".closedTestResults$conditionalErrorRate", "Conditional error rate", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(".closedTestResults$secondStagePValues", "Second stage p-values", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) } else { .showParametersOfOneGroup(".closedTestResults$adjustedStageWisePValues", "Adjusted stage-wise p-values", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(".closedTestResults$overallAdjustedTestStatistics", "Overall adjusted test statistics", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) } .showParametersOfOneGroup(".closedTestResults$rejected", "Test actions", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) } generatedParams <- .getGeneratedParameters() generatedParams <- generatedParams[!(generatedParams %in% c("assumedStDevs", "thetaH1", "pi1", "pi2", "piTreatments", "piTreatments", "piControl", "piControls"))] if (grepl("(MultiArm|Dunnett|Enrichment)", class(.self))) { .showParametersOfOneGroup(generatedParams, "Further analysis results", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) } else { .showParametersOfOneGroup(generatedParams, "Analysis results", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) } .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) if (grepl("(MultiArm|Dunnett)", class(.self))) { .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) .cat(paste0(" (i): results of treatment arm i vs. control group ", .dataInput$getNumberOfGroups(),"\n"), consoleOutputEnabled = consoleOutputEnabled) } else if (.isEnrichmentAnalysisResults(.self)) { .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) .cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) .cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) } else if (grepl("Rates", class(.dataInput)) && .dataInput$getNumberOfGroups() == 2) { .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) .cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) } } }, .toString = function(startWithUpperCase = FALSE) { str <- "analysis results" if (inherits(.self, "AnalysisResultsMultiArm")) { str <- paste0("multi-arm ", str) } else if (inherits(.self, "AnalysisResultsEnrichment")) { str <- paste0("enrichment ", str) } if (startWithUpperCase) { str <- .firstCharacterToUpperCase(str) } numberOfGroups <- .dataInput$getNumberOfGroups() str <- paste0(str, " (") str <- paste0(str, tolower(sub("Dataset(Enrichment)?", "", class(.dataInput)))) if (grepl("Survival", class(.dataInput))) { str <- paste0(str, " data") } if (numberOfGroups == 1) { str <- paste0(str, " of one group") } else { str <- paste0(str, " of ", numberOfGroups, " groups") } if (.design$kMax > 1) { if (grepl("GroupSequential", class(.self))) { str <- paste0(str, ", group sequential design") } else if (grepl("InverseNormal", class(.self))) { str <- paste0(str, ", inverse normal combination test design") } else if (grepl("Fisher", class(.self))) { str <- paste0(str, ", Fisher's combination test design") } else if (grepl("Dunnett", class(.self))) { str <- paste0(str, ", conditional Dunnett design") } } else { str <- paste0(str, ", fixed sample size design") } str <- paste0(str, ")") return(str) }, getNumberOfStages = function() { return(.stageResults$getNumberOfStages()) }, getDataInput = function() { return(.dataInput) } ) ) AnalysisResultsBase <- setRefClass("AnalysisResultsBase", contains = "AnalysisResults", fields = list( thetaH1 = "numeric", assumedStDev = "numeric", equalVariances = "logical", testActions = "character", conditionalRejectionProbabilities = "numeric", conditionalPower = "numeric", repeatedConfidenceIntervalLowerBounds = "numeric", repeatedConfidenceIntervalUpperBounds = "numeric", repeatedPValues = "numeric", finalStage = "integer", finalPValues = "numeric", finalConfidenceIntervalLowerBounds = "numeric", finalConfidenceIntervalUpperBounds = "numeric", medianUnbiasedEstimates = "numeric" ), methods = list( initialize = function(design, dataInput, ...) { callSuper(design = design, dataInput = dataInput, ...) finalStage <<- NA_integer_ } ) ) #' #' @name AnalysisResultsMultiHypotheses #' #' @title #' Basic Class for Analysis Results Multi-Hypotheses #' #' @description #' A basic class for multi-hypotheses analysis results. #' #' @details #' \code{AnalysisResultsMultiHypotheses} is the basic class for #' \itemize{ #' \item \code{\link{AnalysisResultsMultiArm}} and #' \item \code{\link{AnalysisResultsEnrichment}}. #' } #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_analysis_dataset.R #' @include class_design.R #' @include f_core_constants.R #' @include class_analysis_stage_results.R #' #' @keywords internal #' #' @importFrom methods new #' AnalysisResultsMultiHypotheses <- setRefClass("AnalysisResultsMultiHypotheses", contains = "AnalysisResults", fields = list( .closedTestResults = "ClosedCombinationTestResults", thetaH1 = "matrix", # means only assumedStDevs = "matrix", # means only piTreatments = "matrix", # rates only intersectionTest = "character", varianceOption = "character", conditionalRejectionProbabilities = "matrix", conditionalPower = "matrix", repeatedConfidenceIntervalLowerBounds = "matrix", repeatedConfidenceIntervalUpperBounds = "matrix", repeatedPValues = "matrix" ), methods = list( initialize = function(design, dataInput, ...) { callSuper(design = design, dataInput = dataInput, ...) for (param in c("thetaH1", "assumedStDevs", "piTreatments")) { .setParameterType(param, C_PARAM_NOT_APPLICABLE) } } ) ) #' #' @name AnalysisResultsMultiArm #' #' @title #' Basic Class for Analysis Results Multi-Arm #' #' @description #' A basic class for multi-arm analysis results. #' #' @details #' \code{AnalysisResultsMultiArm} is the basic class for #' \itemize{ #' \item \code{\link{AnalysisResultsMultiArmFisher}}, #' \item \code{\link{AnalysisResultsMultiArmInverseNormal}}, and #' \item \code{\link{AnalysisResultsConditionalDunnett}}. #' } #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_analysis_dataset.R #' @include class_design.R #' @include f_core_constants.R #' @include class_analysis_stage_results.R #' #' @keywords internal #' #' @importFrom methods new #' AnalysisResultsMultiArm <- setRefClass("AnalysisResultsMultiArm", contains = "AnalysisResultsMultiHypotheses", fields = list( piControl = "matrix" # rates only ), methods = list( initialize = function(design, dataInput, ...) { callSuper(design = design, dataInput = dataInput, ...) .setParameterType("piControl", C_PARAM_NOT_APPLICABLE) }, .getParametersToShow = function() { parametersToShow <- .getVisibleFieldNames() if ("piTreatments" %in% parametersToShow && "piControl" %in% parametersToShow) { index <- which(parametersToShow == "piTreatments") parametersToShow <- parametersToShow[parametersToShow != "piControl"] parametersToShow <- c(parametersToShow[1:index], "piControl", parametersToShow[(index + 1):length(parametersToShow)]) } return(parametersToShow) } ) ) #' #' @name AnalysisResultsEnrichment #' #' @title #' Basic Class for Analysis Results Enrichment #' #' @description #' A basic class for enrichment analysis results. #' #' @details #' \code{AnalysisResultsEnrichment} is the basic class for #' \itemize{ #' \item \code{\link{AnalysisResultsEnrichmentFisher}} and #' \item \code{\link{AnalysisResultsEnrichmentInverseNormal}}. #' } #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_analysis_dataset.R #' @include class_design.R #' @include f_core_constants.R #' @include class_analysis_stage_results.R #' #' @keywords internal #' #' @importFrom methods new #' AnalysisResultsEnrichment <- setRefClass("AnalysisResultsEnrichment", contains = "AnalysisResultsMultiHypotheses", fields = list( piControls = "matrix" # rates only ), methods = list( initialize = function(design, dataInput, ...) { callSuper(design = design, dataInput = dataInput, ...) .setParameterType("piControls", C_PARAM_NOT_APPLICABLE) } ) ) #' #' @name AnalysisResults_summary #' #' @title #' Analysis Results Summary #' #' @description #' Displays a summary of \code{\link{AnalysisResults}} object. #' #' @param object An \code{\link{AnalysisResults}} object. #' @inheritParams param_digits #' @inheritParams param_three_dots #' #' @details #' Summarizes the parameters and results of an analysis results object. #' #' @template details_summary #' #' @template return_object_summary #' @template how_to_get_help_for_generics #' #' @export #' #' @keywords internal #' summary.AnalysisResults <- function(object, ..., type = 1, digits = NA_integer_) { return(summary.ParameterSet(object = object, ..., type = type, digits = digits)) } #' #' @name AnalysisResults_as.data.frame #' #' @title #' Coerce AnalysisResults to a Data Frame #' #' @description #' Returns the \code{\link{AnalysisResults}} object as data frame. #' #' @param x An \code{\link{AnalysisResults}} object created by \code{\link{getAnalysisResults}}. #' @inheritParams param_three_dots #' #' @details #' Coerces the analysis results to a data frame. #' #' @template return_dataframe #' #' @export #' #' @keywords internal #' as.data.frame.AnalysisResults <- function(x, row.names = NULL, optional = FALSE, ...) { parametersToShow <- .getDesignParametersToShow(x) if (inherits(x, "AnalysisResultsMultiArm")) { parametersToShow <- c(parametersToShow, ".closedTestResults$rejected") } parametersToShow <- c(parametersToShow, x$.getUserDefinedParameters()) parametersToShow <- c(parametersToShow, x$.getDefaultParameters()) parametersToShow <- c(parametersToShow, x$.getStageResultParametersToShow()) parametersToShow <- c(parametersToShow, x$.getGeneratedParameters()) parametersToShow <- parametersToShow[!(parametersToShow %in% c( "finalStage", "allocationRatioPlanned", "thetaH0", "thetaH1", "pi1", "pi2" ))] return(x$.getAsDataFrame(parameterNames = parametersToShow, tableColumnNames = .getTableColumnNames(design = x$.design))) } #' #' @name AnalysisResults_names #' #' @title #' Names of a Analysis Results Object #' #' @description #' Function to get the names of an \code{\link{AnalysisResults}} object. #' #' @param x An \code{\link{AnalysisResults}} object created by \code{\link{getAnalysisResults}}. #' #' @details #' Returns the names of an analysis results that can be accessed by the user. #' #' @template return_names #' #' @export #' #' @keywords internal #' names.AnalysisResults <- function(x) { namesToShow <- c(".design", ".dataInput", ".stageResults", ".conditionalPowerResults") if (.isMultiArmAnalysisResults(x)) { namesToShow <- c(namesToShow, ".closedTestResults") } namesToShow <- c(namesToShow, x$.getVisibleFieldNames()) return(namesToShow) } #' #' @name AnalysisResultsGroupSequential #' #' @title #' Analysis Results Group Sequential #' #' @description #' Class for analysis results results based on a group sequential design. #' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the analysis results of a group sequential design. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_analysis_dataset.R #' @include class_design.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' AnalysisResultsGroupSequential <- setRefClass("AnalysisResultsGroupSequential", contains = "AnalysisResultsBase", fields = list( maxInformation = "integer", informationEpsilon = "numeric" ), methods = list( initialize = function(design, dataInput, ...) { callSuper(design = design, dataInput = dataInput, ...) .setParameterType("maxInformation", C_PARAM_NOT_APPLICABLE) .setParameterType("informationEpsilon", C_PARAM_NOT_APPLICABLE) } ) ) #' #' @name AnalysisResultsInverseNormal #' #' @title #' Analysis Results Inverse Normal #' #' @description #' Class for analysis results results based on an inverse normal design. #' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the analysis results of a inverse normal design. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_analysis_dataset.R #' @include class_design.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' AnalysisResultsInverseNormal <- setRefClass("AnalysisResultsInverseNormal", contains = "AnalysisResultsBase" ) #' #' @name AnalysisResultsMultiArmInverseNormal #' #' @title #' Analysis Results Multi-Arm Inverse Normal #' #' @description #' Class for multi-arm analysis results based on a inverse normal design. #' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the multi-arm analysis results of an inverse normal design. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_analysis_dataset.R #' @include class_design.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' AnalysisResultsMultiArmInverseNormal <- setRefClass("AnalysisResultsMultiArmInverseNormal", contains = "AnalysisResultsMultiArm" ) #' #' @name AnalysisResultsEnrichmentInverseNormal #' #' @title #' Analysis Results Enrichment Inverse Normal #' #' @description #' Class for enrichment analysis results based on a inverse normal design. #' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the enrichment analysis results of an inverse normal design. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_analysis_dataset.R #' @include class_design.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' AnalysisResultsEnrichmentInverseNormal <- setRefClass("AnalysisResultsEnrichmentInverseNormal", contains = "AnalysisResultsEnrichment", fields = list( stratifiedAnalysis = "logical" ) ) #' #' @name AnalysisResultsFisher #' #' @title #' Analysis Results Fisher #' #' @description #' Class for analysis results based on a Fisher combination test design. #' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the analysis results of a Fisher combination test design. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_analysis_dataset.R #' @include class_design.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' AnalysisResultsFisher <- setRefClass("AnalysisResultsFisher", contains = "AnalysisResultsBase", fields = list( conditionalPowerSimulated = "numeric", iterations = "integer", seed = "numeric" ), methods = list( initialize = function(design, dataInput, ...) { callSuper(design = design, dataInput = dataInput, ...) conditionalPowerSimulated <<- -1 } ) ) #' #' @name AnalysisResultsMultiArmFisher #' #' @title #' Analysis Results Multi-Arm Fisher #' #' @description #' Class for multi-arm analysis results based on a Fisher combination test design. #' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_analysis_dataset.R #' @include class_design.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' AnalysisResultsMultiArmFisher <- setRefClass("AnalysisResultsMultiArmFisher", contains = "AnalysisResultsMultiArm", fields = list( conditionalPowerSimulated = "matrix" ) ) #' #' @name AnalysisResultsMultiArmFisher #' #' @title #' Analysis Results Multi-Arm Fisher #' #' @description #' Class for multi-arm analysis results based on a Fisher combination test design. #' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R #' @include class_analysis_dataset.R #' @include class_design.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' AnalysisResultsEnrichmentFisher <- setRefClass("AnalysisResultsEnrichmentFisher", contains = "AnalysisResultsEnrichment", fields = list( conditionalPowerSimulated = "matrix", iterations = "integer", seed = "numeric", stratifiedAnalysis = "logical" ) ) #' #' @name AnalysisResultsConditionalDunnett #' #' @title #' Analysis Results Multi-Arm Conditional Dunnett #' #' @description #' Class for multi-arm analysis results based on a conditional Dunnett test design. #' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the multi-arm analysis results of a conditional Dunnett test design. #' #' @keywords internal #' #' @importFrom methods new #' AnalysisResultsConditionalDunnett <- setRefClass("AnalysisResultsConditionalDunnett", contains = "AnalysisResultsMultiArm", fields = list( ) ) .getAnalysisResultsPlotArguments <- function(x, nPlanned = NA_real_, allocationRatioPlanned = NA_real_) { if (all(is.na(nPlanned))) { nPlanned <- stats::na.omit(x$nPlanned) } if (is.na(allocationRatioPlanned) && length(x$allocationRatioPlanned) == 1) { allocationRatioPlanned <- x$allocationRatioPlanned } if (length(allocationRatioPlanned) != 1) { allocationRatioPlanned <- NA_real_ } if ((.isConditionalPowerEnabled(x$nPlanned) || .isConditionalPowerEnabled(nPlanned)) && is.na(allocationRatioPlanned)) { allocationRatioPlanned <- 1 } return(list( stageResults = x$.stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned )) } .getConfidenceIntervalPlotLegendLabels <- function(x, treatmentArmsToShow) { if (.isEnrichmentStageResults(x)) { gMax <- x$.stageResults$getGMax() labels <- paste0("S", treatmentArmsToShow) labels[treatmentArmsToShow == gMax] <- "F" labels <- factor(labels, levels = unique(labels)) return(labels) } return(paste0(treatmentArmsToShow, " vs control")) } .getConfidenceIntervalData <- function(x, ciName = c("lower", "upper"), treatmentArmsToShow = NULL) { ciName <- match.arg(ciName) paramName <- ifelse(ciName == "lower", "repeatedConfidenceIntervalLowerBounds", "repeatedConfidenceIntervalUpperBounds") data <- x[[paramName]] if (is.matrix(data) && !is.null(treatmentArmsToShow) && length(treatmentArmsToShow) > 0 && !any(is.na(treatmentArmsToShow))) { data <- data[treatmentArmsToShow, ] } if (is.matrix(data) && nrow(data) == 1) { data <- as.numeric(data) } if (is.matrix(data)) { kMax <- ncol(data) if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || all(is.na(treatmentArmsToShow))) { treatmentArmsToShow <- 1:nrow(data) } groups <- length(treatmentArmsToShow) result <- data.frame(ci = data[, 1]) colnames(result) <- ciName result$xValues <- rep(1, groups) result$categories <- .getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow) if (kMax == 1) { return(result) } for (stage in 2:kMax) { resultPart <- data.frame(ci = data[, stage]) colnames(resultPart) <- ciName resultPart$xValues <- rep(stage, groups) resultPart$categories <- .getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow) result <- rbind(result, resultPart) } return(result) } if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || all(is.na(treatmentArmsToShow))) { treatmentArmsToShow <- 1 } kMax <- length(data) result <- data.frame(ci = data) colnames(result) <- ciName result$xValues <- 1:kMax result$categories <- rep(.getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow), kMax) return(result) } #' #' @title #' Analysis Results Plotting #' #' @description #' Plots the conditional power together with the likelihood function. #' #' @param x The analysis results at given stage, obtained from \code{\link{getAnalysisResults}}. #' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). #' @inheritParams param_nPlanned #' @inheritParams param_stage #' @inheritParams param_allocationRatioPlanned #' @param main The main title, default is \code{"Dataset"}. #' @param xlab The x-axis label, default is \code{"Stage"}. #' @param ylab The y-axis label. #' @param legendTitle The legend title, default is \code{""}. #' @inheritParams param_palette #' @inheritParams param_showSource #' @inheritParams param_plotSettings #' @inheritParams param_legendPosition #' @inheritParams param_grid #' @param type The plot type (default = 1). Note that at the moment only one type (the conditional power plot) is available. #' @param ... Optional \link[=param_three_dots_plot]{plot arguments}. Furthermore the following arguments can be defined: #' \itemize{ #' \item \code{thetaRange}: A range of assumed effect sizes if testing means or a survival design was specified. #' Additionally, if testing means was selected, \code{assumedStDev} (assumed standard deviation) #' can be specified (default is \code{1}). #' \item \code{piTreatmentRange}: A range of assumed rates pi1 to calculate the conditional power. #' Additionally, if a two-sample comparison was selected, \code{pi2} can be specified (default is the value from #' \code{getAnalysisResults}). #' \item \code{directionUpper}: Specifies the direction of the alternative, #' only applicable for one-sided testing; default is \code{TRUE} #' which means that larger values of the test statistics yield smaller p-values. #' \item \code{\link[=param_thetaH0]{thetaH0}}: The null hypothesis value, default is \code{0} for #' the normal and the binary case, it is \code{1} for the survival case. #' For testing a rate in one sample, a value thetaH0 in (0, 1) has to be specified for #' defining the null hypothesis H0: \code{pi = thetaH0}. #' } #' #' @details #' The conditional power is calculated only if effect size and sample size is specified. #' #' @template return_object_ggplot #' #' @template examples_plot_analysis_results #' #' @export #' plot.AnalysisResults <- function(x, y, ..., type = 1L, nPlanned = NA_real_, allocationRatioPlanned = NA_real_, main = NA_character_, xlab = NA_character_, ylab = NA_character_, legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, showSource = FALSE, grid = 1, plotSettings = NULL) { functionCall <- match.call(expand.dots = TRUE) analysisResultsName <- as.character(functionCall$x)[1] .assertIsSingleInteger(grid, "grid", validateType = FALSE) typeNumbers <- .getPlotTypeNumber(type, x) p <- NULL plotList <- list() for (typeNumber in typeNumbers) { p <- .plotAnalysisResults(x = x, y = y, type = typeNumber, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, main = main, xlab = xlab, ylab = ylab, legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, showSource = showSource, functionCall = functionCall, analysisResultsName = analysisResultsName, plotSettings = plotSettings, ...) .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) if (length(typeNumbers) > 1) { caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) plotList[[caption]] <- p } } if (length(typeNumbers) == 1) { if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(p)) } return(p) } if (.isSpecialPlotShowSourceArgument(showSource)) { return(invisible(plotList)) } return(.createPlotResultObject(plotList, grid)) } .plotAnalysisResultsRCI <- function(..., x, y, nPlanned, allocationRatioPlanned, main, xlab, ylab, legendTitle, palette, legendPosition, showSource, plotSettings = NULL) { .warnInCaseOfUnknownArguments(functionName = "plot", ignore = c("treatmentArms", "populations"), ...) if (.isEnrichmentStageResults(x)) { gMax <- x$.stageResults$getGMax() treatmentArmsToShow <- .getPopulationsToShow(x, gMax = gMax, ...) } else { treatmentArmsToShow <- .getTreatmentArmsToShow(x, ...) } data <- .getConfidenceIntervalData(x, "lower", treatmentArmsToShow) data$upper <- .getConfidenceIntervalData(x, "upper", treatmentArmsToShow)$upper data$yValues <- (data$upper + data$lower) / 2 data <- na.omit(data) if (nrow(data) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "unable to create plot because no RCIs are available in the specified analysis result") } .warnInCaseOfUnusedArgument(nPlanned, "nPlanned", NA_real_, "plot") .warnInCaseOfUnusedArgument(allocationRatioPlanned, "allocationRatioPlanned", NA_real_, "plot") numberOfRemainingSubjects <- ifelse(length(x$nPlanned) > 0 && !all(is.na(x$nPlanned)), sum(na.omit(x$nPlanned)), NA_real_) plotData <- list( main = "Repeated Confidence Intervals", xlab = "Stage", ylab = "RCI", sub = NA_character_ # subtitle ) if (is.na(legendPosition)) { if (!.isMultiHypothesesAnalysisResults(x)) { legendPosition <- ifelse(length(treatmentArmsToShow) == 1 && treatmentArmsToShow == 1, -1, C_POSITION_RIGHT_CENTER) } else { legendPosition <- C_POSITION_RIGHT_TOP } } if (!is.logical(showSource) || isTRUE(showSource)) { warning("'showSource' != FALSE is not implemented yet for plot type 2 and class ", class(x)) } p <- .createAnalysisResultsPlotObject(x, data = data, plotData = plotData, main = main, xlab = xlab, ylab = ylab, legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, kMax = x$.design$kMax, plotSettings = plotSettings) p <- p + ggplot2::expand_limits(x = c(1, x$.design$kMax)) return(p) } .plotAnalysisResults <- function(..., x, y, type, nPlanned, allocationRatioPlanned, main, xlab, ylab, legendTitle, palette, legendPosition, showSource, functionCall, analysisResultsName, plotSettings = NULL) { .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) if (!(type %in% c(1, 2))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1 or 2") } .assertIsAnalysisResults(x) .assertIsValidLegendPosition(legendPosition = legendPosition) if (type == 2) { return(.plotAnalysisResultsRCI( x = x, y = y, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, main = main, xlab = xlab, ylab = ylab, legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, showSource = showSource, plotSettings = plotSettings, ...)) } if (!.isConditionalPowerEnabled(x$nPlanned) && !.isConditionalPowerEnabled(nPlanned)) { stop("'nPlanned' must be defined to create conditional power plot") } .warnInCaseOfUnknownArguments(functionName = "plot", ignore = c("thetaRange", "assumedStDev", "assumedStDevs", "treatmentArms", "populations", "pi2", "piTreatmentRange"), ...) if (is.na(legendPosition)) { legendPosition <- C_POSITION_RIGHT_CENTER } plotArgs <- .getAnalysisResultsPlotArguments(x = x, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned) functionCall$x <- x$.stageResults functionCall$y <- NULL functionCall$stageResultsName <- paste0(analysisResultsName, "$.stageResults") functionCall$nPlanned <- plotArgs$nPlanned functionCall$main <- main functionCall$xlab <- xlab functionCall$ylab <- ylab functionCall$legendTitle <- legendTitle functionCall$palette <- palette functionCall$legendPosition <- legendPosition functionCall$type <- type functionCall$plotSettings <- plotSettings functionCall$allocationRatioPlanned <- plotArgs$allocationRatioPlanned if (.isTrialDesignFisher(x$.design)) { functionCall$iterations <- x$iterations functionCall$seed <- x$seed } if (x$getDataInput()$isDatasetMeans()) { if (.isMultiHypothesesAnalysisResults(x)) { assumedStDevs <- eval.parent(functionCall$assumedStDevs) if (is.null(assumedStDevs)) { assumedStDevs <- as.numeric(x$assumedStDevs) } functionCall$assumedStDevs <- assumedStDevs } else { assumedStDev <- eval.parent(functionCall$assumedStDev) if (is.null(assumedStDev)) { assumedStDev <- x$assumedStDev } functionCall$assumedStDev <- assumedStDev } } if (x$getDataInput()$isDatasetMeans() || x$getDataInput()$isDatasetSurvival()) { thetaRange <- eval.parent(functionCall$thetaRange) if (is.null(thetaRange)) { thetaRangeMin <- min(x$thetaH0, min(na.omit(as.numeric(x$thetaH1)))) thetaRangeMax <- 2 * max(x$thetaH0, max(na.omit(as.numeric(x$thetaH1)))) thetaRange <- seq(thetaRangeMin, thetaRangeMax, (thetaRangeMax - thetaRangeMin) / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT) } else { thetaRange <- .assertIsValidThetaRange(thetaRange = thetaRange, survivalDataEnabled = x$getDataInput()$isDatasetSurvival()) } functionCall$thetaRange <- thetaRange } else if (x$getDataInput()$isDatasetRates()) { if (.isMultiArmAnalysisResults(x)) { piControl <- eval.parent(functionCall$piControl) if (is.null(piControl)) { piControl <- as.numeric(x$piControl) } functionCall$piControl <- piControl } else if (.isEnrichmentAnalysisResults(x)) { piControl <- eval.parent(functionCall$piControl) if (is.null(piControl)) { piControls <- as.numeric(x$piControls) } functionCall$piControls <- piControls } else { pi2 <- eval.parent(functionCall$pi2) if (is.null(pi2)) { pi2 <- x$pi2 } functionCall$pi2 <- pi2 } piTreatmentRange <- eval.parent(functionCall$piTreatmentRange) if (is.null(piTreatmentRange)) { piTreatmentRange <- seq(0, 1, 1 / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT) # default } else { piTreatmentRange <- .assertIsValidPiTreatmentRange(piTreatmentRange = piTreatmentRange) } functionCall$piTreatmentRange <- piTreatmentRange } functionCall[[1L]] <- as.name("plot") return(eval.parent(functionCall)) } rpact/R/f_core_utilities.R0000644000175000017500000025247714154631431015414 0ustar nileshnilesh## | ## | *Core utilities* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5639 $ ## | Last changed: $Date: 2021-12-10 11:59:33 +0100 (Fri, 10 Dec 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include f_core_constants.R NULL utils::globalVariables(".parallelComputingCluster") utils::globalVariables(".parallelComputingCaseNumbers") utils::globalVariables(".parallelComputingArguments") .parallelComputingCluster <- NULL .parallelComputingCaseNumbers <- NULL .parallelComputingArguments <- NULL .getLogicalEnvironmentVariable <- function(variableName) { result <- as.logical(Sys.getenv(variableName)) return(ifelse(is.na(result), FALSE, result)) } .getPackageName <- function(functionName) { .assertIsSingleCharacter(functionName, "functionName") tryCatch({ return(environmentName(environment(get(functionName)))) }, error = function(e) { return(NA_character_) }) } #' #' @title #' Set Log Level #' #' @description #' Sets the \code{rpact} log level. #' #' @param logLevel The new log level to set. Can be one of #' "PROGRESS", "ERROR", "WARN", "INFO", "DEBUG", "TRACE", "DISABLED". #' Default is "PROGRESS". #' #' @details #' This function sets the log level of the \code{rpact} internal log message system. #' By default only calculation progress messages will be shown on the output console, #' particularly \code{\link{getAnalysisResults}} shows this kind of messages. #' The output of these messages can be disabled by setting the log level to \code{"DISABLED"}. #' #' @seealso #' \itemize{ #' \item \code{\link{getLogLevel}} for getting the current log level, #' \item \code{\link{resetLogLevel}} for resetting the log level to default. #' } #' #' @examples #' \dontrun{ #' # show debug messages #' setLogLevel("DEBUG") #' #' # disable all log messages #' setLogLevel("DISABLED") #' } #' #' @keywords internal #' #' @export #' setLogLevel <- function(logLevel = c("PROGRESS", "ERROR", "WARN", "INFO", "DEBUG", "TRACE", "DISABLED")) { logLevel <- match.arg(logLevel) if (!is.character(logLevel) || !(logLevel %in% c( C_LOG_LEVEL_TRACE, C_LOG_LEVEL_DEBUG, C_LOG_LEVEL_INFO, C_LOG_LEVEL_WARN, C_LOG_LEVEL_ERROR, C_LOG_LEVEL_PROGRESS, C_LOG_LEVEL_DISABLED))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'logLevel' must be one of ", "c(", paste(paste0("'", c(C_LOG_LEVEL_TRACE, C_LOG_LEVEL_DEBUG, C_LOG_LEVEL_INFO, C_LOG_LEVEL_WARN, C_LOG_LEVEL_ERROR, C_LOG_LEVEL_PROGRESS, C_LOG_LEVEL_DISABLED), "'"), collapse = ", "), ")") } Sys.setenv("RPACT_LOG_LEVEL" = logLevel) } #' #' @title #' Get Log Level #' #' @description #' Returns the current \code{rpact} log level. #' #' @details #' This function gets the log level of the \code{rpact} internal log message system. #' #' @seealso #' \itemize{ #' \item \code{\link{setLogLevel}} for setting the log level, #' \item \code{\link{resetLogLevel}} for resetting the log level to default. #' } #' #' @return Returns a \code{\link[base]{character}} of length 1 specifying the current log level. #' #' @examples #' # show current log level #' getLogLevel() #' #' @keywords internal #' #' @export #' getLogLevel <- function() { logLevel <- Sys.getenv("RPACT_LOG_LEVEL") if (logLevel == "") { logLevel <- C_LOG_LEVEL_PROGRESS Sys.setenv("RPACT_LOG_LEVEL" = logLevel) } return(logLevel) } #' #' @title #' Reset Log Level #' #' @description #' Resets the \code{rpact} log level. #' #' @details #' This function resets the log level of the \code{rpact} internal log message #' system to the default value \code{"PROGRESS"}. #' #' @seealso #' \itemize{ #' \item \code{\link{getLogLevel}} for getting the current log level, #' \item \code{\link{setLogLevel}} for setting the log level. #' } #' #' @examples #' \dontrun{ #' # reset log level to default value #' resetLogLevel() #' } #' #' @keywords internal #' #' @export #' resetLogLevel <- function() { setLogLevel(C_LOG_LEVEL_PROGRESS) } .createParallelComputingCluster <- function() { if (!is.null(.parallelComputingCluster)) { return(TRUE) } if (requireNamespace("parallel", quietly = TRUE)) { startTime <- Sys.time() cores <- parallel::detectCores(logical = FALSE) if (is.na(cores) || cores < 2) { return(FALSE) } tryCatch({ .parallelComputingCluster <<- parallel::makeCluster(cores) .logProgress("Parallel computing cluster created with " + cores + " cores", startTime = startTime) return(TRUE) }, error = function(e) { .logWarn("Failed to create parallel computing cluster", e) }) } return(FALSE) } .areEqualVectors <- function(v1, v2, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { if (is.null(v1) || is.null(v2)) { return(FALSE) } if (length(v1) != length(v2)) { return(FALSE) } if (length(v1) == 0) { return(TRUE) } vec1 <- v1 vec2 <- v2 vec1[is.na(vec1)] <- -99999999999999 vec2[is.na(vec2)] <- -99999999999999 d <- nchar(as.character(1 / tolerance)) - 1 vec1 <- round(vec1, d) vec2 <- round(vec2, d) return(sum(vec1 == vec2) == length(vec1)) } #.areEqualVectors(c(0.152206629, 0.165328755, 0.002777922, NA), c(0.152206631, 0.165328753, 0.002777917, NA), tolerance = 1e-08) .toCapitalized <- function(x, ignoreBlackList = FALSE) { if (is.null(x) || is.na(x) || !is.character(x)) { return(x) } if (!ignoreBlackList) { if (x %in% c("pi", "pi1", "pi2", "mu", "mu1", "mu2")) { return(x) } } s <- strsplit(x, " ")[[1]] s <- paste0(toupper(substring(s, 1, 1)), substring(s, 2)) wordsToExclude <- c("And", "The", "Of", "Or", "By") s[s %in% wordsToExclude] <- tolower(s[s %in% wordsToExclude]) s <- paste(s, collapse = " ") s <- sub("non\\-binding", "Non-Binding", s) s <- sub("binding", "Binding", s) return(s) } .isCapitalized <- function(x) { return(x == toupper(x)) } .formatCamelCase <- function(x, title = FALSE) { indices <- gregexpr("[A-Z]", x)[[1]] parts <- strsplit(x, "[A-Z]")[[1]] result <- "" for (i in 1:length(indices)) { index <- indices[i] y <- tolower(substring(x, index, index)) if (title) { y <- .firstCharacterToUpperCase(y) } result <- paste0(result, parts[i], " ", y) } if (length(parts) > length(indices)) { result <- paste0(result, parts[length(parts)]) } return(trimws(result)) } .firstCharacterToUpperCase <- function(x, ..., sep = "") { args <- list(...) if (length(args) > 0) { x <- paste(x, unlist(args, use.names = FALSE), collapse = sep, sep = sep) } substr(x, 1, 1) <- toupper(substr(x, 1, 1)) return(x) } .equalsRegexpIgnoreCase <- function(x, pattern) { x <- tolower(x) pattern <- tolower(pattern) result <- grep(pattern, x) return(sum(result) > 0) } # # @title # Get Optional Argument # # @description # Returns the value of an optional argument if it exists. # # @param optionalArgumentName the name of the optional argument. # # @details # Internal function. # # @return the value of the optional argument if it exists; NULL otherwise. # # @examples # # f = function(...) { # print(.getOptionalArgument("x", ...)) # } # # > f(x = 1) # [1] 1 # # > f(y = 1) # NULL # # @keywords internal # .getOptionalArgument <- function(optionalArgumentName, ..., optionalArgumentDefaultValue = NULL) { args <- list(...) if (optionalArgumentName %in% names(args)) { return(args[[optionalArgumentName]]) } return(optionalArgumentDefaultValue) } .isUndefinedArgument <- function(arg) { if (missing(arg) || is.null(arg)) { return(TRUE) } tryCatch({ if (length(arg) == 0) { return(TRUE) } if (length(arg) > 1) { return(FALSE) } }, error = function(e) { paramName <- deparse(substitute(arg)) .logWarn("Failed to execute '.isUndefinedArgument(%s)' ('%s' is an instance of class '%s'): %s", paramName, paramName, class(arg), e) }) return(is.na(arg)) } .isDefinedArgument <- function(arg, argumentExistsValidationEnabled = TRUE) { paramName <- deparse(substitute(arg)) if (argumentExistsValidationEnabled && length(grep("\\$|\\[|\\]", paramName)) == 0 && !exists(paramName)) { tryCatch({ if (missing(arg) || is.null(arg)) { return(FALSE) } }, error = function(e) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "the object '", paramName, "' has not been defined anywhere. ", "Please define it first, e.g., run '", paramName, " <- 1'") }) } if (missing(arg) || is.null(arg)) { return(FALSE) } tryCatch({ if (length(arg) == 0) { return(FALSE) } if (length(arg) > 1) { return(TRUE) } }, error = function(e) { paramName <- deparse(substitute(arg)) .logWarn("Failed to execute '.isDefinedArgument(%s)' ('%s' is an instance of class '%s'): %s", paramName, paramName, class(arg), e) }) return(!is.na(arg)) } .getConcatenatedValues <- function(x, separator = ", ", mode = c("csv", "vector", "and", "or")) { if (is.null(x) || length(x) <= 1) { return(x) } mode <- match.arg(mode) if (mode %in% c("csv", "vector")) { result <- paste(x, collapse = separator) if (mode == "vector") { result <- paste0("c(", result, ")") } return(result) } if (length(x) == 2) { return(paste(x, collapse = paste0(" ", mode, " "))) } space <- ifelse(grepl(" $", separator), "", " ") part1 <- x[1:length(x) - 1] part2 <- x[length(x)] return(paste0(paste(part1, collapse = separator), separator, space, mode, " ", part2)) } #.getConcatenatedValues(1) #.getConcatenatedValues(1:2) #.getConcatenatedValues(1:3) #.getConcatenatedValues(1, mode = "vector") #.getConcatenatedValues(1:2, mode = "vector") #.getConcatenatedValues(1:3, mode = "vector") #.getConcatenatedValues(1, mode = "and") #.getConcatenatedValues(1:2, mode = "and") #.getConcatenatedValues(1:3, mode = "and") #.getConcatenatedValues(1, mode = "or") #.getConcatenatedValues(1:2, mode = "or") #.getConcatenatedValues(1:3, mode = "or") #.getConcatenatedValues(1, mode = "or", separator = ";") #.getConcatenatedValues(1:2, mode = "or", separator = ";") #.getConcatenatedValues(1:3, mode = "or", separator = ";") .arrayToString <- function(x, ..., separator = ", ", vectorLookAndFeelEnabled = FALSE, encapsulate = FALSE, digits = 3, maxLength = 80L, maxCharacters = 160L, mode = c("csv", "vector", "and", "or")) { if (!is.na(digits) && digits < 0) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'digits' (", digits, ") must be >= 0") } .assertIsSingleInteger(maxLength, "maxLength", naAllowed = FALSE, validateType = FALSE) .assertIsInClosedInterval(maxLength, "maxLength", lower = 1, upper = NULL) .assertIsSingleInteger(maxCharacters, "maxCharacters", naAllowed = FALSE, validateType = FALSE) .assertIsInClosedInterval(maxCharacters, "maxCharacters", lower = 3, upper = NULL) if (missing(x) || is.null(x) || length(x) == 0) { return("NULL") } if (length(x) == 1 && is.na(x)) { return("NA") } if (!is.numeric(x) && !is.character(x) && !is.logical(x) && !is.integer(x)) { return(class(x)) } if (is.numeric(x) && !is.na(digits)) { if (digits > 0) { indices <- which(!is.na(x) & abs(x) >= 10^-digits) } else { indices <- which(!is.na(x)) } x[indices] <- as.character(round(x[indices], digits)) } mode <- match.arg(mode) if (mode == "csv" && vectorLookAndFeelEnabled) { mode <- "vector" } if (is.matrix(x) && nrow(x) > 1 && ncol(x) > 1) { result <- c() for (i in 1:nrow(x)) { row <- x[i, ] if (encapsulate) { row <- paste0("'", row, "'") } result <- c(result, paste0("(", paste(row, collapse = separator), ")")) } return(.getConcatenatedValues(result, separator = separator, mode = mode)) } if (encapsulate) { x <- paste0("'", x, "'") } if (length(x) > maxLength) { x <- c(x[1:maxLength], "...") } s <- .getConcatenatedValues(x, separator = separator, mode = mode) if (nchar(s) > maxCharacters && length(x) > 1) { s <- x[1] index <- 2 while (nchar(paste0(s, separator, x[index])) <= maxCharacters && index <= length(x)) { s <- paste0(s, separator, x[index]) index <- index + 1 } s <- paste0(s, separator, "...") if (vectorLookAndFeelEnabled && length(x) > 1) { s <- paste0("c(", s, ")") } } return(s) } .listToString <- function(a, separator = ", ", listLookAndFeelEnabled = FALSE, encapsulate = FALSE) { if (missing(a) || is.null(a) || length(a) == 0) { return("NULL") } if (length(a) == 1 && is.na(a)) { return("NA") } result <- "" for (name in names(a)) { value <- a[[name]] if (is.list(value)) { value <- .listToString(value, separator = separator, listLookAndFeelEnabled = listLookAndFeelEnabled, encapsulate = encapsulate) if (!listLookAndFeelEnabled) { value <- paste0("{", value, "}") } } else { if (length(value) > 1) { value <- .arrayToString(value, separator = separator, encapsulate = encapsulate) value <- paste0("(", value, ")") } else if (encapsulate) { value <- sQuote(value) } } entry <- paste(name, "=", value) if (nchar(result) > 0) { result <- paste(result, entry, sep = ", ") } else { result <- entry } } if (!listLookAndFeelEnabled) { return(result) } return(paste0("list(", result, ")")) } # # @title # Set Seed # # @description # Sets the seed, generates it if \code{is.na(seed) == TRUE} and returns it. # # @param seed the seed to set. # # @details # Internal function. # # @return the (generated) seed. # # @examples # # .setSeed(12345) # # mySeed <- .setSeed() # # @keywords internal # .setSeed <- function(seed = NA_real_) { if (!is.null(seed) && !is.na(seed)) { if (is.na(as.integer(seed))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'seed' must be a valid integer") } set.seed(seed = seed, kind = "Mersenne-Twister", normal.kind = "Inversion") return(seed) } if (exists(".Random.seed") && length(.Random.seed) > 0) { seed <- .Random.seed[length(.Random.seed)] } else { seed <- round(stats::runif(1) * 1e8) } .logDebug("Set seed to %s", seed) tryCatch({ set.seed(seed, kind = "Mersenne-Twister", normal.kind = "Inversion") }, error = function(e) { .logError("Failed to set seed to '%s' (%s): %s", seed, class(seed), e) seed <- NA_real_ traceback() }) invisible(seed) } .getInputForZeroOutputInsideTolerance <- function(input, output, tolerance = .Machine$double.eps^0.25) { if (is.null(tolerance) || is.na(tolerance)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'tolerance' must be a valid double") } if (tolerance < 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'tolerance' (", tolerance, ") must be >= 0") } if (is.null(input)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'input' must be a valid double or NA") } if (is.null(output) || is.na(output)) { return(NA_real_) } if (abs(output) <= tolerance) { return(input) } return(NA_real_) } .getInputProducingZeroOutput <- function(input1, output1, input2, output2, tolerance = .Machine$double.eps^0.25) { if ((is.na(output1) || is.null(output1)) && (is.na(output2) || is.null(output2))) { return(NA_real_) } if (is.na(output1) || is.null(output1)) { return(.getInputForZeroOutputInsideTolerance(input2, output2, tolerance)) } if (is.na(output2) || is.null(output2)) { return(.getInputForZeroOutputInsideTolerance(input1, output1, tolerance)) } if (abs(output1) <= abs(output2) && !is.na(input1)) { return(.getInputForZeroOutputInsideTolerance(input1, output1, tolerance)) } return(.getInputForZeroOutputInsideTolerance(input2, output2, tolerance)) } # # @title # Get One Dimensional Root # # @description # Searches and returns the one dimensional root of a function using \code{uniroot}. # # @param acceptResultsOutOfTolerance if \code{TRUE}, results will be accepted in any case; # if \code{FALSE}, \code{NA_real_} will be returned in case of tolerance discrepancy # # @details # Internal function. # # @return the root. # # @keywords internal # .getOneDimensionalRoot <- function( fun, ..., lower, upper, tolerance = .Machine$double.eps^0.25, acceptResultsOutOfTolerance = FALSE, suppressWarnings = TRUE, callingFunctionInformation = NA_character_) { .assertIsSingleNumber(lower, "lower") .assertIsSingleNumber(upper, "upper") .assertIsSingleNumber(tolerance, "tolerance") resultLower <- fun(lower, ...) resultUpper <- fun(upper, ...) result <- .getInputProducingZeroOutput(lower, resultLower, upper, resultUpper, tolerance) if (!is.na(result)) { return(result) } unirootResult <- NULL tryCatch({ unirootResult <- stats::uniroot(f = fun, lower = lower, upper = upper, tol = tolerance, trace = 2, extendInt = "no", ...) }, warning = function(w) { .logWarn(.getCallingFunctionInformation(callingFunctionInformation), "uniroot(f, lower = %s, upper = %s, tol = %s) produced a warning: %s", lower, upper, tolerance, w) }, error = function(e) { msg <- "Failed to run uniroot(f, lower = %s, upper = %s, tol = %s): %s" if (getLogLevel() == C_LOG_LEVEL_DEBUG) { .logError(msg, lower, upper, tolerance, e) } else { .logWarn(msg, lower, upper, tolerance, e) } }) if (is.null(unirootResult)) { direction <- ifelse(fun(lower) < fun(upper), 1, -1) if (is.na(direction)) { return(NA_real_) } return(.getOneDimensionalRootBisectionMethod(fun = fun, lower = lower, upper = upper, tolerance = tolerance, acceptResultsOutOfTolerance = acceptResultsOutOfTolerance, direction = direction, suppressWarnings = suppressWarnings, callingFunctionInformation = callingFunctionInformation)) } if (is.infinite(unirootResult$f.root) || abs(unirootResult$f.root) > max(tolerance * 100, 1e-07)) { if (!acceptResultsOutOfTolerance) { if (!suppressWarnings) { warning(.getCallingFunctionInformation(callingFunctionInformation), "NA returned because root search by 'uniroot' produced a function result (", unirootResult$f.root, ") that differs from target 0 ", "(lower = ", lower, ", upper = ", upper, ", tolerance = ", tolerance, ", last function argument was ", unirootResult$root, ")", call. = FALSE) } return(NA_real_) } else if (!suppressWarnings) { warning(.getCallingFunctionInformation(callingFunctionInformation), "Root search by 'uniroot' produced a function result (", unirootResult$f.root, ") ", "that differs from target 0 ", "(lower = ", lower, ", upper = ", upper, ", tolerance = ", tolerance, ", last function argument was ", unirootResult$root, ")", call. = FALSE) } } return(unirootResult$root) } .getCallingFunctionInformation <- function(x) { if (is.na(x)) { return("") } return(paste0(x, ": ")) } # # @title # Get One Dimensional Root Bisection Method # # @description # Searches and returns the one dimensional root of a function using the bisection method. # # @param acceptResultsOutOfTolerance if \code{TRUE}, results will be accepted in any case; # if \code{FALSE}, \code{NA_real_} will be returned in case of tolerance discrepancy # # @details # Internal function. # # @keywords internal # .getOneDimensionalRootBisectionMethod <- function( fun, ..., lower, upper, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, acceptResultsOutOfTolerance = FALSE, maxSearchIterations = 50, direction = 0, suppressWarnings = TRUE, callingFunctionInformation = NA_character_) { lowerStart <- lower upperStart <- upper if (direction == 0) { direction <- ifelse(fun(lower) < fun(upper), 1, -1) } .logTrace("Start special root search: lower = %s, upper = %s, tolerance = %s, direction = %s", lower, upper, tolerance, direction) precision <- 1 while (!is.na(precision) && precision > tolerance) { argument <- (lower + upper) / 2 result <- fun(argument) .logTrace("Root search step: f(%s, lower = %s, upper = %s, direction = %s) = %s", argument, lower, upper, direction, result) ifelse(result * direction < 0, lower <- argument, upper <- argument) maxSearchIterations <- maxSearchIterations - 1 if (maxSearchIterations < 0) { if (!suppressWarnings) { warning(.getCallingFunctionInformation(callingFunctionInformation), "Root search via 'bisection' stopped: maximum number of search iterations reached. ", "Check if lower and upper search bounds were calculated correctly", call. = FALSE) } .plotMonotoneFunctionRootSearch(fun, lowerStart, upperStart) return(NA_real_) } precision <- upper - lower } if (is.infinite(result) || abs(result) > max(tolerance * 100, 1e-07)) { # 0.01) { # tolerance * 20 .plotMonotoneFunctionRootSearch(fun, lowerStart, upperStart) if (!acceptResultsOutOfTolerance) { if (!suppressWarnings) { warning(.getCallingFunctionInformation(callingFunctionInformation), "NA returned because root search via 'bisection' produced a function result (", result, ") that differs from target 0 ", "(tolerance is ", tolerance, ", last function argument was ", argument, ")", call. = FALSE) } return(NA_real_) } else if (!suppressWarnings) { warning(.getCallingFunctionInformation(callingFunctionInformation), "Root search via 'bisection' produced a function result (", result, ") ", "that differs from target 0 ", "(tolerance is ", tolerance, ", last function argument was ", argument, ")", call. = FALSE) } } return(argument) } .plotMonotoneFunctionRootSearch <- function(f, lowerStart, upperStart) { if (getLogLevel() != C_LOG_LEVEL_TRACE) { return(invisible()) } values <- c() params <- seq(from = lowerStart, to = upperStart, by = (upperStart - lowerStart) / 20) for (i in params) { values <- c(values, f(i)) } graphics::plot(params, values) } .getTextLineWithLineBreak <- function(line, lineBreakIndex) { index <- .getSpaceIndex(line, lineBreakIndex) if (index == -1) { return(line) } a <- substr(line, 0, index - 1) b <- substr(line, index + 1, nchar(line)) return(paste0(a, "\n", b)) } .getSpaceIndex <- function(line, lineBreakIndex) { if (nchar(line) <= lineBreakIndex) { return(-1) } if (regexpr('\\n', line) > 0) { return(-1) } len <- nchar(line) lineSplit <- strsplit(line, "")[[1]] for (i in (len/2):length(lineSplit)) { char <- lineSplit[i] if (char == " ") { return(i) } } return(-1) } .isFirstValueGreaterThanSecondValue <- function(firstValue, secondValue) { if (is.null(firstValue) || length(firstValue) != 1 || is.na(firstValue)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'firstValue' (", firstValue, ") must be a valid numeric value") } if (is.null(secondValue) || length(secondValue) != 1 || is.na(secondValue)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'secondValue' (", secondValue, ") must be a valid numeric value") } return(firstValue > secondValue) } .isFirstValueSmallerThanSecondValue <- function(firstValue, secondValue) { if (is.null(firstValue) || length(firstValue) != 1 || is.na(firstValue)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'firstValue' (", firstValue, ") must be a valid numeric value") } if (is.null(secondValue) || length(secondValue) != 1 || is.na(secondValue)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'secondValue' (", secondValue, ") must be a valid numeric value") } return(firstValue < secondValue) } .logBase <- function(s, ..., logLevel) { if (length(list(...)) > 0) { cat(paste0("[", logLevel, "]"), sprintf(s, ...), "\n") } else { cat(paste0("[", logLevel, "]"), s, "\n") } } .logTrace <- function(s, ...) { if (getLogLevel() == C_LOG_LEVEL_TRACE) { .logBase(s, ..., logLevel = C_LOG_LEVEL_TRACE) } } .logDebug <- function(s, ...) { if (getLogLevel() %in% c(C_LOG_LEVEL_TRACE, C_LOG_LEVEL_DEBUG)) { .logBase(s, ..., logLevel = C_LOG_LEVEL_DEBUG) } } .logInfo <- function(s, ...) { if (getLogLevel() %in% c(C_LOG_LEVEL_TRACE, C_LOG_LEVEL_DEBUG, C_LOG_LEVEL_INFO)) { .logBase(s, ..., logLevel = C_LOG_LEVEL_INFO) } } .logWarn <- function(s, ...) { if (getLogLevel() %in% c(C_LOG_LEVEL_TRACE, C_LOG_LEVEL_DEBUG, C_LOG_LEVEL_INFO, C_LOG_LEVEL_WARN)) { .logBase(s, ..., logLevel = C_LOG_LEVEL_WARN) } } .logError <- function(s, ...) { if (getLogLevel() %in% c(C_LOG_LEVEL_TRACE, C_LOG_LEVEL_DEBUG, C_LOG_LEVEL_INFO, C_LOG_LEVEL_WARN, C_LOG_LEVEL_ERROR)) { .logBase(s, ..., logLevel = C_LOG_LEVEL_ERROR) } } .getRuntimeString <- function(startTime, ..., endTime = Sys.time(), runtimeUnits = c("secs", "auto"), addBrackets = FALSE) { runtimeUnits <- match.arg(runtimeUnits) if (runtimeUnits == "secs") { time <- as.numeric(difftime(endTime, startTime, units = "secs")) time <- round(time, ifelse(time < 1, 4, 2)) timeStr <- paste0(time, " secs") } else { timeStr <- format(difftime(endTime, startTime)) } if (addBrackets) { timeStr <- paste0("[", timeStr, "]") } return(timeStr) } .logProgress <- function(s, ..., startTime, runtimeUnits = c("secs", "auto")) { if (!(getLogLevel() %in% c(C_LOG_LEVEL_TRACE, C_LOG_LEVEL_DEBUG, C_LOG_LEVEL_INFO, C_LOG_LEVEL_WARN, C_LOG_LEVEL_ERROR, C_LOG_LEVEL_PROGRESS))) { return(invisible()) } timeStr <- .getRuntimeString(startTime, runtimeUnits = runtimeUnits, addBrackets = TRUE) if (length(list(...)) > 0) { cat(paste0("[", C_LOG_LEVEL_PROGRESS, "]"), sprintf(s, ...), timeStr, "\n") } else { cat(paste0("[", C_LOG_LEVEL_PROGRESS, "]"), s, timeStr, "\n") } } .setParameterType <- function(parameterSet, parameterName, parameterType) { if (is.null(parameterSet)) { return(invisible()) } parameterSet$.setParameterType(parameterName, parameterType) } .setValueAndParameterType <- function(parameterSet, parameterName, value, defaultValue, notApplicableIfNA = FALSE) { .assertIsParameterSetClass(parameterSet, "parameterSet") if (is.null(parameterSet)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterSet' must be not null") } if (!(parameterName %in% names(parameterSet$getRefClass()$fields()))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", class(parameterSet), "' does not contain a field with name '", parameterName, "'") } parameterSet[[parameterName]] <- value if (notApplicableIfNA && all(is.na(value))) { parameterSet$.setParameterType(parameterName, C_PARAM_NOT_APPLICABLE) } else if (!is.null(value) && length(value) == length(defaultValue) && ( (all(is.na(value)) && all(is.na(value) == is.na(defaultValue))) || (!is.na(all(value == defaultValue)) && all(value == defaultValue)) )) { parameterSet$.setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) } else { parameterSet$.setParameterType(parameterName, C_PARAM_USER_DEFINED) } } .isDefaultVector <- function(x, default) { if (length(x) != length(default)) { return(FALSE) } return(sum(x == default) == length(x)) } .getNumberOfZeroesDirectlyAfterDecimalSeparator <- function(x) { zeroCounter <- 0 startEnabled <- FALSE x <- round(x, 15) x <- sprintf("%.15f", x) for (i in 1:nchar(x)) { num <- substring(x, i, i) if (num == ".") { startEnabled <- TRUE } else if (startEnabled) { if (num == "0") { zeroCounter <- zeroCounter + 1 } else { return(zeroCounter) } } } return(zeroCounter) } .getNextHigherValue <- function(x) { .assertIsNumericVector(x, "x") values <- c() for (value in x) { value <- round(value, 15) values <- c(values, 1 / 10^.getNumberOfZeroesDirectlyAfterDecimalSeparator(value)) } return(values) } # cf. testthat::skip_on_cran() .skipTestIfDisabled <- function() { if (!isTRUE(.isCompleteUnitTestSetEnabled()) && base::requireNamespace("testthat", quietly = TRUE)) { testthat::skip("Test is disabled") } } .skipTestIfNotX64 <- function() { if (!.isMachine64Bit() && !.isMinimumRVersion4() && base::requireNamespace("testthat", quietly = TRUE)) { testthat::skip("The test is only intended for R version 4.x or 64-bit computers (x86-64)") } } .isMachine64Bit <- function() { return(Sys.info()[["machine"]] == "x86-64") } .isMinimumRVersion4 <- function() { return(R.Version()$major >= 4) } .getTestthatResultLine <- function(fileContent) { if (grepl("\\[ OK:", fileContent)) { indexStart <- regexpr("\\[ OK: \\d", fileContent)[[1]] indexEnd <- regexpr("FAILED: \\d{1,5} \\]", fileContent) indexEnd <- indexEnd[[1]] + attr(indexEnd, "match.length") - 1 resultPart <- substr(fileContent, indexStart, indexEnd) return(resultPart) } indexStart <- regexpr("\\[ FAIL \\d", fileContent)[[1]] if (indexStart == -1) { return("[ FAIL 0 | WARN 0 | SKIP 0 | PASS 14868 ]") } indexEnd <- regexpr("PASS \\d{1,5} \\]", fileContent) indexEnd <- indexEnd[[1]] + attr(indexEnd, "match.length") - 1 resultPart <- substr(fileContent, indexStart, indexEnd) return(resultPart) } .getTestthatResultNumberOfFailures <- function(fileContent) { if (grepl("FAILED:", fileContent)) { line <- .getTestthatResultLine(fileContent) index <- regexpr("FAILED: \\d{1,5} \\]", line) indexStart <- index[[1]] + 8 indexEnd <- index[[1]] + attr(index, "match.length") - 3 return(substr(line, indexStart, indexEnd)) } line <- .getTestthatResultLine(fileContent) index <- regexpr("FAIL \\d{1,5} ", line) indexStart <- index[[1]] + 5 indexEnd <- index[[1]] + attr(index, "match.length") - 2 return(substr(line, indexStart, indexEnd)) } .getTestthatResultNumberOfSkippedTests <- function(fileContent) { if (grepl("SKIPPED:", fileContent)) { line <- .getTestthatResultLine(fileContent) index <- regexpr("SKIPPED: \\d{1,5} {1,1}", line) indexStart <- index[[1]] + 9 indexEnd <- index[[1]] + attr(index, "match.length") - 2 return(substr(line, indexStart, indexEnd)) } line <- .getTestthatResultLine(fileContent) index <- regexpr("SKIP \\d{1,5} {1,1}", line) indexStart <- index[[1]] + 5 indexEnd <- index[[1]] + attr(index, "match.length") - 2 return(substr(line, indexStart, indexEnd)) } # testFileTargetDirectory <- "D:/R/_temp/test_debug" .downloadUnitTests <- function(testFileTargetDirectory, ..., token, secret, method = "auto", mode = "wb", cacheOK = TRUE, extra = getOption("download.file.extra"), cleanOldFiles = TRUE, connectionType = c("http", "ftp", "pkg")) { .assertIsSingleCharacter(testFileTargetDirectory, "testFileTargetDirectory") .assertIsSingleCharacter(token, "token") .assertIsSingleCharacter(secret, "secret") connectionType <- match.arg(connectionType) if (grepl("testthat(/|\\\\)?$", testFileTargetDirectory)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'testFileTargetDirectory' (", testFileTargetDirectory, ") must not end with 'testthat'") } if (cleanOldFiles) { unlink(testFileTargetDirectory, recursive = TRUE) } dir.create(testFileTargetDirectory, recursive = TRUE) testthatSubDirectory <- file.path(testFileTargetDirectory, "testthat") if (!dir.exists(testthatSubDirectory)) { dir.create(testthatSubDirectory, recursive = TRUE) } if (connectionType == "ftp") { suppressWarnings(.downloadUnitTestsViaFtp(testFileTargetDirectory = testFileTargetDirectory, testthatSubDirectory = testthatSubDirectory, token = token, secret = secret, method = method, mode = mode, cacheOK = cacheOK, extra = extra)) } else if (connectionType == "http") { suppressWarnings(.downloadUnitTestsViaHttp(testFileTargetDirectory = testFileTargetDirectory, testthatSubDirectory = testthatSubDirectory, token = token, secret = secret)) } else if (connectionType == "pkg") { .prepareUnitTestFiles(extra, testFileTargetDirectory, token, secret) } } .prepareUnitTestFiles <- function(packageSource, testFileTargetDirectory, token, secret) { if (is.null(packageSource)) { return(invisible()) } .assertIsValidCipher("token", token) .assertIsValidCipher("secret", secret) .assertIsSingleCharacter(packageSource, "packageSource") if (!file.exists(packageSource)) { warning(sQuote("packageSource"), " (", packageSource, ") does not exist") } if (!grepl("\\.tar\\.gz$", packageSource)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "file ", sQuote(packageSource), " must have a .tar.gz extension") } unlinkFile <- FALSE if (grepl("^http", packageSource)) { tempFile <- tempfile(fileext = ".tar.gz") if (utils::download.file(packageSource, tempFile) != 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(packageSource), " seems to be an invalid URL") } packageSource <- tempFile unlinkFile <- TRUE } testthatTempDirectory <- NULL tryCatch({ contentLines <- utils::untar(packageSource, list = TRUE) if (!("rpact/DESCRIPTION" %in% contentLines) || !("rpact/tests/testthat/" %in% contentLines)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "file ", sQuote(packageSource), " is not an rpact package source file") } testthatTempDirectory <- file.path(testFileTargetDirectory, "temp") utils::untar(packageSource, files = c("rpact/tests/testthat.R", "rpact/tests/testthat/"), exdir = testthatTempDirectory) testthatTempSubDirectory <- file.path(testthatTempDirectory, "rpact", "tests") testFiles <- list.files(testthatTempSubDirectory, pattern = "\\.R$", recursive = TRUE) for (testFile in testFiles) { file.copy(file.path(testthatTempSubDirectory, testFile), file.path(testFileTargetDirectory, testFile)) } message(length(testFiles), " extracted from ", sQuote(packageSource), " and copied to ", sQuote(testFileTargetDirectory)) }, finally = { if (!is.null(testthatTempDirectory)) { unlink(testthatTempDirectory, recursive = TRUE) } if (unlinkFile) { unlink(packageSource) } }) } .downloadUnitTestsViaHttp <- function(testFileTargetDirectory, ..., testthatSubDirectory, token, secret) { indexFile <- file.path(testFileTargetDirectory, "index.html") tryCatch({ version <- utils::packageVersion("rpact") baseUrl <- paste0("http://", token, ":", secret, "@unit.tests.rpact.com/", version, "/tests/") if (!dir.exists(testFileTargetDirectory)) { dir.create(testFileTargetDirectory) } if (!dir.exists(testthatSubDirectory)) { dir.create(testthatSubDirectory) } testthatBaseFile <- system.file("tests", "testthat.R", package = "rpact") if (file.exists(testthatBaseFile)) { file.copy(testthatBaseFile, file.path(testFileTargetDirectory, "testthat.R")) } else { result <- download.file( url = paste0(baseUrl, "testthat.R"), destfile = file.path(testFileTargetDirectory, "testthat.R")) if (result != 0) { warning("'testthat.R' download result in ", result) } } result <- download.file( url = paste0(baseUrl, "testthat/index.txt"), destfile = indexFile, quiet = TRUE) if (result != 0) { warning("Unit test index file download result in ", result) } lines <- .readLinesFromFile(indexFile) lines <- lines[grepl("\\.R", lines)] testFiles <- gsub("\\.R<.*", ".R", lines) testFiles <- gsub(".*>", "", testFiles) testFiles <- gsub(" *$", "", testFiles) if (length(testFiles) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "online source does not contain any unit test files") } startTime <- Sys.time() message("Start to download ", length(testFiles), " unit test files (http). Please wait...") for (testFile in testFiles) { result <- download.file(url = paste0(baseUrl, "testthat/", testFile), destfile = file.path(testthatSubDirectory, testFile), quiet = TRUE) } message(length(testFiles), " unit test files downloaded successfully (needed ", .getRuntimeString(startTime, runtimeUnits = "secs"), ")") }, error = function(e) { .logDebug(e$message) stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to download unit test files (http): illegal 'token' / 'secret' or rpact version ", version, " unknown") }, finally = { if (file.exists(indexFile)) { tryCatch({ file.remove(indexFile) }, error = function(e) { warning("Failed to remove unit test index file: ", e$message, call. = FALSE) }) } }) } .downloadUnitTestsViaFtp <- function(testFileTargetDirectory, ..., testthatSubDirectory, token, secret, method = "auto", mode = "wb", cacheOK = TRUE, extra = getOption("download.file.extra")) { indexFile <- file.path(testFileTargetDirectory, "index.html") tryCatch({ version <- utils::packageVersion("rpact") baseUrl <- paste0("ftp://", token, ":", secret, "@ftp.rpact.com/", version, "/tests/") testthatBaseFile <- system.file("tests", "testthat.R", package = "rpact") if (file.exists(testthatBaseFile)) { file.copy(testthatBaseFile, file.path(testFileTargetDirectory, "testthat.R")) } else { result <- download.file( url = paste0(baseUrl, "testthat.R"), destfile = file.path(testFileTargetDirectory, "testthat.R"), method = method, quiet = TRUE, mode = mode, cacheOK = cacheOK, extra = extra, headers = NULL) if (result != 0) { warning("'testthat.R' download result in ", result) } } result <- download.file( url = paste0(baseUrl, "testthat/"), destfile = indexFile, method = method, quiet = TRUE, mode = mode, cacheOK = cacheOK, extra = extra, headers = NULL) if (result != 0) { warning("Unit test index file download result in ", result) } lines <- .readLinesFromFile(indexFile) lines <- lines[grepl("\\.R", lines)] testFiles <- gsub("\\.R<.*", ".R", lines) testFiles <- gsub(".*>", "", testFiles) if (length(testFiles) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "online source does not contain any unit test files") } startTime <- Sys.time() message("Start to download ", length(testFiles), " unit test files (ftp). Please wait...") for (testFile in testFiles) { result <- download.file(url = paste0(baseUrl, "testthat/", testFile), destfile = file.path(testthatSubDirectory, testFile), method = method, quiet = TRUE, mode = mode, cacheOK = cacheOK, extra = extra, headers = NULL) } message(length(testFiles), " unit test files downloaded successfully (needed ", .getRuntimeString(startTime, runtimeUnits = "secs"), ")") }, error = function(e) { .logDebug(e$message) stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to download unit test files (ftp): illegal 'token' / 'secret' or rpact version ", version, " unknown") }, finally = { if (file.exists(indexFile)) { tryCatch({ file.remove(indexFile) }, error = function(e) { warning("Failed to remove unit test index file: ", e$message, call. = FALSE) }) } }) } .getConnectionArgument <- function(connection, name = c("token", "secret", "method", "mode", "cacheEnabled", "extra", "cleanOldFiles", "connectionType")) { if (is.null(connection) || !is.list(connection)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'connection' must be a list (is ", class(connection), ")") } name <- match.arg(name) defaultValues <- list( "token" = NULL, "secret" = NULL, "method" = "auto", "mode" = "wb", "cacheEnabled" = TRUE, "extra" = getOption("download.file.extra"), "cleanOldFiles" = TRUE, "connectionType" = "http" ) value <- connection[[name]] if (is.null(value)) { return(defaultValues[[name]]) } return(value) } #' @title #' Test Package # #' @description #' This function allows the installed package \code{rpact} to be tested. #' #' @param outDir The output directory where all test results shall be saved. #' By default the current working directory is used. #' @param completeUnitTestSetEnabled If \code{TRUE} (default) all existing unit tests will #' be executed; a subset of all unit tests will be used otherwise. #' @param types The type(s) of tests to be done. Can be one or more of #' \code{c("tests", "examples", "vignettes")}, default is "tests" only. #' @param connection A \code{list} where owners of the rpact validation documentation #' can enter a \code{token} and a \code{secret} to get full access to all unit tests, e.g., #' to fulfill regulatory requirements (see \href{https://www.rpact.com}{www.rpact.com} for more information). #' @inheritParams param_three_dots #' #' @details #' This function creates the subdirectory \code{rpact-tests} in the specified output directory #' and copies all unit test files of the package to this newly created directory. #' Then the function runs all tests (or a subset of all tests if #' \code{completeUnitTestSetEnabled} is \code{FALSE}) using #' \code{\link[tools]{testInstalledPackage}}. #' The test results will be saved to the text file \code{testthat.Rout} that can be found #' in the subdirectory \code{rpact-tests}. #' #' @return The value of \code{completeUnitTestSetEnabled} will be returned invisible. #' #' @examples #' \dontrun{ #' testPackage() #' } #' #' @export #' testPackage <- function(outDir = ".", ..., completeUnitTestSetEnabled = TRUE, types = "tests", connection = list(token = NULL, secret = NULL)) { .assertTestthatIsInstalled() .assertMnormtIsInstalled() if (!dir.exists(outDir)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "test output directory '", outDir, "' does not exist") } startTime <- Sys.time() Sys.setenv("LANGUAGE" = "EN") on.exit(Sys.unsetenv("LANGUAGE")) temp <- .isCompleteUnitTestSetEnabled() on.exit(Sys.setenv("RPACT_COMPLETE_UNIT_TEST_SET_ENABLED" = temp), add = TRUE) Sys.setenv("RPACT_COMPLETE_UNIT_TEST_SET_ENABLED" = completeUnitTestSetEnabled) debug <- .getOptionalArgument("debug", ...) if (!is.null(debug) && length(debug) == 1 && isTRUE(as.logical(debug))) { setLogLevel(C_LOG_LEVEL_DEBUG) } else { setLogLevel(C_LOG_LEVEL_DISABLED) } on.exit(resetLogLevel(), add = TRUE) token <- .getConnectionArgument(connection, "token") secret <- .getConnectionArgument(connection, "secret") fullTestEnabled <- (!is.null(token) && !is.null(secret) && length(token) == 1 && length(secret) == 1 && !is.na(token) && !is.na(secret)) if (completeUnitTestSetEnabled && fullTestEnabled) { cat("Run all tests. Please wait...\n") cat("Have a break - it takes about 25 to 30 minutes.\n") cat("Exceution of all available unit tests startet at ", format(startTime, "%H:%M (%d-%B-%Y)"), "\n", sep = "") } else if (!fullTestEnabled) { cat("Run a small subset of all tests. Please wait...\n") cat("This is just a quick test (see comments below).\n") cat("The entire test will take only some seconds.\n") } else { cat("Run a subset of all tests. Please wait...\n") cat("This is just a quick test, i.e., all time consuming tests will be skipped.\n") cat("The entire test will take about a minute.\n") } if (outDir == ".") { outDir <- getwd() } oldResultFiles <- c( file.path(outDir, "rpact-tests", "testthat.Rout"), file.path(outDir, "rpact-tests", "testthat.Rout.fail")) for (oldResultFile in oldResultFiles) { if (file.exists(oldResultFile)) { file.remove(oldResultFile) } } pkgName <- "rpact" if (!fullTestEnabled) { tools::testInstalledPackage(pkg = pkgName, outDir = outDir, types = types) } else { testFileTargetDirectory <- file.path(outDir, paste0(pkgName, "-tests")) .downloadUnitTests( testFileTargetDirectory = testFileTargetDirectory, token = token, secret = secret, method = .getConnectionArgument(connection, "method"), mode = .getConnectionArgument(connection, "mode"), cacheOK = .getConnectionArgument(connection, "cacheEnabled"), extra = .getConnectionArgument(connection, "extra"), cleanOldFiles = .getConnectionArgument(connection, "cleanOldFiles"), connectionType = .getConnectionArgument(connection, "connectionType") ) .testInstalledPackage(testFileDirectory = testFileTargetDirectory, pkgName = pkgName, outDir = testFileTargetDirectory, Ropts = "") } outDir <- file.path(outDir, paste0(pkgName, "-tests")) endTime <- Sys.time() if (completeUnitTestSetEnabled) { cat("Test exceution ended at ", format(endTime, "%H:%M (%d-%B-%Y)"), "\n", sep = "") } cat("Total runtime for testing: ", .getRuntimeString(startTime, endTime = endTime, runtimeUnits = "auto"), ".\n", sep = "") inputFileName <- file.path(outDir, "testthat.Rout") if (file.exists(inputFileName)) { fileContent <- base::readChar(inputFileName, file.info(inputFileName)$size) if (completeUnitTestSetEnabled && fullTestEnabled) { cat("All unit tests were completed successfully, i.e., the installation \n", "qualification was successful.\n", sep = "") } else { cat("Unit tests were completed successfully.\n", sep = "") } cat("Results:\n") cat(.getTestthatResultLine(fileContent), "\n") cat("\n") cat("Test results were written to directory \n", "'", outDir, "' (see file 'testthat.Rout')\n", sep = "") skipped <- .getTestthatResultNumberOfSkippedTests(fileContent) if (skipped > 0) { cat("-------------------------------------------------------------------------\n") cat("Note that ", skipped, " tests were skipped; ", "a possible reason may be that expected \n", "error messages could not be tested ", "because of local translation.\n", sep = "") } cat("-------------------------------------------------------------------------\n") cat("Please visit www.rpact.com to learn how to use rpact on FDA/GxP-compliant \n", "validated corporate computer systems and how to get a copy of the formal \n", "validation documentation that is customized and licensed for exclusive use \n", "by your company/organization, e.g., to fulfill regulatory requirements.\n", sep = "") } else { inputFileName <- file.path(outDir, "testthat.Rout.fail") if (file.exists(inputFileName)) { fileContent <- base::readChar(inputFileName, file.info(inputFileName)$size) if (completeUnitTestSetEnabled) { cat(.getTestthatResultNumberOfFailures(fileContent), " unit tests failed, i.e., the installation qualification was not successful.\n", sep = "") } else { cat(.getTestthatResultNumberOfFailures(fileContent), " unit tests failed :(\n", sep = "") } cat("Results:\n") cat(.getTestthatResultLine(fileContent), "\n") cat("Test results were written to directory '", outDir, "' (see file 'testthat.Rout.fail')\n", sep = "") } } if (!fullTestEnabled) { cat("-------------------------------------------------------------------------\n") cat("Note that only a small subset of all available unit tests were executed.\n") cat("You need a personal 'token' and 'secret' to perform all unit tests.\n") cat("You can find these data in the appendix of the validation documentation \n") cat("licensed for your company/organization.\n") } else if (!completeUnitTestSetEnabled) { cat("Note that only a small subset of all available unit tests were executed.\n") cat("Use testPackage(completeUnitTestSetEnabled = TRUE) to perform all unit tests.\n") } invisible(.isCompleteUnitTestSetEnabled()) } .testInstalledPackage <- function(testFileDirectory, ..., pkgName = "rpact", outDir = ".", Ropts = "") { if (!dir.exists(testFileDirectory)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'testFileDirectory' (", testFileDirectory, ") does not exist") } workingDirectoryBefore <- setwd(outDir) on.exit(setwd(workingDirectoryBefore)) setwd(testFileDirectory) message(gettextf("Running specific tests for package %s", sQuote(pkgName)), domain = NA) testFiles <- dir(".", pattern="\\.R$") for (testFile in testFiles) { message(gettextf(" Running %s", sQuote(testFile)), domain = NA) outfile <- paste0(testFile, "out") cmd <- paste(shQuote(file.path(R.home("bin"), "R")), "CMD BATCH --vanilla --no-timing", Ropts, shQuote(testFile), shQuote(outfile)) cmd <- if (.Platform$OS.type == "windows") paste(cmd, "LANGUAGE=C") else paste("LANGUAGE=C", cmd) res <- system(cmd) if (res) { file.rename(outfile, paste(outfile, "fail", sep = ".")) return(invisible(1L)) } savefile <- paste(outfile, "save", sep = "." ) if (file.exists(savefile)) { message(gettextf(" comparing %s to %s ...", sQuote(outfile), sQuote(savefile)), appendLF = FALSE, domain = NA) res <- Rdiff(outfile, savefile) if (!res) message(" OK") } } setwd(workingDirectoryBefore) return(invisible(0L)) } .isCompleteUnitTestSetEnabled <- function() { completeUnitTestSetEnabled <- as.logical(Sys.getenv("RPACT_COMPLETE_UNIT_TEST_SET_ENABLED")) if (is.na(completeUnitTestSetEnabled)) { completeUnitTestSetEnabled <- FALSE Sys.setenv("RPACT_COMPLETE_UNIT_TEST_SET_ENABLED" = completeUnitTestSetEnabled) } return(isTRUE(completeUnitTestSetEnabled)) } .getVariedParameterVectorByValue <- function(variedParameter) { return((variedParameter[2] - variedParameter[1]) / C_VARIED_PARAMETER_SEQUENCE_LENGTH_DEFAULT) } .getVariedParameterVector <- function(variedParameter, variedParameterName) { if (is.null(variedParameter) || length(variedParameter) != 2 || any(is.na(variedParameter))) { return(variedParameter) } minValue <- variedParameter[1] maxValue <- variedParameter[2] if (minValue == maxValue) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", variedParameterName, "' with length 2 must contain minimum != maximum (", minValue, " == ", maxValue , ")") } by <- .getVariedParameterVectorByValue(variedParameter) variedParameter <- seq(minValue, maxValue, by) return(variedParameter) } .getVariedParameterVectorSeqCommand <- function(variedParameter) { return(paste0("seq(", round(variedParameter[1], 4), ", ", round(variedParameter[2], 4), ", ", round(.getVariedParameterVectorByValue(variedParameter), 6),")")) } .getNumberOfSubjects1 <- function(numberOfSubjects, allocationRatioPlanned) { return((numberOfSubjects * allocationRatioPlanned) / (allocationRatioPlanned + 1)) } .getNumberOfSubjects2 <- function(numberOfSubjects, allocationRatioPlanned) { return(numberOfSubjects / (allocationRatioPlanned + 1)) } .fillWithNAs <- function(x, kMax) { if (length(x) >= kMax) { return(x) } x[(length(x) + 1):kMax] <- NA_real_ return(x) } .matchArgument <- function(arg, defaultValue) { if (any(is.na(arg))) { return(defaultValue) } return(ifelse(length(arg) > 0, arg[1], defaultValue)) } #' @title #' Print Citation # #' @description #' How to cite \code{rpact} and \code{R} in publications. #' #' @param inclusiveR If \code{TRUE} (default) the information on how to cite the base R system in publications will be added. #' #' @details #' This function shows how to cite \code{rpact} and \code{R} (\code{inclusiveR = TRUE}) in publications. #' #' @examples #' printCitation() #' #' @keywords internal #' #' @export #' printCitation <- function(inclusiveR = TRUE) { if (inclusiveR) { citR <- capture.output(print(citation("base"), bibtex = FALSE)) indices <- which(citR == "") indices <- indices[indices != 1 & indices != length(citR)] if (length(indices) > 1) { index <- indices[length(indices)] citR <- citR[1:min(index, length(citR))] } cat("\n", trimws(paste(citR, collapse = "\n")), "\n", sep = "") } print(citation("rpact"), bibtex = FALSE) } .writeLinesToFile <- function(lines, fileName) { if (is.null(lines) || length(lines) == 0 || !is.character(lines)) { warning("Empty lines. Stop to write '", fileName, "'") return(invisible(fileName)) } fileConn <- base::file(fileName) tryCatch({ base::writeLines(lines, fileConn) }, finally = { base::close(fileConn) }) invisible(fileName) } .readLinesFromFile <- function(inputFileName) { content <- .readContentFromFile(inputFileName) # Windows: CR (Carriage Return \r) and LF (LineFeed \n) pair # OSX, Linux: LF (LineFeed \n) return(strsplit(content, split = "(\r?\n)|(\r\n?)")[[1]]) } .readContentFromFile <- function(inputFileName) { return(readChar(inputFileName, file.info(inputFileName)$size)) } .integerToWrittenNumber <- function(x) { if (is.null(x) || length(x) != 1 || !is.numeric(x) || is.na(x)) { return(x) } temp <- c('one', 'two', 'three', 'four', 'five', 'six', 'seven', 'eight', 'nine') if (x >= 1 && x <= length(temp) && as.integer(x) == x) { return(temp[x]) } return(as.character(x)) } .isNullFunction <- function(fun) { if (is.null(fun)) { return(TRUE) } if (!is.function(fun)) { return(FALSE) } s <- capture.output(print(fun)) if (length(s) != 3) { return(FALSE) } return(s[2] == "NULL") } .getFunctionAsString <- function(fun, stringWrapPrefix = " ", stringWrapParagraphWidth = 90) { .assertIsFunction(fun) s <- capture.output(print(fun)) s <- s[!grepl("bytecode", s)] s <- s[!grepl("environment", s)] if (is.null(stringWrapPrefix) || is.na(stringWrapPrefix) || nchar(stringWrapPrefix) == 0) { stringWrapPrefix <- " " } s <- gsub("\u0009", stringWrapPrefix, s) # \t if (!is.null(stringWrapParagraphWidth) && !is.na(stringWrapParagraphWidth)) { #s <- paste0(s, collapse = "\n") } return(s) } .getFunctionArgumentNames <- function(fun, ignoreThreeDots = FALSE) { .assertIsFunction(fun) args <- methods::formalArgs(fun) if (ignoreThreeDots) { args <- args[args != "..."] } return(args) } .getNumberOfZeroesAfterDecimalPoint <- function(values) { if (is.null(values) || length(values) == 0) { return(integer(0)) } values[is.na(values)] <- 0 number <- c() for (value in values) { s1 <- sub("^\\d+\\.", "", sub("0*$", "", format(round(value, 15), scientific = FALSE))) s2 <- sub("^0*", "", s1) number <- c(number, nchar(s1) - nchar(s2)) } return(number) } .getDecimalPlaces <- function(values) { if (is.null(values) || length(values) == 0) { return(integer(0)) } values[is.na(values)] <- 0 decimalPlaces <- c() for (value in values) { decimalPlaces <- c(decimalPlaces, nchar(sub("^\\d+\\.", "", sub("0*$", "", format(round(value, 15), scientific = FALSE))))) } return(decimalPlaces) } #' #' @title #' Get Parameter Caption #' #' @description #' Returns the parameter caption for a given object and parameter name. #' #' @details #' This function identifies and returns the caption that will be used in print outputs of an rpact result object. #' #' @seealso #' \code{\link{getParameterName}} for getting the parameter name for a given caption. #' #' @return Returns a \code{\link[base]{character}} of specifying the corresponding caption of a given parameter name. #' Returns \code{NULL} if the specified \code{parameterName} does not exist. #' #' @examples #' getParameterCaption(getDesignInverseNormal(), "kMax") #' #' @keywords internal #' #' @export #' getParameterCaption <- function(obj, parameterName) { if (is.null(obj) || length(obj) != 1 || !isS4(obj) || !inherits(obj, "FieldSet")) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'obj' (", class(obj), ") must be an rpact result object") } .assertIsSingleCharacter(parameterName, "parameterName", naAllowed = FALSE) design <- NULL designPlan <- NULL if (inherits(obj, "TrialDesignPlan")) { designPlan <- obj design <- obj$.design } else if (inherits(obj, "TrialDesign")) { design <- obj } else { design <- obj[[".design"]] } parameterNames <- .getParameterNames(design = design, designPlan = designPlan) if (is.null(parameterNames) || length(parameterNames) == 0) { return(NULL) } return(parameterNames[[parameterName]]) } #' #' @title #' Get Parameter Name #' #' @description #' Returns the parameter name for a given object and parameter caption. #' #' @details #' This function identifies and returns the parameter name for a given caption #' that will be used in print outputs of an rpact result object. #' #' @seealso #' \code{\link{getParameterCaption}} for getting the parameter caption for a given name. #' #' @return Returns a \code{\link[base]{character}} of specifying the corresponding name of a given parameter caption. #' Returns \code{NULL} if the specified \code{parameterCaption} does not exist. #' #' @examples #' getParameterName(getDesignInverseNormal(), "Maximum number of stages") #' #' @keywords internal #' #' @export #' getParameterName <- function(obj, parameterCaption) { if (is.null(obj) || length(obj) != 1 || !isS4(obj) || !inherits(obj, "FieldSet")) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'obj' (", class(obj), ") must be an rpact result object") } .assertIsSingleCharacter(parameterCaption, "parameterCaption", naAllowed = FALSE) design <- NULL designPlan <- NULL if (inherits(obj, "TrialDesignPlan")) { designPlan <- obj design <- obj$.design } else if (inherits(obj, "TrialDesign")) { design <- obj } else { design <- obj[[".design"]] } parameterNames <- .getParameterNames(design = design, designPlan = designPlan) if (is.null(parameterNames) || length(parameterNames) == 0) { return(NULL) } return(unique(names(parameterNames)[parameterNames == parameterCaption])) } .removeLastEntryFromArray <- function(x) { if (!is.array(x)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'x' (", class(x), ") must be an array") } dataDim <- dim(x) if (length(dataDim) != 3) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "function .removeLastEntryFromArray() only works for 3-dimensional arrays") } if (dataDim[3] < 2) { return(NA_real_) } dataDim[3] <- dataDim[3] - 1 subData <- x[, , 1:dataDim[3]] return(array(data = subData, dim = dataDim)) } .moveColumn <- function(data, columnName, insertPositionColumnName) { if (!is.data.frame(data)) { stop("Illegal argument: 'data' (", class(data), ") must be a data.frame") } if (is.null(insertPositionColumnName) || length(insertPositionColumnName) != 1 || is.na(insertPositionColumnName) || !is.character(insertPositionColumnName)) { stop("Illegal argument: 'insertPositionColumnName' (", class(insertPositionColumnName), ") must be a valid character value") } if (is.null(columnName) || length(columnName) != 1 || is.na(columnName) || !is.character(columnName)) { stop("Illegal argument: 'columnName' (", class(columnName), ") must be a valid character value") } colNames <- colnames(data) if (!(columnName %in% colNames)) { stop("Illegal argument: 'columnName' (", columnName, ") does not exist in the specified data.frame 'data'") } if (!(insertPositionColumnName %in% colNames)) { stop("Illegal argument: 'insertPositionColumnName' (", insertPositionColumnName, ") does not exist in the specified data.frame 'data'") } if (columnName == insertPositionColumnName) { return(data) } colNames <- colNames[colNames != columnName] insertPositioIndex <- which(colNames == insertPositionColumnName) if (insertPositioIndex != (which(colnames(data) == columnName) - 1)) { if (insertPositioIndex == length(colNames)) { data <- data[, c(colNames[1:insertPositioIndex], columnName)] } else { data <- data[, c(colNames[1:insertPositioIndex], columnName, colNames[(insertPositioIndex + 1):length(colNames)])] } } return(data) } # Example: # or1 <- list( # and1 = FALSE, # and2 = TRUE, # and3 = list( # or1 = list( # and1 = TRUE, # and2 = TRUE # ), # or2 = list( # and1 = TRUE, # and2 = TRUE, # and3 = TRUE # ), # or3 = list( # and1 = TRUE, # and2 = TRUE, # and3 = TRUE, # and4 = TRUE, # and5 = TRUE # ) # ) # ) .isConditionTrue <- function(x, condType = c("and", "or"), xName = NA_character_, level = 0, showDebugMessages = FALSE) { if (is.logical(x)) { #message("logical: ", x) if (showDebugMessages) { message(rep("\t", level), x, "") } return(x) } condType <- match.arg(condType) if (is.list(x)) { listNames <- names(x) #message("listNames: ", .arrayToString(listNames)) if (is.null(listNames) || any(is.na(listNames)) || any(trimws(listNames) == "")) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "list (", .arrayToString(unlist(x)), ") must be named") } results <- logical(0) for (listName in listNames) { type <- gsub("\\d*", "", listName) if (!(type %in% c("and", "or"))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "all list names (", type, " / ", listName, ") must have the format 'and[number]' or 'or[number]', where [number] is an integer") } subList <- x[[listName]] #message(xName, ": ", .arrayToString(names(subList)), " (", class(subList), ")") result <- .isConditionTrue(subList, condType = type, xName = listName, level = level + 1, showDebugMessages = showDebugMessages) results <- c(results, result) } if (condType == "and") { result <- all(results == TRUE) if (showDebugMessages) { message(rep("\t", level), result, " (before: and)") } return(result) } result <- any(results == TRUE) if (showDebugMessages) { message(rep("\t", level), result, " (before: or)") } return(result) } stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "x must be of type logical or list (is ", class(x)) } .getAgrumentSpecificFormattedValue <- function(value) { if (is.character(value)) { value <- paste0("\"", value, "\"") value[value == "\"NA\""] <- NA_character_ value[is.na(value)] <- "\"NA\"" return(value) } else if (is.integer(value)) { value[is.na(value)] <- "NA_integer_" } else if (is.numeric(value)) { value[!is.na(value)] <- format(value[!is.na(value)], digits = 8) value[is.na(value)] <- "NA_real_" } else if (is.complex(value)) { value[is.na(value)] <- "NA_complex_" } return(value) } .getArgumentValueRCode <- function(x, name) { if (is.null(x)) { return("NULL") } if (length(x) == 0) { if (is.list(x)) { return("list()") } else if (is.character(x)) { return("character(0)") } else if (is.integer(x)) { return("integer(0)") } else if (is.numeric(x)) { return("numeric(0)") } else if (is.complex(x)) { return("complex(0)") } } if (is.function(x) || isS4(x)) { return("NULL") # function(...) } if (length(x) == 1 && is.na(x)) { if (is.character(x)) { return("NA_character_") } else if (is.integer(x)) { return("NA_integer_") } else if (is.numeric(x)) { return("NA_real_") } else if (is.complex(x)) { return("NA_complex_") } return("NA") } if (is.list(x)) { params <- c() for (paramName in names(x)) { paramValue <- x[[paramName]] params <- c(params, paste0(paramName, " = ", .getArgumentValueRCode(x = paramValue, name = paramName))) } return(paste0("list(", paste0(params, collapse = ", "), ")")) } leadingZeroAdded <- FALSE expectedResult <- "" if (name == "accrualTime" && length(x) > 0 && !is.na(x[1]) && x[1] != 0) { expectedResult <- "0" leadingZeroAdded <- TRUE } else if (name == "followUpTime" && length(x) == 1 && !is.na(x)) { x <- round(x, 3) } else if (name == "maxNumberOfSubjects" && length(x) == 1 && !is.na(x)) { x <- floor(x * 100) / 100 } if (is.matrix(x) && name == "effectMatrix") { x <- t(x) } for (i in 1:length(x)) { if (nchar(expectedResult) > 0) { expectedResult <- paste0(expectedResult, ", ") } expectedResult <- paste0(expectedResult, .getAgrumentSpecificFormattedValue(x[i])) } if (leadingZeroAdded || length(x) > 1) { expectedResult <- paste0("c(", expectedResult, ")") } if (is.matrix(x) && grepl("effectMatrix|effects|piTreatments|hazardRatios", name)) { expectedResult <- paste0("matrix(", expectedResult, ", ncol = ", ncol(x), ")") } return(expectedResult) } .addDesignToObjectRCode <- function(obj, leadingArguments, precondition, stringWrapParagraphWidth) { if (is.null(leadingArguments) || !any(grepl("design", leadingArguments))) { precondition <- c(precondition, getObjectRCode(obj$.design, prefix = "design <- ", stringWrapParagraphWidth = stringWrapParagraphWidth)) leadingArguments <- c(leadingArguments, "design = design") } return(precondition = precondition, leadingArguments = leadingArguments) } #' @rdname getObjectRCode #' @export rcmd <- function(obj, ..., leadingArguments = NULL, includeDefaultParameters = FALSE, stringWrapParagraphWidth = 90, prefix = "", postfix = "", stringWrapPrefix = "", newArgumentValues = list()) { getObjectRCode(obj = obj, leadingArguments = leadingArguments, includeDefaultParameters = includeDefaultParameters, stringWrapParagraphWidth = stringWrapParagraphWidth, prefix = prefix, postfix = postfix, stringWrapPrefix = stringWrapPrefix, newArgumentValues = newArgumentValues) } #' #' @title #' Get Object R Code #' #' @description #' Returns the R source command of a result object. #' #' @param obj The result object. #' @param leadingArguments A character vector with arguments that shall be inserted at the beginning of the function command, #' e.g., \code{design = x}. Be careful with this option because the created R command may no longer be valid if used. #' @param includeDefaultParameters If \code{TRUE}, default parameters will be included in all \code{rpact} commands; #' default is \code{FALSE}. #' @param stringWrapParagraphWidth An integer value defining the number of characters after which a line break shall be inserted; #' set to \code{NULL} to insert no line breaks. #' @param prefix A character string that shall be added to the beginning of the R command. #' @param postfix A character string that shall be added to the end of the R command. #' @param stringWrapPrefix A prefix character string that shall be added to each new line, typically some spaces. #' @param newArgumentValues A named list with arguments that shall be renewed in the R command, e.g., #' \code{newArgumentValues = list(informationRates = c(0.5, 1))}. #' @inheritParams param_three_dots #' #' @details #' \code{\link{getObjectRCode}} (short: \code{\link{rcmd}}) recreates #' the R commands that result in the specified object \code{obj}. #' \code{obj} must be an instance of class \code{ParameterSet}. #' #' @return A \code{\link[base]{character}} value or vector will be returned. #' #' @export #' getObjectRCode <- function(obj, ..., leadingArguments = NULL, includeDefaultParameters = FALSE, stringWrapParagraphWidth = 90, prefix = "", postfix = "", stringWrapPrefix = "", newArgumentValues = list()) { functionName <- deparse(substitute(obj)) functionName <- sub("\\(.*\\)$", "", functionName) if (!is.null(obj) && is.function(obj)) { lines <- .getFunctionAsString(obj, stringWrapPrefix = stringWrapPrefix, stringWrapParagraphWidth = stringWrapParagraphWidth) if (length(lines) == 0) { return("") } lines[1] <- paste0(prefix, lines[1]) if (postfix != "") { lines <- c(lines, postfix) } return(lines) } .assertIsParameterSetClass(obj, "ParameterSet") if (!is.list(newArgumentValues)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'newArgumentValues' must be a named list ", "(is ", class(newArgumentValues), ")") } precondition <- character(0) if (is.null(leadingArguments)) { leadingArguments <- character(0) } if (!inherits(obj, "ConditionalPowerResults") && !is.null(obj[[".design"]]) && (is.null(leadingArguments) || !any(grepl("design", leadingArguments)))) { preconditionDesign <- getObjectRCode(obj$.design, prefix = "design <- ", includeDefaultParameters = includeDefaultParameters, stringWrapParagraphWidth = stringWrapParagraphWidth, newArgumentValues = newArgumentValues) if (paste0(preconditionDesign, collapse = " ") != "design <- getDesignGroupSequential(kMax = 1)") { precondition <- c(precondition, preconditionDesign) leadingArguments <- c(leadingArguments, "design = design") } } if (!is.null(obj[[".dataInput"]]) && (is.null(leadingArguments) || !any(grepl("data", leadingArguments)))) { precondition <- c(precondition, getObjectRCode(obj$.dataInput, prefix = "data <- ", includeDefaultParameters = includeDefaultParameters, stringWrapParagraphWidth = stringWrapParagraphWidth, newArgumentValues = newArgumentValues)) leadingArguments <- c(leadingArguments, "dataInput = data") } if (!is.null(obj[["calcSubjectsFunction"]]) && (is.null(leadingArguments) || !any(grepl("calcSubjectsFunction", leadingArguments))) && obj$.getParameterType("calcSubjectsFunction") == C_PARAM_USER_DEFINED) { precondition <- c(precondition, getObjectRCode(obj$calcSubjectsFunction, prefix = "calcSubjectsFunction <- ", includeDefaultParameters = includeDefaultParameters, stringWrapParagraphWidth = stringWrapParagraphWidth, newArgumentValues = newArgumentValues)) } if (!is.null(obj[["calcEventsFunction"]]) && (is.null(leadingArguments) || !any(grepl("calcEventsFunction", leadingArguments))) && obj$.getParameterType("calcEventsFunction") == C_PARAM_USER_DEFINED) { precondition <- c(precondition, getObjectRCode(obj$calcEventsFunction, prefix = "calcEventsFunction <- ", includeDefaultParameters = includeDefaultParameters, stringWrapParagraphWidth = stringWrapParagraphWidth, newArgumentValues = newArgumentValues)) } if (!is.null(obj[["selectArmsFunction"]]) && (is.null(leadingArguments) || !any(grepl("selectArmsFunction", leadingArguments))) && !is.null(obj[["typeOfSelection"]]) && obj$typeOfSelection == "userDefined") { precondition <- c(precondition, getObjectRCode(obj$selectArmsFunction, prefix = "selectArmsFunction <- ", includeDefaultParameters = includeDefaultParameters,, stringWrapParagraphWidth = stringWrapParagraphWidth, newArgumentValues = newArgumentValues)) leadingArguments <- c(leadingArguments, "selectArmsFunction = selectArmsFunction") } if (inherits(obj, "ConditionalPowerResults") && !is.null(obj[[".stageResults"]]) && (is.null(leadingArguments) || !any(grepl("stageResults", leadingArguments)))) { precondition <- c(precondition, getObjectRCode(obj$.stageResults, prefix = "stageResults <- ", includeDefaultParameters = includeDefaultParameters, stringWrapParagraphWidth = stringWrapParagraphWidth, newArgumentValues = newArgumentValues)) leadingArguments <- c(leadingArguments, "stageResults = stageResults") } if (grepl("SimulationResultsEnrichment(Means|Rates|Survival)", class(obj))) { precondition <- c(precondition, paste0("effectList <- ", .getArgumentValueRCode(obj$effectList, "effectList"))) } if ("TrialDesignPlanMeans" == class(obj)) { if (obj$.isSampleSizeObject()) { functionName <- "getSampleSizeMeans" } else { functionName <- "getPowerMeans" } } else if ("TrialDesignPlanRates" == class(obj)) { if (obj$.isSampleSizeObject()) { functionName <- "getSampleSizeRates" } else { functionName <- "getPowerRates" } } else if ("TrialDesignPlanSurvival" == class(obj)) { if (obj$.isSampleSizeObject()) { functionName <- "getSampleSizeSurvival" } else { functionName <- "getPowerSurvival" } } else if (inherits(obj, "TrialDesign")) { functionName <- paste0("get", sub("^Trial", "", class(obj))) } else if (inherits(obj, "Dataset")) { functionName <- "getDataset" } else if (inherits(obj, "AnalysisResults")) { functionName <- "getAnalysisResults" } else if ("TrialDesignSet" == class(obj)) { functionName <- "getDesignSet" } else if ("TrialDesignCharacteristics" == class(obj)) { functionName <- "getDesignCharacteristics" } else if ("SummaryFactory" == class(obj)) { functionName <- "summary" } else if (inherits(obj, "SimulationResultsMeans")) { functionName <- "getSimulationMeans" } else if (inherits(obj, "SimulationResultsRates")) { functionName <- "getSimulationRates" } else if (inherits(obj, "SimulationResultsSurvival")) { functionName <- "getSimulationSurvival" } else if (inherits(obj, "SimulationResultsMultiArmMeans")) { functionName <- "getSimulationMultiArmMeans" } else if (inherits(obj, "SimulationResultsMultiArmRates")) { functionName <- "getSimulationMultiArmRates" } else if (inherits(obj, "SimulationResultsMultiArmSurvival")) { functionName <- "getSimulationMultiArmSurvival" } else if (inherits(obj, "SimulationResultsEnrichmentMeans")) { functionName <- "getSimulationEnrichmentMeans" } else if (inherits(obj, "SimulationResultsEnrichmentRates")) { functionName <- "getSimulationEnrichmentRates" } else if (inherits(obj, "SimulationResultsEnrichmentSurvival")) { functionName <- "getSimulationEnrichmentSurvival" } else if (inherits(obj, "PiecewiseSurvivalTime")) { functionName <- "getPiecewiseSurvivalTime" } else if (inherits(obj, "AccrualTime")) { functionName <- "getAccrualTime" } else if (inherits(obj, "StageResults")) { functionName <- "getStageResults" } else if (inherits(obj, "ConditionalPowerResults")) { functionName <- "getConditionalPower" } else if (inherits(obj, "PowerAndAverageSampleNumberResult")) { functionName <- "getPowerAndAverageSampleNumber" } else if (inherits(obj, "EventProbabilities")) { functionName <- "getEventProbabilities" } else if (inherits(obj, "NumberOfSubjects")) { functionName <- "getNumberOfSubjects" } else if (inherits(obj, "SummaryFactory")) { return(getObjectRCode(obj$object, prefix = "summary(", postfix = ")", includeDefaultParameters = includeDefaultParameters,, stringWrapParagraphWidth = stringWrapParagraphWidth, newArgumentValues = newArgumentValues)) } else { stop("Runtime issue: function 'getObjectRCode' is not implemented for class ", class(obj)) } objNames <- names(obj) objNames <- objNames[objNames != "effectList"] if (inherits(obj, "ParameterSet")) { if (includeDefaultParameters) { objNames <- obj$.getInputParameters() } else { objNames <- obj$.getUserDefinedParameters() } objNames <- objNames[objNames != "stages"] } if (inherits(obj, "TrialDesign") && !inherits(obj, "TrialDesignConditionalDunnett") && !("informationRates" %in% objNames) && !("kMax" %in% objNames) && obj$kMax != 3) { objNames <- c("kMax", objNames) } thetaH0 <- NA_real_ if (inherits(obj, "SimulationResultsSurvival") && obj$.getParameterType("thetaH1") == "g") { objNames <- c(objNames, "thetaH1") thetaH0 <- obj[["thetaH0"]] } if (inherits(obj, "SimulationResultsSurvival")) { objNames <- objNames[objNames != "allocationRatioPlanned"] } if (inherits(obj, "AnalysisResults") && grepl("Fisher", class(obj))) { if (!is.null(obj[["seed"]]) && length(obj$seed) == 1 && !is.na(obj$seed)) { if (!("iterations" %in% objNames) ) { objNames <- c(objNames, "iterations") } if (!("seed" %in% objNames) ) { objNames <- c(objNames, "seed") } } else if (!is.null(obj[[".conditionalPowerResults"]]) && !is.null(obj$.conditionalPowerResults[["seed"]]) && length(obj$.conditionalPowerResults$seed) == 1 && !is.na(obj$.conditionalPowerResults$seed)) { if (!("iterations" %in% objNames) ) { objNames <- c(objNames, ".conditionalPowerResults$iterations") } if (!("seed" %in% objNames) ) { objNames <- c(objNames, ".conditionalPowerResults$seed") } } } if (!("accrualIntensity" %in% objNames) && !is.null(obj[[".accrualTime"]]) && !obj$.accrualTime$absoluteAccrualIntensityEnabled) { objNames <- c(objNames, "accrualIntensity") } if (length(newArgumentValues) > 0) { newArgumentValueNames <- names(newArgumentValues) illegalArgumentValueNames <- newArgumentValueNames[which(!(newArgumentValueNames %in% names(obj)))] if (length(illegalArgumentValueNames) > 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", illegalArgumentValueNames , "' is not a valid ", functionName, "() argument") } defaultParams <- newArgumentValueNames[!(newArgumentValueNames %in% objNames)] objNames <- c(objNames, defaultParams) } if (inherits(obj, "TrialDesign") && "kMax" %in% objNames && "informationRates" %in% objNames) { informationRates <- obj[["informationRates"]] if (!is.null(informationRates) && length(informationRates) > 0) { kMax <- obj[["kMax"]] if (isTRUE(all.equal(target = c(1:kMax) / kMax, current = informationRates, tolerance = 1e-15))) { objNames <- objNames[objNames != "informationRates"] } } } if (inherits(obj, "Dataset")) { lines <- .getDatasetArgumentsRCodeLines(obj, complete = FALSE, digits = NA_integer_) argumentsRCode <- paste0(lines, collapse = ", ") } else { argumentsRCode <- "" arguments <- c() if (length(objNames) > 0) { for (name in objNames) { if (grepl("^\\.conditionalPowerResults\\$", name)) { name <- sub("^\\.conditionalPowerResults\\$", "", name) value <- obj$.conditionalPowerResults[[name]] } else { value <- obj[[name]] } if (name == "accrualTime" && inherits(obj, "AccrualTime") && !isTRUE(obj$endOfAccrualIsUserDefined) && isTRUE(length(obj$accrualIntensity) < length(value))) { value <- value[1:(length(value) - 1)] } if (name == "accrualIntensityRelative") { name <- "accrualIntensity" } if (name == "accrualIntensity" && !is.null(obj[[".accrualTime"]]) && !obj$.accrualTime$absoluteAccrualIntensityEnabled) { value <- obj$.accrualTime$accrualIntensityRelative } originalValue <- value newValue <- newArgumentValues[[name]] if (!is.null(newValue)) { originalValue <- newValue } value <- .getArgumentValueRCode(originalValue, name) if (name == "allocationRatioPlanned") { optimumAllocationRatio <- obj[["optimumAllocationRatio"]] if (!is.null(optimumAllocationRatio) && isTRUE(optimumAllocationRatio)) { value <- 0 } else if (inherits(obj, "ParameterSet")) { if (obj$.getParameterType("allocationRatioPlanned") == "g") { value <- 0 } } } else if (name == "optimumAllocationRatio") { name <- "allocationRatioPlanned" value <- 0 } else if (name == "maxNumberOfSubjects") { value <- .getArgumentValueRCode(originalValue[1], name) } else if (name == "thetaH1" && length(thetaH0) == 1 && !is.na(thetaH0) && value != 1) { value <- .getArgumentValueRCode(originalValue * thetaH0, name) } else if (name == "nPlanned") { if (!all(is.na(originalValue))) { value <- .getArgumentValueRCode(na.omit(originalValue), name) } } if (name == "calcSubjectsFunction" && obj$.getParameterType("calcSubjectsFunction") == C_PARAM_USER_DEFINED && !is.null(obj[["calcSubjectsFunction"]])) { value <- "calcSubjectsFunction" } else if (name == "calcEventsFunction" && obj$.getParameterType("calcEventsFunction") == C_PARAM_USER_DEFINED && !is.null(obj[["calcEventsFunction"]])) { value <- "calcEventsFunction" } if ((name == "twoSidedPower" && isFALSE(originalValue)) || name == "accrualIntensityRelative") { # do not add #arguments <- c(arguments, paste0(name, "_DoNotAdd")) } else { if (length(value) > 0 && nchar(as.character(value)) > 0) { argument <- paste0(name, " = ", value) } else { argument <- name } if (!(argument %in% leadingArguments)) { arguments <- c(arguments, argument) } } } } if (inherits(obj, "TrialDesignPlanSurvival")) { if (!("accrualTime" %in% objNames) && obj$.getParameterType("accrualTime") == "g" && !all(is.na(obj$accrualTime))) { # case 2: follow-up time and absolute intensity given accrualType2 <- (length(obj$accrualIntensity) == 1 && obj$accrualIntensity >= 1 && obj$.getParameterType("accrualIntensity") == "u" && obj$.getParameterType("followUpTime") == "u" && obj$.getParameterType("maxNumberOfSubjects") == "g") if (!accrualType2) { accrualTime <- .getArgumentValueRCode(obj$accrualTime, "accrualTime") if (length(obj$accrualTime) > 1 && length(obj$accrualTime) == length(obj$accrualIntensity) && (obj$.getParameterType("maxNumberOfSubjects") == "u" || obj$.getParameterType("followUpTime") == "u")) { accrualTime <- .getArgumentValueRCode(obj$accrualTime[1:(length(obj$accrualTime) - 1)], "accrualTime") } accrualTimeArg <- paste0("accrualTime = ", accrualTime) index <- which(grepl("^accrualIntensity", arguments)) if (length(index) == 1 && index > 1) { arguments <- c(arguments[1:(index - 1)], accrualTimeArg, arguments[index:length(arguments)]) } else { arguments <- c(arguments, accrualTimeArg) } } else if (obj$.getParameterType("followUpTime") == "u") { arguments <- c(arguments, "accrualTime = 0") } } accrualIntensityRelative <- obj$.accrualTime$accrualIntensityRelative if (!("accrualIntensity" %in% objNames) && !all(is.na(accrualIntensityRelative))) { arguments <- c(arguments, paste0("accrualIntensity = ", .getArgumentValueRCode(accrualIntensityRelative, "accrualIntensity"))) } if (!("maxNumberOfSubjects" %in% objNames) && obj$.accrualTime$.getParameterType("maxNumberOfSubjects") == "u" && !(obj$.getParameterType("followUpTime") %in% c("u", "d"))) { arguments <- c(arguments, paste0("maxNumberOfSubjects = ", .getArgumentValueRCode(obj$maxNumberOfSubjects[1], "maxNumberOfSubjects"))) } } else if (inherits(obj, "AnalysisResults")) { arguments <- c(arguments, paste0("stage = ", obj$.stageResults$stage)) } else if (inherits(obj, "StageResults")) { arguments <- c(arguments, paste0("stage = ", obj$stage)) } if (length(arguments) > 0) { argumentsRCode <- paste0(argumentsRCode, arguments, collapse = ", ") } } if (!is.null(leadingArguments) && length(leadingArguments) > 0) { leadingArguments <- unique(leadingArguments) leadingArguments <- paste0(leadingArguments, collapse = ", ") if (nchar(argumentsRCode) > 0) { argumentsRCode <- paste0(leadingArguments, ", ", argumentsRCode) } else { argumentsRCode <- leadingArguments } } rCode <- paste0(prefix, functionName, "(", argumentsRCode, ")", postfix) rCode <- c(precondition, rCode) if (is.null(stringWrapParagraphWidth) || length(stringWrapParagraphWidth) != 1 || is.na(stringWrapParagraphWidth) || !is.numeric(stringWrapParagraphWidth) || stringWrapParagraphWidth < 10) { return(rCode) } rCode <- strwrap(rCode, width = stringWrapParagraphWidth) if (length(rCode) > 1 && !is.null(stringWrapPrefix) && length(stringWrapPrefix) == 1 && !is.na(stringWrapPrefix) && is.character(stringWrapPrefix)) { for (i in 2:length(rCode)) { if (!grepl("^ *([a-zA-Z0-9]+ *<-)|(^ *get[a-zA-Z]+\\()", rCode[i])) { rCode[i] <- paste0(stringWrapPrefix, rCode[i]) } } } return(rCode) } .getQNorm <- function(p, mean = 0, sd = 1, lower.tail = TRUE, log.p = FALSE, epsilon = C_QNORM_EPSILON) { if (any(p < -1e-07 | p > 1 + 1e-07, na.rm = TRUE)) { warning("Tried to get qnorm() from ", .arrayToString(p), " which is out of interval (0, 1)") } p[p <= 0] <- epsilon p[p > 1] <- 1 result <- stats::qnorm(p, mean = mean, sd = sd, lower.tail = lower.tail, log.p = log.p) result[result < -C_QNORM_THRESHOLD] <- C_QNORM_MINIMUM result[result > C_QNORM_THRESHOLD] <- C_QNORM_MAXIMUM return(result) } .getOneMinusQNorm <- function(p, mean = 0, sd = 1, lower.tail = TRUE, log.p = FALSE, ..., epsilon = C_QNORM_EPSILON) { if (all(is.na(p))) { return(p) } if (any(p < -1e-07 | p > 1 + 1e-07, na.rm = TRUE)) { warning("Tried to get 1 - qnorm() from ", .arrayToString(p), " which is out of interval (0, 1)") } p[p <= 0] <- epsilon p[p > 1] <- 1 indices <- p < 0.5 indices[is.na(indices)] <- FALSE result <- rep(NA_real_, length(p)) if (is.matrix(p)) { result <- matrix(result, ncol = ncol(p)) } if (any(indices)) { result[indices] <- -stats::qnorm(p[indices], mean = mean, sd = sd, lower.tail = lower.tail, log.p = log.p) } # prevent values that are close to 1 from becoming Inf, see qnorm(1) # example: 1 - 1e-17 = 1 in R, i.e., qnorm(1 - 1e-17) = Inf # on the other hand: qnorm(1e-323) = -38.44939 if (any(!indices)) { result[!indices] <- stats::qnorm(1 - p[!indices], mean = mean, sd = sd, lower.tail = lower.tail, log.p = log.p) } result[result < -C_QNORM_THRESHOLD] <- C_QNORM_MINIMUM result[result > C_QNORM_THRESHOLD] <- C_QNORM_MAXIMUM return(result) } rpact/R/class_analysis_stage_results.R0000644000175000017500000013021114153345060020014 0ustar nileshnilesh## | ## | *Stage results classes* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5615 $ ## | Last changed: $Date: 2021-12-06 09:29:15 +0100 (Mo, 06 Dez 2021) $ ## | Last changed by: $Author: wassmer $ ## | .getStageResultsClassNames <- function() { return(c("StageResultsMeans", "StageResultsRates", "StageResultsSurvival", "StageResultsMultiArmMeans", "StageResultsMultiArmRates", "StageResultsMultiArmSurvival", "StageResultsEnrichmentMeans", "StageResultsEnrichmentRates", "StageResultsEnrichmentSurvival")) } #' #' @name StageResults #' #' @title #' Basic Stage Results #' #' @description #' Basic class for stage results. #' #' @details #' \code{StageResults} is the basic class for \code{StageResultsMeans}, #' \code{StageResultsRates}, and \code{StageResultsSurvival}. #' #' @field testStatistics The stage-wise test statistics. #' @field pValues The stage-wise p-values. #' @field combInverseNormal The inverse normal test. #' @field combFisher The Fisher's combination test. #' @field effectSizes The effect sizes for different designs. #' @field testActions The action drawn from test result. #' @field weightsFisher The weights for Fisher's combination test. #' @field weightsInverseNormal The weights for inverse normal statistic. #' #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_analysis_dataset.R #' @include f_core_constants.R #' @include class_core_plot_settings.R #' #' @keywords internal #' #' @importFrom methods new #' StageResults <- setRefClass("StageResults", contains = "ParameterSet", fields = list( .plotSettings = "PlotSettings", .design = "TrialDesign", .dataInput = "Dataset", stage = "integer", stages = "integer", pValues = "numeric", weightsFisher = "numeric", weightsInverseNormal = "numeric", thetaH0 = "numeric", direction = "character" ), methods = list( initialize = function(...) { callSuper(...) }, init = function(design, dataInput) { .design <<- design .dataInput <<- dataInput .plotSettings <<- PlotSettings() if (!missing(design)) { stages <<- c(1:design$kMax) if (design$kMax == C_KMAX_DEFAULT) { .setParameterType("stages", C_PARAM_DEFAULT_VALUE) } else { .setParameterType("stages", C_PARAM_USER_DEFINED) } .parameterNames <<- .getParameterNames(design = design) } .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS .setParameterType("stage", C_PARAM_NOT_APPLICABLE) .setParameterType("pValues", ifelse( .isMultiArm(), C_PARAM_NOT_APPLICABLE, C_PARAM_GENERATED)) .setParameterType("thetaH0", ifelse( identical(thetaH0, C_THETA_H0_MEANS_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) .setParameterType("direction", ifelse( identical(direction, C_DIRECTION_UPPER), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) }, getPlotSettings = function() { return(.plotSettings) }, show = function(showType = 1, digits = NA_integer_) { .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { 'Method for automatically printing stage results' .resetCat() if (showType == 2) { callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { .cat(.toString(startWithUpperCase = TRUE), ":\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showParametersOfOneGroup(.getGeneratedParameters(), "Output", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled) .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) if (grepl("Enrichment", class(.self))) { .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) .cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) .cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) } else if (grepl("MultiArm", class(.self))) { .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) .cat(paste0(" (i): results of treatment arm i vs. control group ", .dataInput$getNumberOfGroups(),"\n"), consoleOutputEnabled = consoleOutputEnabled) } else if (.dataInput$getNumberOfGroups(survivalCorrectionEnabled = FALSE) >= 2) { .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) .cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) } } }, isDirectionUpper = function() { return(direction == C_DIRECTION_UPPER) }, .isMultiArm = function() { return(grepl("multi", tolower(class(.self)))) }, .isEnrichment = function() { return(grepl("enrichment", tolower(class(.self)))) }, getGMax = function() { if (!is.matrix(testStatistics)) { return(1L) } gMax <- nrow(testStatistics) if (is.null(gMax) || gMax == 0) { gMax <- 1L } return(gMax) }, .getParametersToShow = function() { return(c("stages")) }, .toString = function(startWithUpperCase = FALSE) { s <- "stage results of" if (grepl("MultiArm", class(.self))) { s <- paste(s, "multi-arm") } else if (grepl("Enrichment", class(.self))) { s <- paste(s, "enrichment") } if (grepl("Means", class(.self))) { s <- paste(s, "means") } if (grepl("Rates", class(.self))) { s <- paste(s, "rates") } if (grepl("Survival", class(.self))) { s <- paste(s, "survival data") } if (startWithUpperCase) { s <- .firstCharacterToUpperCase(s) } return(s) }, getDataInput = function() { return(.dataInput) }, getNumberOfGroups = function() { return(.dataInput$getNumberOfGroups()) }, isOneSampleDataset = function() { return(getNumberOfGroups() == 1) }, isTwoSampleDataset = function() { return(getNumberOfGroups() == 2) }, isDatasetMeans = function() { return(.dataInput$isDatasetMeans()) }, isDatasetRates = function() { return(.dataInput$isDatasetRates()) }, isDatasetSurvival = function() { return(.dataInput$isDatasetSurvival()) }, getNumberOfStages = function() { if (.isMultiArm()) { if (inherits(.self, "StageResultsMultiArmRates")) { return(max(ncol(stats::na.omit(testStatistics)), ncol(stats::na.omit(separatePValues)))) } return(max(ncol(stats::na.omit(effectSizes)), ncol(stats::na.omit(separatePValues)))) } return(max(length(stats::na.omit(effectSizes)), length(stats::na.omit(pValues)))) } ) ) #' #' @name StageResultsMeans #' #' @title #' Stage Results of Means #' #' @description #' Class for stage results of means. #' #' @details #' This object cannot be created directly; use \code{getStageResults} #' with suitable arguments to create the stage results of a dataset of means. #' #' @field testStatistics The stage-wise test statistics. #' @field pValues The stage-wise p-values. #' @field combInverseNormal The inverse normal test. #' @field combFisher The Fisher's combination test. #' @field effectSizes The effect sizes for different designs. #' @field testActions The action drawn from test result. #' @field weightsFisher The weights for Fisher's combination test. #' @field weightsInverseNormal The weights for inverse normal statistic. #' #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_analysis_dataset.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' StageResultsMeans <- setRefClass("StageResultsMeans", contains = "StageResults", fields = list( combInverseNormal = "numeric", combFisher = "numeric", overallTestStatistics = "numeric", overallPValues = "numeric", effectSizes = "numeric", testStatistics = "numeric", overallMeans = "numeric", overallMeans1 = "numeric", overallMeans2 = "numeric", overallStDevs = "numeric", overallStDevs1 = "numeric", overallStDevs2 = "numeric", overallSampleSizes = "numeric", overallSampleSizes1 = "numeric", overallSampleSizes2 = "numeric", equalVariances = "logical", normalApproximation = "logical" ), methods = list( initialize = function(design, dataInput, ..., equalVariances = TRUE, normalApproximation = FALSE) { callSuper(.design = design, .dataInput = dataInput, ..., equalVariances = equalVariances, normalApproximation = normalApproximation) init(design = design, dataInput = dataInput) for (param in c( "weightsFisher", "weightsInverseNormal", "combFisher", "combInverseNormal")) { .setParameterType(param, C_PARAM_NOT_APPLICABLE) } for (param in .getParametersToShow()) { if (.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { .setParameterType(param, C_PARAM_GENERATED) } } .setParameterType("equalVariances", ifelse( identical(equalVariances, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) .setParameterType("normalApproximation", ifelse( identical(normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) }, .getParametersToShow = function() { parametersToShow <- c( "stages", "overallTestStatistics", "overallPValues" ) if (.dataInput$getNumberOfGroups() == 1) { parametersToShow <- c(parametersToShow, "overallMeans", "overallStDevs", "overallSampleSizes" ) } else if (.dataInput$getNumberOfGroups() == 2) { parametersToShow <- c(parametersToShow, "overallMeans1", "overallMeans2", "overallStDevs1", "overallStDevs2", "overallSampleSizes1", "overallSampleSizes2" ) } parametersToShow <- c(parametersToShow, "testStatistics", "pValues", "effectSizes" ) if (.isTrialDesignInverseNormal(.design)) { parametersToShow <- c(parametersToShow, "combInverseNormal", "weightsInverseNormal" ) } else if (.isTrialDesignFisher(.design)) { parametersToShow <- c(parametersToShow, "combFisher", "weightsFisher" ) } parametersToShow <- c(parametersToShow, "thetaH0", "direction", "normalApproximation" ) if (.dataInput$getNumberOfGroups() == 2) { parametersToShow <- c(parametersToShow, "equalVariances" ) } return(parametersToShow) } ) ) #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_analysis_dataset.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' StageResultsMultiArmMeans <- setRefClass("StageResultsMultiArmMeans", contains = "StageResults", fields = list( stage = "integer", combInverseNormal = "matrix", combFisher = "matrix", overallTestStatistics = "matrix", overallStDevs = "matrix", overallPooledStDevs = "matrix", overallPValues = "matrix", testStatistics = "matrix", separatePValues = "matrix", effectSizes = "matrix", singleStepAdjustedPValues = "matrix", intersectionTest = "character", varianceOption = "character", normalApproximation = "logical", directionUpper = "logical" ), methods = list( initialize = function(design, dataInput, ..., varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, normalApproximation = FALSE) { callSuper(.design = design, .dataInput = dataInput, ..., varianceOption = varianceOption, normalApproximation = normalApproximation) init(design = design, dataInput = dataInput) for (param in c("singleStepAdjustedPValues", "weightsFisher", "weightsInverseNormal", "combFisher", "combInverseNormal")) { .setParameterType(param, C_PARAM_NOT_APPLICABLE) } for (param in .getParametersToShow()) { if (.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { .setParameterType(param, C_PARAM_GENERATED) } } .setParameterType("varianceOption", ifelse( identical(varianceOption, C_VARIANCE_OPTION_MULTIARMED_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) .setParameterType("normalApproximation", ifelse( identical(normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) .setParameterType("directionUpper", ifelse( identical(directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) }, .getParametersToShow = function() { parametersToShow <- c( "stages", "thetaH0", "direction", "normalApproximation", "directionUpper", "varianceOption", "intersectionTest", "overallTestStatistics", "overallPValues", "overallStDevs", "overallPooledStDevs", "testStatistics", "separatePValues", "effectSizes", "singleStepAdjustedPValues" ) if (.isTrialDesignInverseNormal(.design)) { parametersToShow <- c(parametersToShow, "combInverseNormal", "weightsInverseNormal" ) } else if (.isTrialDesignFisher(.design)) { parametersToShow <- c(parametersToShow, "combFisher", "weightsFisher" ) } return(parametersToShow) } ) ) #' #' @name StageResultsRates #' #' @title #' Stage Results of Rates #' #' @description #' Class for stage results of rates. #' #' @details #' This object cannot be created directly; use \code{getStageResults} #' with suitable arguments to create the stage results of a dataset of rates. #' #' @field testStatistics The stage-wise test statistics. #' @field pValues The stage-wise p-values. #' @field combInverseNormal The inverse normal test. #' @field combFisher The Fisher's combination test. #' @field effectSizes The effect sizes for different designs. #' @field testActions The action drawn from test result. #' @field weightsFisher The weights for Fisher's combination test. #' @field weightsInverseNormal The weights for inverse normal statistic. #' #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_analysis_dataset.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' StageResultsRates <- setRefClass("StageResultsRates", contains = "StageResults", fields = list( combInverseNormal = "numeric", combFisher = "numeric", overallTestStatistics = "numeric", overallPValues = "numeric", effectSizes = "numeric", testStatistics = "numeric", overallPi1 = "numeric", overallPi2 = "numeric", overallEvents = "numeric", overallEvents1 = "numeric", overallEvents2 = "numeric", overallSampleSizes = "numeric", overallSampleSizes1 = "numeric", overallSampleSizes2 = "numeric", normalApproximation = "logical" ), methods = list( initialize = function(design, dataInput, ..., normalApproximation = TRUE) { callSuper(.design = design, .dataInput = dataInput, ..., normalApproximation = normalApproximation) init(design = design, dataInput = dataInput) for (param in c( "weightsFisher", "weightsInverseNormal", "combFisher", "combInverseNormal")) { .setParameterType(param, C_PARAM_NOT_APPLICABLE) } for (param in .getParametersToShow()) { if (.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { .setParameterType(param, C_PARAM_GENERATED) } } .setParameterType("normalApproximation", ifelse( identical(normalApproximation, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) }, .getParametersToShow = function() { parametersToShow <- c( "stages", "overallTestStatistics", "overallPValues" ) if (.dataInput$getNumberOfGroups() == 1) { parametersToShow <- c(parametersToShow, "overallEvents", "overallSampleSizes", "overallPi1" ) } else if (.dataInput$getNumberOfGroups() == 2) { parametersToShow <- c(parametersToShow, "overallEvents1", "overallEvents2", "overallSampleSizes1", "overallSampleSizes2", "overallPi1", "overallPi2" ) } parametersToShow <- c(parametersToShow, "testStatistics", "pValues" ) if (.dataInput$getNumberOfGroups() > 1) { parametersToShow <- c(parametersToShow, "effectSizes") } if (.isTrialDesignInverseNormal(.design)) { parametersToShow <- c(parametersToShow, "combInverseNormal", "weightsInverseNormal" ) } else if (.isTrialDesignFisher(.design)) { parametersToShow <- c(parametersToShow, "combFisher", "weightsFisher" ) } parametersToShow <- c(parametersToShow, "thetaH0", "direction", "normalApproximation" ) return(parametersToShow) } ) ) #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_analysis_dataset.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' StageResultsMultiArmRates <- setRefClass("StageResultsMultiArmRates", contains = "StageResults", fields = list( stage = "integer", overallPiTreatments = "matrix", overallPiControl = "matrix", combInverseNormal = "matrix", combFisher = "matrix", overallTestStatistics = "matrix", overallPValues = "matrix", testStatistics = "matrix", separatePValues = "matrix", effectSizes = "matrix", singleStepAdjustedPValues = "matrix", intersectionTest = "character", normalApproximation = "logical", directionUpper = "logical" ), methods = list( initialize = function(design, dataInput, ..., normalApproximation = FALSE) { callSuper(.design = design, .dataInput = dataInput, ..., normalApproximation = normalApproximation) init(design = design, dataInput = dataInput) for (param in c("singleStepAdjustedPValues", "weightsFisher", "weightsInverseNormal", "combFisher", "combInverseNormal")) { .setParameterType(param, C_PARAM_NOT_APPLICABLE) } for (param in .getParametersToShow()) { if (.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { .setParameterType(param, C_PARAM_GENERATED) } } .setParameterType("normalApproximation", ifelse( identical(normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) .setParameterType("directionUpper", ifelse( identical(directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) }, .getParametersToShow = function() { parametersToShow <- c( "stages", "thetaH0", "direction", "normalApproximation", "directionUpper", "overallPiControl", "overallPiTreatments", "intersectionTest", "overallTestStatistics", "overallPValues", "testStatistics", "separatePValues", "singleStepAdjustedPValues" ) if (.isTrialDesignInverseNormal(.design)) { parametersToShow <- c(parametersToShow, "combInverseNormal", "weightsInverseNormal" ) } else if (.isTrialDesignFisher(.design)) { parametersToShow <- c(parametersToShow, "combFisher", "weightsFisher" ) } return(parametersToShow) } ) ) #' #' @name StageResultsSurvival #' #' @title #' Stage Results of Survival Data #' #' @description #' Class for stage results survival data. #' #' @details #' This object cannot be created directly; use \code{getStageResults} #' with suitable arguments to create the stage results of a dataset of survival data. #' #' @field testStatistics The stage-wise test statistics. #' @field pValues The stage-wise p-values. #' @field combInverseNormal The inverse normal test. #' @field combFisher The Fisher's combination test. #' @field effectSizes The effect sizes for different designs. #' @field testActions The action drawn from test result. #' @field weightsFisher The weights for Fisher's combination test. #' @field weightsInverseNormal The weights for inverse normal statistic. #' #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_analysis_dataset.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' StageResultsSurvival <- setRefClass("StageResultsSurvival", contains = "StageResults", fields = list( combInverseNormal = "numeric", combFisher = "numeric", overallPValues = "numeric", effectSizes = "numeric", overallTestStatistics = "numeric", overallEvents = "numeric", overallAllocationRatios = "numeric", events = "numeric", allocationRatios = "numeric", testStatistics = "numeric" ), methods = list( initialize = function(design, dataInput, ...) { callSuper(.design = design, .dataInput = dataInput, ...) init(design = design, dataInput = dataInput) for (param in c( "weightsFisher", "weightsInverseNormal", "combFisher", "combInverseNormal")) { .setParameterType(param, C_PARAM_NOT_APPLICABLE) } for (param in .getParametersToShow()) { if (.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { .setParameterType(param, C_PARAM_GENERATED) } } }, .getParametersToShow = function() { parametersToShow <- c( "stages", "overallTestStatistics", "overallPValues", "overallEvents", "overallAllocationRatios", "events", "allocationRatios", "testStatistics", "pValues", "overallPValues", "effectSizes" ) if (.isTrialDesignInverseNormal(.design)) { parametersToShow <- c(parametersToShow, "combInverseNormal", "weightsInverseNormal" ) } else if (.isTrialDesignFisher(.design)) { parametersToShow <- c(parametersToShow, "combFisher", "weightsFisher" ) } parametersToShow <- c(parametersToShow, "thetaH0", "direction" ) return(parametersToShow) } ) ) #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_analysis_dataset.R #' @include f_core_constants.R #' #' @keywords internal #' #' @importFrom methods new #' StageResultsMultiArmSurvival <- setRefClass("StageResultsMultiArmSurvival", contains = "StageResults", fields = list( stage = "integer", combInverseNormal = "matrix", combFisher = "matrix", overallTestStatistics = "matrix", overallPValues = "matrix", testStatistics = "matrix", separatePValues = "matrix", effectSizes = "matrix", singleStepAdjustedPValues = "matrix", intersectionTest = "character", directionUpper = "logical" ), methods = list( initialize = function(design, dataInput, ..., normalApproximation = FALSE) { callSuper(.design = design, .dataInput = dataInput, ...) init(design = design, dataInput = dataInput) for (param in c("singleStepAdjustedPValues", "weightsFisher", "weightsInverseNormal", "combFisher", "combInverseNormal")) { .setParameterType(param, C_PARAM_NOT_APPLICABLE) } for (param in .getParametersToShow()) { if (.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { .setParameterType(param, C_PARAM_GENERATED) } } .setParameterType("directionUpper", ifelse( identical(directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) }, .getParametersToShow = function() { parametersToShow <- c( "stages", "thetaH0", "direction", "directionUpper", "intersectionTest", "overallTestStatistics", "overallPValues", "testStatistics", "separatePValues", "effectSizes", "singleStepAdjustedPValues" ) if (.isTrialDesignInverseNormal(.design)) { parametersToShow <- c(parametersToShow, "combInverseNormal", "weightsInverseNormal" ) } else if (.isTrialDesignFisher(.design)) { parametersToShow <- c(parametersToShow, "combFisher", "weightsFisher" ) } return(parametersToShow) } ) ) StageResultsEnrichmentMeans <- setRefClass("StageResultsEnrichmentMeans", contains = "StageResultsMultiArmMeans", fields = list( .overallSampleSizes1 = "matrix", .overallSampleSizes2 = "matrix", stratifiedAnalysis = "logical" ), methods = list( .getParametersToShow = function() { return(c(callSuper(), "stratifiedAnalysis")) } ) ) StageResultsEnrichmentRates <- setRefClass("StageResultsEnrichmentRates", contains = "StageResultsMultiArmRates", fields = list( .overallSampleSizes1 = "matrix", .overallSampleSizes2 = "matrix", overallPisTreatment = "matrix", overallPisControl = "matrix", stratifiedAnalysis = "logical" ), methods = list( .getParametersToShow = function() { parametersToShow <- callSuper() parametersToShow <- parametersToShow[!(parametersToShow %in% c("overallPiTreatments", "overallPiControl"))] return(c(parametersToShow, "stratifiedAnalysis", "overallPisTreatment", "overallPisControl")) } ) ) StageResultsEnrichmentSurvival <- setRefClass("StageResultsEnrichmentSurvival", contains = "StageResultsMultiArmSurvival", fields = list( stratifiedAnalysis = "logical", .overallEvents = "matrix" ), methods = list( .getParametersToShow = function() { return(c(callSuper(), "stratifiedAnalysis")) } ) ) #' #' @name StageResults_names #' #' @title #' Names of a Stage Results Object #' #' @description #' Function to get the names of a \code{\link{StageResults}} object. #' #' @param x A \code{\link{StageResults}} object. #' #' @details #' Returns the names of stage results that can be accessed by the user. #' #' @template return_names #' #' @export #' #' @keywords internal #' names.StageResults <- function(x) { return(x$.getParametersToShow()) } #' #' @name StageResults_as.data.frame #' #' @title #' Coerce Stage Results to a Data Frame #' #' @description #' Returns the \code{StageResults} as data frame. #' #' @param x A \code{\link{StageResults}} object. #' @inheritParams param_niceColumnNamesEnabled #' @inheritParams param_includeAllParameters #' @inheritParams param_three_dots #' #' @details #' Coerces the stage results to a data frame. #' #' @template return_dataframe #' #' @export #' #' @keywords internal #' as.data.frame.StageResults <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, type = 1, ...) { if (type == 1) { parametersToShow <- x$.getParametersToShow() return(x$.getAsDataFrame(parameterNames = parametersToShow, niceColumnNamesEnabled = niceColumnNamesEnabled, includeAllParameters = includeAllParameters, tableColumnNames = .getTableColumnNames(design = x$.design))) } kMax <- length(x$stages) group1 <- rep(1, kMax) group2 <- rep(2, kMax) empty <- rep(NA_real_, kMax) stageResults <- data.frame( Stage = c(x$stages, x$stages), Group = c(group1, group2), "Cumulative Mean" = c(x$overallMeans1, x$overallMeans2), "Cumulative stDev" = c(x$overallStDevs1, x$overallStDevs2), "Cumulative test statistics" = c(x$overallTestStatistics, empty), "Overall p-value" = c(x$overallPValues, empty), "Cumulative stDev" = c(x$overallStDevs, empty), "Stage-wise test statistic" = c(x$testStatistics, empty), "Stage-wise p-value" = c(x$pValues, empty), "Comb Inverse Normal" = c(x$combInverseNormal, empty), "Comb Fisher" = c(x$combFisher, empty), "Weights Fisher" = c(x$weightsFisher, empty), "Weights Inverse Normal" = c(x$weightsInverseNormal, empty), row.names = row.names, ... ) stageResults <- stageResults[with(stageResults, order(Stage, Group)), ] return(stageResults) } .getTreatmentArmsToShow <- function(x, ...) { dataInput <- x if (!inherits(dataInput, "Dataset")) { dataInput <- x[[".dataInput"]] } if (is.null(dataInput) || !inherits(dataInput, "Dataset")) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", class(x)) } numberOfTreatments <- dataInput$getNumberOfGroups() if (numberOfTreatments > 1) { validComparisons <- 1L:as.integer(numberOfTreatments - 1) } else { validComparisons <- 1L } treatmentArmsToShow <- .getOptionalArgument("treatmentArms", ...) if (!is.null(treatmentArmsToShow)) { treatmentArmsToShow <- as.integer(na.omit(treatmentArmsToShow)) } if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || all(is.na(treatmentArmsToShow)) || !is.numeric(treatmentArmsToShow)) { treatmentArmsToShow <- validComparisons } else if (!all(treatmentArmsToShow %in% validComparisons)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'treatmentArms' (", .arrayToString(treatmentArmsToShow), ") must be a vector ", "containing one or more values of ", .arrayToString(validComparisons)) } treatmentArmsToShow <- sort(unique(treatmentArmsToShow)) return(treatmentArmsToShow) } .getPopulationsToShow <- function(x, ..., gMax) { dataInput <- x if (!inherits(dataInput, "Dataset")) { dataInput <- x[[".dataInput"]] } if (is.null(dataInput) || !inherits(dataInput, "Dataset")) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", class(x)) } numberOfPopulations <- gMax if (numberOfPopulations > 1) { validComparisons <- 1L:as.integer(numberOfPopulations) } else { validComparisons <- 1L } populationsToShow <- .getOptionalArgument("populations", ...) if (!is.null(populationsToShow)) { populationsToShow <- as.integer(na.omit(populationsToShow)) } if (is.null(populationsToShow) || length(populationsToShow) == 0 || all(is.na(populationsToShow)) || !is.numeric(populationsToShow)) { populationsToShow <- validComparisons } else if (!all(populationsToShow %in% validComparisons)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'populations' (", .arrayToString(populationsToShow), ") must be a vector ", "containing one or more values of ", .arrayToString(validComparisons)) } populationsToShow <- sort(unique(populationsToShow)) return(populationsToShow) } #' #' @title #' Stage Results Plotting #' #' @description #' Plots the conditional power together with the likelihood function. #' #' @param x The stage results at given stage, obtained from \code{getStageResults} or \code{getAnalysisResults}. #' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). #' @inheritParams param_stage #' @inheritParams param_nPlanned #' @inheritParams param_allocationRatioPlanned #' @param main The main title. #' @param xlab The x-axis label. #' @param ylab The y-axis label. #' @param legendTitle The legend title. #' @inheritParams param_palette #' @inheritParams param_showSource #' @inheritParams param_plotSettings #' @inheritParams param_legendPosition #' @param type The plot type (default = 1). Note that at the moment only one type #' (the conditional power plot) is available. #' @param ... Optional \link[=param_three_dots_plot]{plot arguments}. Furthermore the following arguments can be defined: #' \itemize{ #' \item \code{thetaRange}: A range of assumed effect sizes if testing means or a survival design was specified. #' Additionally, if testing means was selected, an assumed standard deviation can be specified (default is 1). #' \item \code{piTreatmentRange}: A range of assumed rates pi1 to calculate the conditional power. #' Additionally, if a two-sample comparison was selected, pi2 can be specified (default is the value from #' \code{getAnalysisResults}). #' \item \code{directionUpper}: Specifies the direction of the alternative, #' only applicable for one-sided testing; default is \code{TRUE} #' which means that larger values of the test statistics yield smaller p-values. #' \item \code{\link[=param_thetaH0]{thetaH0}}: The null hypothesis value, default is 0 for the normal and the binary case, #' it is 1 for the survival case. #' For testing a rate in one sample, a value thetaH0 in (0,1) has to be specified for #' defining the null hypothesis H0: pi = thetaH0. #' } #' #' @details #' Generic function to plot all kinds of stage results. #' The conditional power is calculated only if effect size and sample size is specified. #' #' @template return_object_ggplot #' #' @examples #' design <- getDesignGroupSequential(kMax = 4, alpha = 0.025, #' informationRates = c(0.2, 0.5, 0.8, 1), #' typeOfDesign = "WT", deltaWT = 0.25) #' #' dataExample <- getDataset( #' n = c(20, 30, 30), #' means = c(50, 51, 55), #' stDevs = c(130, 140, 120) #' ) #' #' stageResults <- getStageResults(design, dataExample, thetaH0 = 20) #' #' if (require(ggplot2)) plot(stageResults, nPlanned = c(30), thetaRange = c(0, 100)) #' #' @export #' plot.StageResults <- function(x, y, ..., type = 1L, nPlanned, allocationRatioPlanned = 1, # C_ALLOCATION_RATIO_DEFAULT main = NA_character_, xlab = NA_character_, ylab = NA_character_, legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, showSource = FALSE, plotSettings = NULL) { fCall = match.call(expand.dots = FALSE) .assertGgplotIsInstalled() .assertIsStageResults(x) .assertIsValidLegendPosition(legendPosition) if (.isConditionalPowerEnabled(nPlanned)) { .assertIsValidAllocationRatioPlanned(allocationRatioPlanned, x$.dataInput$getNumberOfGroups()) } .stopInCaseOfIllegalStageDefinition2(...) if (x$.design$kMax == 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot plot stage results of a fixed design") } if (!is.logical(showSource) || isTRUE(showSource)) { stageResultsName <- .getOptionalArgument("stageResultsName", ...) if (is.null(stageResultsName)) { stageResultsName <- deparse(fCall$x) } cat("Source data of the plot:\n") cat(" Use getConditionalPower(..., addPlotData = TRUE) to create the data.\n", sep = "") cat("Simple plot command example:\n", sep = "") cmd <- paste0("condPow <- getConditionalPower(", stageResultsName, ", nPlanned = ", .arrayToString(nPlanned, vectorLookAndFeelEnabled = TRUE)) if (.isConditionalPowerEnabled(nPlanned) && allocationRatioPlanned != C_ALLOCATION_RATIO_DEFAULT) { cmd <- paste0(cmd, ", allocationRatioPlanned = ", allocationRatioPlanned) } if (grepl("Means|Survival", class(x))) { cmd <- paste0(cmd, ", thetaRange = seq(0, 1, 0.1)") } else if (grepl("Rates", class(x))) { cmd <- paste0(cmd, ", piTreatmentRange = seq(0, 1, 0.1)") } cmd <- paste0(cmd, ", addPlotData = TRUE)") cat(" ", cmd, "\n", sep = "") cat(" plotData <- condPow$.plotData # get plot data list\n", sep = "") cat(" plotData # show plot data list\n", sep = "") cat(" plot(plotData$xValues, plotData$condPowerValues)\n", sep = "") cat(" plot(plotData$xValues, plotData$likelihoodValues)\n", sep = "") } plotData <- .getConditionalPowerPlot(stageResults = x, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ...) yParameterName1 <- "Conditional power" yParameterName2 <- "Likelihood" if (.isMultiArmStageResults(x)) { treatmentArmsToShow <- .getTreatmentArmsToShow(x, ...) data <- data.frame( xValues = numeric(0), yValues = numeric(0), categories = character(0), treatmentArms = numeric(0) ) for (treatmentArm in treatmentArmsToShow) { legend1 <- ifelse(length(treatmentArmsToShow) == 1, yParameterName1, paste0(yParameterName1, " (", treatmentArm, " vs control)")) legend2 <- ifelse(length(treatmentArmsToShow) == 1, yParameterName2, paste0(yParameterName2, " (", treatmentArm, " vs control)")) treatmentArmIndices <- which(plotData$treatmentArms == treatmentArm) if (all(is.na(plotData$condPowerValues[treatmentArmIndices]))) { if (!all(is.na(plotData$likelihoodValues[treatmentArmIndices]))) { data <- rbind(data, data.frame( xValues = plotData$xValues[treatmentArmIndices], yValues = plotData$likelihoodValues[treatmentArmIndices], categories = rep(legend2, length(plotData$xValues[treatmentArmIndices])), treatmentArms = rep(treatmentArm, length(plotData$xValues[treatmentArmIndices])) )) } } else { data <- rbind(data, data.frame( xValues = c(plotData$xValues[treatmentArmIndices], plotData$xValues[treatmentArmIndices]), yValues = c(plotData$condPowerValues[treatmentArmIndices], plotData$likelihoodValues[treatmentArmIndices]), categories = c(rep(legend1, length(plotData$xValues[treatmentArmIndices])), rep(legend2, length(plotData$xValues[treatmentArmIndices]))), treatmentArms = c(rep(treatmentArm, length(plotData$xValues[treatmentArmIndices])), rep(treatmentArm, length(plotData$xValues[treatmentArmIndices]))) )) } } } else if (.isEnrichmentStageResults(x)) { gMax <- max(na.omit(plotData$populations)) populationsToShow <- .getPopulationsToShow(x, ..., gMax = gMax) data <- data.frame( xValues = numeric(0), yValues = numeric(0), categories = character(0), populations = numeric(0) ) for (population in populationsToShow) { populationName <- ifelse(population == gMax, "F", paste0("S", population)) legend1 <- ifelse(length(populationsToShow) == 1, yParameterName1, paste0(yParameterName1, " (", populationName, ")")) legend2 <- ifelse(length(populationsToShow) == 1, yParameterName2, paste0(yParameterName2, " (", populationName, ")")) populationIndices <- which(plotData$populations == population) if (all(is.na(plotData$condPowerValues[populationIndices]))) { if (!all(is.na(plotData$likelihoodValues[populationIndices]))) { data <- rbind(data, data.frame( xValues = plotData$xValues[populationIndices], yValues = plotData$likelihoodValues[populationIndices], categories = rep(legend2, length(plotData$xValues[populationIndices])), populations = rep(population, length(plotData$xValues[populationIndices])) )) } } else { data <- rbind(data, data.frame( xValues = c(plotData$xValues[populationIndices], plotData$xValues[populationIndices]), yValues = c(plotData$condPowerValues[populationIndices], plotData$likelihoodValues[populationIndices]), categories = c(rep(legend1, length(plotData$xValues[populationIndices])), rep(legend2, length(plotData$xValues[populationIndices]))), populations = c(rep(population, length(plotData$xValues[populationIndices])), rep(population, length(plotData$xValues[populationIndices]))) )) } } } else { if (all(is.na(plotData$condPowerValues))) { legendPosition <- -1 data <- data.frame( xValues = plotData$xValues, yValues = plotData$likelihoodValues, categories = rep(yParameterName2, length(plotData$xValues)) ) } else { data <- data.frame( xValues = c(plotData$xValues, plotData$xValues), yValues = c(plotData$condPowerValues, plotData$likelihoodValues), categories = c(rep(yParameterName1, length(plotData$xValues)), rep(yParameterName2, length(plotData$xValues))) ) } } data$categories <- factor(data$categories, levels = unique(data$categories)) main <- ifelse(is.na(main), C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, main) ylab <- ifelse(is.na(ylab), C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, ylab) if (is.na(legendTitle)) { legendTitle <- "Parameter" } return(.createAnalysisResultsPlotObject(x, data = data, plotData = plotData, main = main, xlab = xlab, ylab = ylab, legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, numberOfPairedLines = 2L, plotSettings = plotSettings)) } .createAnalysisResultsPlotObject <- function(x, ..., data, plotData, main = NA_character_, xlab = NA_character_, ylab = NA_character_, legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, numberOfPairedLines = NA_integer_, plotSettings = NULL) { ciModeEnabled <- !is.null(data[["lower"]]) && !is.null(data[["upper"]]) if (!ciModeEnabled) { p <- ggplot2::ggplot(data, ggplot2::aes(x = .data[["xValues"]], y = .data[["yValues"]], colour = factor(.data[["categories"]]), linetype = factor(.data[["categories"]]))) } else { p <- ggplot2::ggplot(data, ggplot2::aes(x = .data[["xValues"]], y = .data[["yValues"]], colour = factor(.data[["categories"]]))) } if (is.null(plotSettings)) { plotSettings <- x$getPlotSettings() } p <- plotSettings$setTheme(p) p <- plotSettings$hideGridLines(p) # set main title mainTitle <- ifelse(!is.call(main) && !isS4(main) && is.na(main), plotData$main, main) p <- plotSettings$setMainTitle(p, mainTitle, subtitle = plotData$sub) # set legend if (is.na(legendPosition)) { legendPosition <- C_POSITION_LEFT_TOP } p <- plotSettings$setLegendPosition(p, legendPosition = legendPosition) p <- plotSettings$setLegendBorder(p) p <- plotSettings$setLegendTitle(p, legendTitle) p <- plotSettings$setLegendLabelSize(p) # set axes labels p <- plotSettings$setAxesLabels(p, xAxisLabel = plotData$xlab, yAxisLabel1 = plotData$ylab, xlab = xlab, ylab = ylab) # plot lines and points if (!ciModeEnabled) { if (is.na(numberOfPairedLines)) { numberOfPairedLines <- 2 if (x$.isMultiArm()) { numberOfPairedLines <- length(unique(data$treatmentArms)) - 1 } else if (x$.isEnrichment()) { numberOfPairedLines <- length(unique(data$populations)) - 1 } } p <- plotSettings$plotValues(p, plotPointsEnabled = FALSE, pointBorder = 1) n <- length(unique(data$categories)) / numberOfPairedLines if (n > 1) { lineTypeValues <- rep(1:numberOfPairedLines, n) colorTypes <- sort(rep(1:n, numberOfPairedLines)) for (i in c(1, 3)) { colorTypes[colorTypes >= i] <- colorTypes[colorTypes >= i] + 1 } p <- p + ggplot2::scale_color_manual(name = legendTitle, values = colorTypes) p <- p + ggplot2::scale_linetype_manual(name = legendTitle, values = lineTypeValues) } else { colorValues = c(2, 4) if (!x$.isMultiArm()) { colorValues = c(2, 2) # use only one color } p <- p + ggplot2::scale_color_manual(name = legendTitle, values = colorValues) p <- p + ggplot2::scale_linetype_manual(name = legendTitle, values = c(1, 2)) } } # plot confidence intervall else { pd <- ggplot2::position_dodge(0.15) p <- p + ggplot2::geom_errorbar(data = data, ggplot2::aes(ymin = .data[["lower"]], ymax = .data[["upper"]]), width = 0.15, position = pd, size = 0.8) p <- p + ggplot2::geom_line(position = pd, linetype = "longdash") p <- p + ggplot2::geom_point(position = pd, size = 2.0) stage <- unique(data$xValues) kMax <- list(...)[["kMax"]] if (length(stage) == 1 && !is.null(kMax)) { stages <- 1:kMax p <- p + ggplot2::scale_x_continuous(breaks = stages) } else if (length(stage) > 1 && all(stage %in% 1:10)) { p <- p + ggplot2::scale_x_continuous(breaks = stage) } } p <- plotSettings$setAxesAppearance(p) p <- plotSettings$enlargeAxisTicks(p) companyAnnotationEnabled <- .getOptionalArgument("companyAnnotationEnabled", ...) if (is.null(companyAnnotationEnabled) || !is.logical(companyAnnotationEnabled)) { companyAnnotationEnabled <- FALSE } p <- plotSettings$addCompanyAnnotation(p, enabled = companyAnnotationEnabled) # start plot generation return(p) } rpact/R/f_simulation_enrichment_survival.R0000644000175000017500000012553614156304412020715 0ustar nileshnilesh## | ## | *Simulation of enrichment design with time to event data* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5655 $ ## | Last changed: $Date: 2021-12-15 07:19:53 +0100 (Wed, 15 Dec 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include f_simulation_enrichment.R NULL .getSimulationSurvivalEnrichmentStageEvents <- function(..., stage, directionUpper, conditionalPower, conditionalCriticalValue, plannedEvents, allocationRatioPlanned, selectedPopulations, thetaH1, overallEffects, minNumberOfEventsPerStage, maxNumberOfEventsPerStage) { stage <- stage - 1 # to be consistent with non-enrichment situation gMax <- nrow(overallEffects) if (!is.na(conditionalPower)) { if (any(selectedPopulations[1:gMax, stage + 1], na.rm = TRUE)) { if (is.na(thetaH1)) { if (directionUpper) { thetaStandardized <- log(max(min( overallEffects[selectedPopulations[1:gMax, stage + 1], stage], na.rm = TRUE ), 1 + 1e-07)) } else { thetaStandardized <- log(min(max( overallEffects[selectedPopulations[1:gMax, stage + 1], stage], na.rm = TRUE ), 1 - 1e-07)) } } else { if (directionUpper) { thetaStandardized <- log(max(thetaH1, 1 + 1e-07)) } else { thetaStandardized <- log(min(thetaH1, 1 - 1e-07)) } } if (conditionalCriticalValue[stage] > 8) { newEvents <- maxNumberOfEventsPerStage[stage + 1] } else { newEvents <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * (max(0, conditionalCriticalValue[stage] + .getQNorm(conditionalPower), na.rm = TRUE))^2 / thetaStandardized^2 newEvents <- min( max(minNumberOfEventsPerStage[stage + 1], newEvents), maxNumberOfEventsPerStage[stage + 1] ) } } else { newEvents <- 0 } } else { newEvents <- plannedEvents[stage + 1] - plannedEvents[stage] } return(newEvents) } .getSimulatedStageSurvivalEnrichment <- function(..., design, subsets, prevalences, hazardRatios, directionUpper, stratifiedAnalysis, plannedEvents, typeOfSelection, effectMeasure, adaptations, epsilonValue, rValue, threshold, allocationRatioPlanned, minNumberOfEventsPerStage, maxNumberOfEventsPerStage, conditionalPower, thetaH1, calcEventsFunction, calcEventsFunctionIsUserDefined, selectPopulationsFunction) { kMax <- length(plannedEvents) pMax <- length(hazardRatios) gMax <- log(length(hazardRatios), 2) + 1 simLogRanks <- matrix(NA_real_, nrow = pMax, ncol = kMax) eventsPerStage <- matrix(NA_real_, nrow = pMax, ncol = kMax) populationEventsPerStage <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallEffects <- matrix(NA_real_, nrow = gMax, ncol = kMax) testStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallTestStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) separatePValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) conditionalCriticalValue <- rep(NA_real_, kMax - 1) conditionalPowerPerStage <- rep(NA_real_, kMax) selectedPopulations <- matrix(FALSE, nrow = gMax, ncol = kMax) selectedSubsets <- matrix(FALSE, nrow = pMax, ncol = kMax) selectedPopulations[, 1] <- TRUE selectedSubsets[, 1] <- TRUE adjustedPValues <- rep(NA_real_, kMax) populationHazardRatios <- rep(NA_real_, gMax) if (.isTrialDesignFisher(design)) { weights <- .getWeightsFisher(design) } else if (.isTrialDesignInverseNormal(design)) { weights <- .getWeightsInverseNormal(design) } const <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 for (k in 1:kMax) { selectedSubsets[, k] <- .createSelectedSubsets(k, selectedPopulations) if (k == 1) { eventsPerStage[, k] <- prevalences * (1 + allocationRatioPlanned * hazardRatios) / sum(prevalences * (1 + allocationRatioPlanned * hazardRatios), na.rm = TRUE) * plannedEvents[k] } else { prevSelected <- prevalences / sum(prevalences[selectedSubsets[, k]]) prevSelected[!selectedSubsets[, k]] <- 0 if (sum(prevSelected, na.rm = TRUE) > 0) { eventsPerStage[, k] <- prevSelected * (1 + allocationRatioPlanned * hazardRatios) / sum(prevSelected * (1 + allocationRatioPlanned * hazardRatios), na.rm = TRUE) * (plannedEvents[k] - plannedEvents[k - 1]) } else { break } } if (gMax == 1) { testStatistics[1, k] <- (2 * directionUpper - 1) * stats::rnorm(1, log(hazardRatios[1]) * sqrt(const * eventsPerStage[1, k]), 1) populationEventsPerStage[1, k] <- eventsPerStage[1, k] overallTestStatistics[1, k] <- sum(sqrt(eventsPerStage[1, 1:k]) * testStatistics[1, 1:k], na.rm = TRUE) / sqrt(sum(eventsPerStage[1, 1:k], na.rm = TRUE)) overallEffects[1, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[1, k] / sqrt(const) / sqrt(sum(eventsPerStage[1, 1:k], na.rm = TRUE))) } else if (gMax == 2) { # Population S1 testStatistics[1, k] <- (2 * directionUpper - 1) * stats::rnorm(1, log(hazardRatios[1]) * sqrt(const * eventsPerStage[1, k]), 1) populationEventsPerStage[1, k] <- eventsPerStage[1, k] overallTestStatistics[1, k] <- sum(sqrt(eventsPerStage[1, 1:k]) * testStatistics[1, 1:k], na.rm = TRUE) / sqrt(sum(eventsPerStage[1, 1:k], na.rm = TRUE)) overallEffects[1, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[1, k] / sqrt(const) / sqrt(sum(eventsPerStage[1, 1:k], na.rm = TRUE))) # Full population testStatistics[2, k] <- (2 * directionUpper - 1) * stats::rnorm(1, log(hazardRatios[1:2] %*% prevalences[1:2] / sum(prevalences[1:2])) * sqrt(const * sum(eventsPerStage[1:2, k], na.rm = TRUE)), 1) populationEventsPerStage[2, k] <- sum(eventsPerStage[1:2, k], na.rm = TRUE) overallTestStatistics[2, k] <- sum(sqrt(populationEventsPerStage[2, 1:k]) * testStatistics[2, 1:k], na.rm = TRUE) / sqrt(sum(populationEventsPerStage[2, 1:k], na.rm = TRUE)) overallEffects[2, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[2, k] / sqrt(const) / sqrt(sum(populationEventsPerStage[2, 1:k], na.rm = TRUE))) } else if (gMax == 3) { # Population S1 testStatistics[1, k] <- (2 * directionUpper - 1) * stats::rnorm(1, log(hazardRatios[c(1, 3)] %*% prevalences[c(1, 3)] / sum(prevalences[c(1, 3)])) * sqrt(const * sum(eventsPerStage[c(1, 3), k], na.rm = TRUE)), 1) populationEventsPerStage[1, k] <- sum(eventsPerStage[c(1, 3), k], na.rm = TRUE) overallTestStatistics[1, k] <- sum(sqrt(populationEventsPerStage[1, 1:k]) * testStatistics[1, 1:k], na.rm = TRUE) / sqrt(sum(populationEventsPerStage[1, 1:k], na.rm = TRUE)) overallEffects[1, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[1, k] / sqrt(const) / sqrt(sum(populationEventsPerStage[1, 1:k], na.rm = TRUE))) # Population S2 testStatistics[2, k] <- (2 * directionUpper - 1) * stats::rnorm(1, log(hazardRatios[c(2, 3)] %*% prevalences[c(2, 3)] / sum(prevalences[c(2, 3)])) * sqrt(const * sum(eventsPerStage[c(2, 3), k], na.rm = TRUE)), 1) populationEventsPerStage[2, k] <- sum(eventsPerStage[c(2, 3), k], na.rm = TRUE) overallTestStatistics[2, k] <- sum(sqrt(populationEventsPerStage[2, 1:k]) * testStatistics[2, 1:k], na.rm = TRUE) / sqrt(sum(populationEventsPerStage[2, 1:k], na.rm = TRUE)) overallEffects[2, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[2, k] / sqrt(const) / sqrt(sum(populationEventsPerStage[2, 1:k], na.rm = TRUE))) # Full population testStatistics[3, k] <- (2 * directionUpper - 1) * stats::rnorm(1, log(hazardRatios[1:4] %*% prevalences[1:4] / sum(prevalences[1:4])) * sqrt(const * sum(eventsPerStage[1:4, k], na.rm = TRUE)), 1) populationEventsPerStage[3, k] <- sum(eventsPerStage[1:4, k], na.rm = TRUE) overallTestStatistics[3, k] <- sum(sqrt(populationEventsPerStage[3, 1:k]) * testStatistics[3, 1:k], na.rm = TRUE) / sqrt(sum(populationEventsPerStage[3, 1:k], na.rm = TRUE)) overallEffects[3, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[3, k] / sqrt(const) / sqrt(sum(populationEventsPerStage[3, 1:k], na.rm = TRUE))) } else if (gMax == 4) { # Population S1 testStatistics[1, k] <- (2 * directionUpper - 1) * stats::rnorm(1, log(hazardRatios[c(1, 4, 5, 7)] %*% prevalences[c(1, 4, 5, 7)] / sum(prevalences[c(1, 4, 5, 7)])) * sqrt(const * sum(eventsPerStage[c(1, 4, 5, 7), k], na.rm = TRUE)), 1) populationEventsPerStage[1, k] <- sum(eventsPerStage[c(1, 4, 5, 7), k], na.rm = TRUE) overallTestStatistics[1, k] <- sum(sqrt(populationEventsPerStage[1, 1:k]) * testStatistics[1, 1:k], na.rm = TRUE) / sqrt(sum(populationEventsPerStage[1, 1:k], na.rm = TRUE)) overallEffects[1, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[1, k] / sqrt(const) / sqrt(sum(populationEventsPerStage[1, 1:k], na.rm = TRUE))) # Population S2 testStatistics[2, k] <- (2 * directionUpper - 1) * stats::rnorm(1, log(hazardRatios[c(2, 4, 6, 7)] %*% prevalences[c(2, 4, 6, 7)] / sum(prevalences[c(2, 4, 6, 7)])) * sqrt(const * sum(eventsPerStage[c(2, 4, 6, 7), k], na.rm = TRUE)), 1) populationEventsPerStage[2, k] <- sum(eventsPerStage[c(2, 4, 6, 7), k], na.rm = TRUE) overallTestStatistics[2, k] <- sum(sqrt(populationEventsPerStage[2, 1:k]) * testStatistics[2, 1:k], na.rm = TRUE) / sqrt(sum(populationEventsPerStage[2, 1:k], na.rm = TRUE)) overallEffects[2, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[2, k] / sqrt(const) / sqrt(sum(populationEventsPerStage[2, 1:k], na.rm = TRUE))) # Population S3 testStatistics[3, k] <- (2 * directionUpper - 1) * stats::rnorm(1, log(hazardRatios[c(3, 5, 6, 7)] %*% prevalences[c(3, 5, 6, 7)] / sum(prevalences[c(3, 5, 6, 7)])) * sqrt(const * sum(eventsPerStage[c(3, 5, 6, 7), k], na.rm = TRUE)), 1) populationEventsPerStage[3, k] <- sum(eventsPerStage[c(3, 5, 6, 7), k], na.rm = TRUE) overallTestStatistics[3, k] <- sum(sqrt(populationEventsPerStage[3, 1:k]) * testStatistics[3, 1:k], na.rm = TRUE) / sqrt(sum(populationEventsPerStage[3, 1:k], na.rm = TRUE)) overallEffects[3, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[3, k] / sqrt(const) / sqrt(sum(populationEventsPerStage[3, 1:k], na.rm = TRUE))) # Full population testStatistics[4, k] <- (2 * directionUpper - 1) * stats::rnorm(1, log(hazardRatios[1:8] %*% prevalences[1:8] / sum(prevalences[1:8])) * sqrt(const * sum(eventsPerStage[1:8, k], na.rm = TRUE)), 1) populationEventsPerStage[4, k] <- sum(eventsPerStage[1:8, k], na.rm = TRUE) overallTestStatistics[4, k] <- sum(sqrt(populationEventsPerStage[4, 1:k]) * testStatistics[4, 1:k], na.rm = TRUE) / sqrt(sum(populationEventsPerStage[4, 1:k], na.rm = TRUE)) overallEffects[4, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[4, k] / sqrt(const) / sqrt(sum(populationEventsPerStage[4, 1:k], na.rm = TRUE))) } # selsubs <- !is.na(eventsPerStage[, k]) & eventsPerStage[, k] > 0 # simLogRanks[selsubs, k] <- (2 * directionUpper - 1) * # stats::rnorm(rep(1, sum(selsubs)), log(hazardRatios[selsubs]) * sqrt(const * eventsPerStage[selsubs, k]), 1) # # if (gMax == 1){ # testStatistics[1, k] <- simLogRanks[1, k] # populationEventsPerStage[1, k] <- eventsPerStage[1, k] # overallTestStatistics[1, k] <- sum(sqrt(eventsPerStage[1, 1:k]) * testStatistics[1, 1:k], na.rm = TRUE) / # sqrt(sum(eventsPerStage[1, 1:k], na.rm = TRUE)) # overallEffects[1, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[1, k] / # sqrt(const) / sqrt(sum(eventsPerStage[1, 1:k], na.rm = TRUE))) # } else if (gMax == 2){ # # Population S1 # testStatistics[1, k] <- simLogRanks[1, k] # populationEventsPerStage[1, k] <- eventsPerStage[1, k] # overallTestStatistics[1, k] <- sum(sqrt(eventsPerStage[1, 1:k]) * testStatistics[1, 1:k], na.rm = TRUE) / # sqrt(sum(eventsPerStage[1, 1:k], na.rm = TRUE)) # overallEffects[1, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[1, k] / # sqrt(const) / sqrt(sum(eventsPerStage[1, 1:k], na.rm = TRUE))) # # Full population # testStatistics[2, k] <- sum(sqrt(eventsPerStage[1:2, k]) * simLogRanks[1:2, k], na.rm = TRUE) / sqrt(sum(eventsPerStage[1:2, k], na.rm = TRUE)) # populationEventsPerStage[2, k] <- sum(eventsPerStage[1:2, k], na.rm = TRUE) # overallTestStatistics[2, k] <- sum(sqrt(populationEventsPerStage[2, 1:k]) * testStatistics[2, 1:k], na.rm = TRUE) / # sqrt(sum(populationEventsPerStage[2, 1:k], na.rm = TRUE)) # overallEffects[2, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[2, k] / # sqrt(const) / sqrt(sum(populationEventsPerStage[2, 1:k], na.rm = TRUE))) # # } else if (gMax == 3){ # # Population S1 # testStatistics[1, k] <- sum(sqrt(eventsPerStage[c(1,3), k]) * simLogRanks[c(1,3), k], na.rm = TRUE) / sqrt(sum(eventsPerStage[c(1,3), k], na.rm = TRUE)) # populationEventsPerStage[1, k] <- sum(eventsPerStage[c(1,3), k], na.rm = TRUE) # overallTestStatistics[1, k] <- sum(sqrt(populationEventsPerStage[1, 1:k]) * testStatistics[1, 1:k], na.rm = TRUE) / # sqrt(sum(populationEventsPerStage[1, 1:k], na.rm = TRUE)) # overallEffects[1, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[1, k] / # sqrt(const) / sqrt(sum(populationEventsPerStage[1, 1:k], na.rm = TRUE))) # # Population S2 # testStatistics[2, k] <- sum(sqrt(eventsPerStage[c(2,3), k]) * simLogRanks[c(2,3), k], na.rm = TRUE) / sqrt(sum(eventsPerStage[c(2,3), k], na.rm = TRUE)) # populationEventsPerStage[2, k] <- sum(eventsPerStage[c(2,3), k], na.rm = TRUE) # overallTestStatistics[2, k] <- sum(sqrt(populationEventsPerStage[2, 1:k]) * testStatistics[2, 1:k], na.rm = TRUE) / # sqrt(sum(populationEventsPerStage[2, 1:k], na.rm = TRUE)) # overallEffects[2, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[2, k] / # sqrt(const) / sqrt(sum(populationEventsPerStage[2, 1:k], na.rm = TRUE))) # # Full population # testStatistics[3, k] <- sum(sqrt(eventsPerStage[1:4, k]) * simLogRanks[1:4, k], na.rm = TRUE) / sqrt(sum(eventsPerStage[1:4, k], na.rm = TRUE)) # populationEventsPerStage[3, k] <- sum(eventsPerStage[1:4, k], na.rm = TRUE) # overallTestStatistics[3, k] <- sum(sqrt(populationEventsPerStage[3, 1:k]) * testStatistics[3, 1:k], na.rm = TRUE) / # sqrt(sum(populationEventsPerStage[3, 1:k], na.rm = TRUE)) # overallEffects[3, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[3, k] / # sqrt(const) / sqrt(sum(populationEventsPerStage[3, 1:k], na.rm = TRUE))) # # } else if (gMax == 4){ # # Population S1 # testStatistics[1, k] <- sum(sqrt(eventsPerStage[c(1,4,5,7), k]) * simLogRanks[c(1,4,5,7), k], na.rm = TRUE) / sqrt(sum(eventsPerStage[c(1,4,5,7), k], na.rm = TRUE)) # populationEventsPerStage[1, k] <- sum(eventsPerStage[c(1,4,5,7), k], na.rm = TRUE) # overallTestStatistics[1, k] <- sum(sqrt(populationEventsPerStage[1, 1:k]) * testStatistics[1, 1:k], na.rm = TRUE) / # sqrt(sum(populationEventsPerStage[1, 1:k], na.rm = TRUE)) # overallEffects[1, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[1, k] / # sqrt(const) / sqrt(sum(populationEventsPerStage[1, 1:k], na.rm = TRUE))) # # Population S2 # testStatistics[2, k] <- sum(sqrt(eventsPerStage[c(2,4,6,7), k]) * simLogRanks[c(2,4,6,7), k], na.rm = TRUE) / sqrt(sum(eventsPerStage[c(2,4,6,7), k], na.rm = TRUE)) # populationEventsPerStage[2, k] <- sum(eventsPerStage[c(2,4,6,7), k], na.rm = TRUE) # overallTestStatistics[2, k] <- sum(sqrt(populationEventsPerStage[2, 1:k]) * testStatistics[2, 1:k], na.rm = TRUE) / # sqrt(sum(populationEventsPerStage[2, 1:k], na.rm = TRUE)) # overallEffects[2, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[2, k] / # sqrt(const) / sqrt(sum(populationEventsPerStage[2, 1:k], na.rm = TRUE))) # # Population S3 # testStatistics[3, k] <- sum(sqrt(eventsPerStage[c(3,5,6,7), k]) * simLogRanks[c(3,5,6,7), k], na.rm = TRUE) / sqrt(sum(eventsPerStage[c(3,5,6,7), k], na.rm = TRUE)) # populationEventsPerStage[3, k] <- sum(eventsPerStage[c(3,5,6,7), k], na.rm = TRUE) # overallTestStatistics[3, k] <- sum(sqrt(populationEventsPerStage[3, 1:k]) * testStatistics[3, 1:k], na.rm = TRUE) / # sqrt(sum(populationEventsPerStage[3, 1:k], na.rm = TRUE)) # overallEffects[3, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[3, k] / # sqrt(const) / sqrt(sum(populationEventsPerStage[3, 1:k], na.rm = TRUE))) # # Full population # testStatistics[4, k] <- sum(sqrt(eventsPerStage[1:8, k]) * simLogRanks[1:8, k], na.rm = TRUE) / sqrt(sum(eventsPerStage[1:8, k], na.rm = TRUE)) # populationEventsPerStage[4, k] <- sum(eventsPerStage[1:8, k], na.rm = TRUE) # overallTestStatistics[4, k] <- sum(sqrt(populationEventsPerStage[4, 1:k]) * testStatistics[4, 1:k], na.rm = TRUE) / # sqrt(sum(populationEventsPerStage[4, 1:k], na.rm = TRUE)) # overallEffects[4, k] <- exp((2 * directionUpper - 1) * overallTestStatistics[4, k] / # sqrt(const) / sqrt(sum(populationEventsPerStage[4, 1:k], na.rm = TRUE))) # } testStatistics[!selectedPopulations[, k], k] <- NA_real_ overallEffects[!selectedPopulations[, k], k] <- NA_real_ overallTestStatistics[!selectedPopulations[, k], k] <- NA_real_ separatePValues[, k] <- 1 - stats::pnorm(testStatistics[, k]) if (k < kMax) { if (colSums(selectedPopulations)[k] == 0) { break } # Bonferroni adjustment adjustedPValues[k] <- min(min(separatePValues[, k], na.rm = TRUE) * (colSums(selectedPopulations)[k]), 1 - 1e-7) # conditional critical value to reject the null hypotheses at the next stage of the trial if (.isTrialDesignFisher(design)) { conditionalCriticalValue[k] <- .getOneMinusQNorm(min((design$criticalValues[k + 1] / prod(adjustedPValues[1:k]^weights[1:k]))^(1 / weights[k + 1]), 1 - 1e-7)) } else { conditionalCriticalValue[k] <- (design$criticalValues[k + 1] * sqrt(design$informationRates[k + 1]) - .getOneMinusQNorm(adjustedPValues[1:k]) %*% weights[1:k]) / sqrt(design$informationRates[k + 1] - design$informationRates[k]) } if (adaptations[k]) { if (effectMeasure == "testStatistic") { selectedPopulations[, k + 1] <- (selectedPopulations[, k] & .selectPopulations( k, overallTestStatistics[, k], typeOfSelection, epsilonValue, rValue, threshold, selectPopulationsFunction )) } else if (effectMeasure == "effectEstimate") { if (directionUpper) { selectedPopulations[, k + 1] <- (selectedPopulations[, k] & .selectPopulations( k, overallEffects[, k], typeOfSelection, epsilonValue, rValue, threshold, selectPopulationsFunction )) } else { selectedPopulations[, k + 1] <- (selectedPopulations[, k] & .selectPopulations( k, 1 / overallEffects[, k], typeOfSelection, epsilonValue, rValue, 1 / threshold, selectPopulationsFunction )) } } newEvents <- calcEventsFunction( stage = k + 1, # to be consistent with non-enrichment situation, cf. line 38 directionUpper = directionUpper, conditionalPower = conditionalPower, conditionalCriticalValue = conditionalCriticalValue, plannedEvents = plannedEvents, allocationRatioPlanned = allocationRatioPlanned, selectedPopulations = selectedPopulations, thetaH1 = thetaH1, overallEffects = overallEffects, minNumberOfEventsPerStage = minNumberOfEventsPerStage, maxNumberOfEventsPerStage = maxNumberOfEventsPerStage ) if (is.null(newEvents) || length(newEvents) != 1 || !is.numeric(newEvents) || is.na(newEvents)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'calcEventsFunction' returned an illegal or undefined result (", newEvents, "); ", "the output must be a single numeric value" ) } if (!is.na(conditionalPower) || calcEventsFunctionIsUserDefined) { plannedEvents[(k + 1):kMax] <- plannedEvents[k] + cumsum(rep(newEvents, kMax - k)) } } else { selectedPopulations[, k + 1] <- selectedPopulations[, k] } if (is.na(thetaH1)) { if (directionUpper) { thetaStandardized <- log(min(overallEffects[selectedPopulations[1:gMax, k], k], na.rm = TRUE)) } else { thetaStandardized <- log(max(overallEffects[selectedPopulations[1:gMax, k], k], na.rm = TRUE)) } } else { thetaStandardized <- log(thetaH1) } thetaStandardized <- (2 * directionUpper - 1) * thetaStandardized conditionalPowerPerStage[k] <- 1 - stats::pnorm(conditionalCriticalValue[k] - thetaStandardized * sqrt(plannedEvents[k + 1] - plannedEvents[k]) * sqrt(const)) } } return(list( eventsPerStage = eventsPerStage, plannedEvents = plannedEvents, allocationRatioPlanned = allocationRatioPlanned, overallEffects = overallEffects, testStatistics = testStatistics, overallTestStatistics = overallTestStatistics, separatePValues = separatePValues, conditionalCriticalValue = conditionalCriticalValue, conditionalPowerPerStage = conditionalPowerPerStage, selectedPopulations = selectedPopulations )) } #' #' @title #' Get Simulation Enrichment Survival #' #' @description #' Returns the simulated power, stopping and selection probabilities, conditional power, #' and expected sample size for testing hazard ratios in an enrichment design testing situation. #' In contrast to \code{getSimulationSurvival()} (where survival times are simulated), normally #' distributed logrank test statistics are simulated. #' #' @inheritParams param_intersectionTest_Enrichment #' @inheritParams param_typeOfSelection #' @inheritParams param_effectMeasure #' @inheritParams param_adaptations #' @inheritParams param_threshold #' @inheritParams param_effectList #' @inheritParams param_populations #' @inheritParams param_successCriterion #' @inheritParams param_typeOfSelection #' @inheritParams param_design_with_default #' @inheritParams param_directionUpper #' @inheritParams param_allocationRatioPlanned #' @inheritParams param_minNumberOfEventsPerStage #' @inheritParams param_maxNumberOfEventsPerStage #' @inheritParams param_conditionalPowerSimulation #' @inheritParams param_thetaH1 #' @inheritParams param_plannedEvents #' @inheritParams param_maxNumberOfIterations #' @inheritParams param_calcEventsFunction #' @inheritParams param_selectPopulationsFunction #' @inheritParams param_rValue #' @inheritParams param_epsilonValue #' @inheritParams param_seed #' @inheritParams param_three_dots #' @inheritParams param_showStatistics #' @inheritParams param_stratifiedAnalysis #' #' @details #' At given design the function simulates the power, stopping probabilities, #' selection probabilities, and expected event number at given number of events, #' parameter configuration, and population selection rule in the enrichment situation. #' An allocation ratio can be specified referring to the ratio of number of subjects #' in the active treatment group as compared to the control group. #' #' The definition of \code{thetaH1} makes only sense if \code{kMax} > 1 #' and if \code{conditionalPower}, \code{minNumberOfEventsPerStage}, and #' \code{maxNumberOfEventsPerStage} (or \code{calcEventsFunction}) are defined. #' #' \code{calcEventsFunction}\cr #' This function returns the number of events at given conditional power #' and conditional critical value for specified testing situation. #' The function might depend on the variables #' \code{stage}, #' \code{selectedPopulations}, #' \code{plannedEvents}, #' \code{directionUpper}, #' \code{allocationRatioPlanned}, #' \code{minNumberOfEventsPerStage}, #' \code{maxNumberOfEventsPerStage}, #' \code{conditionalPower}, #' \code{conditionalCriticalValue}, and #' \code{overallEffects}. #' The function has to contain the three-dots argument '...' (see examples). #' #' @template return_object_simulation_results #' @template how_to_get_help_for_generics #' #' @template examples_get_simulation_enrichment_survival #' #' @export #' getSimulationEnrichmentSurvival <- function(design = NULL, ..., populations = NA_integer_, # C_POPULATIONS_DEFAULT effectList = NULL, intersectionTest = c("Simes", "SpiessensDebois", "Bonferroni", "Sidak"), # C_INTERSECTION_TEST_ENRICHMENT_DEFAULT stratifiedAnalysis = TRUE, # C_STRATIFIED_ANALYSIS_DEFAULT directionUpper = TRUE, # C_DIRECTION_UPPER_DEFAULT adaptations = NA, typeOfSelection = c("best", "rBest", "epsilon", "all", "userDefined"), # C_TYPE_OF_SELECTION_DEFAULT effectMeasure = c("effectEstimate", "testStatistic"), # C_EFFECT_MEASURE_DEFAULT successCriterion = c("all", "atLeastOne"), # C_SUCCESS_CRITERION_DEFAULT epsilonValue = NA_real_, rValue = NA_real_, threshold = -Inf, plannedEvents = NA_real_, allocationRatioPlanned = NA_real_, minNumberOfEventsPerStage = NA_real_, maxNumberOfEventsPerStage = NA_real_, conditionalPower = NA_real_, thetaH1 = NA_real_, maxNumberOfIterations = 1000L, # C_MAX_SIMULATION_ITERATIONS_DEFAULT seed = NA_real_, calcEventsFunction = NULL, selectPopulationsFunction = NULL, showStatistics = FALSE) { if (is.null(design)) { design <- .getDefaultDesign(..., type = "simulation") .warnInCaseOfUnknownArguments( functionName = "getSimulationEnrichmentSurvival", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "showStatistics"), ... ) } else { .assertIsTrialDesignInverseNormalOrFisher(design) .warnInCaseOfUnknownArguments(functionName = "getSimulationEnrichmentSurvival", ignore = "showStatistics", ...) .warnInCaseOfTwoSidedPowerArgument(...) } .assertIsOneSidedDesign(design, designType = "enrichment", engineType = "simulation") calcEventsFunctionIsUserDefined <- !is.null(calcEventsFunction) simulationResults <- .createSimulationResultsEnrichmentObject( design = design, populations = populations, effectList = effectList, intersectionTest = intersectionTest, stratifiedAnalysis = stratifiedAnalysis, directionUpper = directionUpper, # rates + survival only adaptations = adaptations, typeOfSelection = typeOfSelection, effectMeasure = effectMeasure, successCriterion = successCriterion, epsilonValue = epsilonValue, rValue = rValue, threshold = threshold, plannedEvents = plannedEvents, # survival only allocationRatioPlanned = allocationRatioPlanned, minNumberOfEventsPerStage = minNumberOfEventsPerStage, # survival only maxNumberOfEventsPerStage = maxNumberOfEventsPerStage, # survival only conditionalPower = conditionalPower, thetaH1 = thetaH1, # means + survival only maxNumberOfIterations = maxNumberOfIterations, seed = seed, calcEventsFunction = calcEventsFunction, # survival only selectPopulationsFunction = selectPopulationsFunction, showStatistics = showStatistics, endpoint = "survival" ) design <- simulationResults$.design successCriterion <- simulationResults$successCriterion effectMeasure <- simulationResults$effectMeasure adaptations <- simulationResults$adaptations gMax <- simulationResults$populations kMax <- simulationResults$.design$kMax intersectionTest <- simulationResults$intersectionTest typeOfSelection <- simulationResults$typeOfSelection effectList <- simulationResults$effectList thetaH1 <- simulationResults$thetaH1 # means + survival only plannedEvents <- simulationResults$plannedEvents # survival only conditionalPower <- simulationResults$conditionalPower minNumberOfEventsPerStage <- simulationResults$minNumberOfEventsPerStage # survival only maxNumberOfEventsPerStage <- simulationResults$maxNumberOfEventsPerStage # survival only allocationRatioPlanned <- simulationResults$allocationRatioPlanned calcEventsFunction <- simulationResults$calcEventsFunction indices <- .getIndicesOfClosedHypothesesSystemForSimulation(gMax = gMax) cols <- nrow(effectList$hazardRatios) simulatedSelections <- array(0, dim = c(kMax, cols, gMax)) simulatedRejections <- array(0, dim = c(kMax, cols, gMax)) simulatedNumberOfPopulations <- matrix(0, nrow = kMax, ncol = cols) simulatedSingleEventsPerStage <- array(0, dim = c(kMax, cols, 2^(gMax - 1))) simulatedOverallEventsPerStage <- matrix(0, nrow = kMax, ncol = cols) simulatedSuccessStopping <- matrix(0, nrow = kMax, ncol = cols) simulatedFutilityStopping <- matrix(0, nrow = kMax - 1, ncol = cols) simulatedConditionalPower <- matrix(0, nrow = kMax, ncol = cols) simulatedRejectAtLeastOne <- rep(0, cols) expectedNumberOfEvents <- rep(0, cols) iterations <- matrix(0, nrow = kMax, ncol = cols) len <- maxNumberOfIterations * kMax * gMax * cols dataIterationNumber <- rep(NA_real_, len) dataStageNumber <- rep(NA_real_, len) dataArmNumber <- rep(NA_real_, len) dataAlternative <- rep(NA_real_, len) dataEffect <- rep(NA_real_, len) dataNumberOfEvents <- rep(NA_real_, len) dataRejectPerStage <- rep(NA, len) dataFutilityStop <- rep(NA_real_, len) dataSuccessStop <- rep(NA, len) dataFutilityStop <- rep(NA, len) dataTestStatistics <- rep(NA_real_, len) dataConditionalCriticalValue <- rep(NA_real_, len) dataConditionalPowerAchieved <- rep(NA_real_, len) dataEffectEstimate <- rep(NA_real_, len) dataPValuesSeparate <- rep(NA_real_, len) index <- 1 for (i in 1:cols) { for (j in 1:maxNumberOfIterations) { stageResults <- .getSimulatedStageSurvivalEnrichment( design = design, subsets = effectList$subsets, prevalences = effectList$prevalences, hazardRatios = effectList$hazardRatios[i, ], directionUpper = directionUpper, stratifiedAnalysis = stratifiedAnalysis, plannedEvents = plannedEvents, typeOfSelection = typeOfSelection, effectMeasure = effectMeasure, adaptations = adaptations, epsilonValue = epsilonValue, rValue = rValue, threshold = threshold, allocationRatioPlanned = allocationRatioPlanned, minNumberOfEventsPerStage = minNumberOfEventsPerStage, maxNumberOfEventsPerStage = maxNumberOfEventsPerStage, conditionalPower = conditionalPower, thetaH1 = thetaH1, calcEventsFunction = calcEventsFunction, calcEventsFunctionIsUserDefined = calcEventsFunctionIsUserDefined, selectPopulationsFunction = selectPopulationsFunction ) closedTest <- .performClosedCombinationTestForSimulationEnrichment( stageResults = stageResults, design = design, indices = indices, intersectionTest = intersectionTest, successCriterion = successCriterion ) rejectAtSomeStage <- FALSE rejectedPopulationsBefore <- rep(FALSE, gMax) for (k in 1:kMax) { simulatedRejections[k, i, ] <- simulatedRejections[k, i, ] + (closedTest$rejected[, k] & closedTest$selectedPopulations[1:gMax, k] | rejectedPopulationsBefore) simulatedSelections[k, i, ] <- simulatedSelections[k, i, ] + closedTest$selectedPopulations[, k] simulatedSingleEventsPerStage[k, i, ] <- simulatedSingleEventsPerStage[k, i, ] + stageResults$eventsPerStage[, k] simulatedNumberOfPopulations[k, i] <- simulatedNumberOfPopulations[k, i] + sum(closedTest$selectedPopulations[, k]) if (!any(is.na(closedTest$successStop))) { simulatedSuccessStopping[k, i] <- simulatedSuccessStopping[k, i] + closedTest$successStop[k] } if ((kMax > 1) && (k < kMax)) { if (!any(is.na(closedTest$futilityStop))) { simulatedFutilityStopping[k, i] <- simulatedFutilityStopping[k, i] + (closedTest$futilityStop[k] && !closedTest$successStop[k]) } if (!closedTest$successStop[k] && !closedTest$futilityStop[k]) { simulatedConditionalPower[k + 1, i] <- simulatedConditionalPower[k + 1, i] + stageResults$conditionalPowerPerStage[k] } } iterations[k, i] <- iterations[k, i] + 1 if (k == 1) { simulatedOverallEventsPerStage[k, i] <- simulatedOverallEventsPerStage[k, i] + stageResults$plannedEvents[k] } else { simulatedOverallEventsPerStage[k, i] <- simulatedOverallEventsPerStage[k, i] + stageResults$plannedEvents[k] - stageResults$plannedEvents[k - 1] } for (g in 1:gMax) { dataIterationNumber[index] <- j dataStageNumber[index] <- k dataArmNumber[index] <- g dataAlternative[index] <- i dataEffect[index] <- effectList$hazardRatios[i, g] dataNumberOfEvents[index] <- round(stageResults$eventsPerStage[g, k], 1) dataRejectPerStage[index] <- closedTest$rejected[g, k] dataTestStatistics[index] <- stageResults$testStatistics[g, k] dataSuccessStop[index] <- closedTest$successStop[k] if (k < kMax) { dataFutilityStop[index] <- closedTest$futilityStop[k] dataConditionalCriticalValue[index] <- stageResults$conditionalCriticalValue[k] dataConditionalPowerAchieved[index + 1] <- stageResults$conditionalPowerPerStage[k] } dataEffectEstimate[index] <- stageResults$overallEffects[g, k] dataPValuesSeparate[index] <- closedTest$separatePValues[g, k] index <- index + 1 } if (!rejectAtSomeStage && any(closedTest$rejected[, k] & closedTest$selectedPopulations[1:gMax, k] | rejectedPopulationsBefore)) { simulatedRejectAtLeastOne[i] <- simulatedRejectAtLeastOne[i] + 1 rejectAtSomeStage <- TRUE } if ((k < kMax) && (closedTest$successStop[k] || closedTest$futilityStop[k])) { # rejected hypotheses remain rejected also in case of early stopping simulatedRejections[(k + 1):kMax, i, ] <- simulatedRejections[(k + 1):kMax, i, ] + matrix((closedTest$rejected[, k] & closedTest$selectedPopulations[1:gMax, k] | rejectedPopulationsBefore), kMax - k, gMax, byrow = TRUE ) break } rejectedPopulationsBefore <- closedTest$rejected[, k] & closedTest$selectedPopulations[1:gMax, k] | rejectedPopulationsBefore } } simulatedSingleEventsPerStage[, i, ] <- simulatedSingleEventsPerStage[, i, ] / iterations[, i] simulatedOverallEventsPerStage[, i] <- simulatedOverallEventsPerStage[, i] / iterations[, i] if (kMax > 1) { simulatedRejections[2:kMax, i, ] <- simulatedRejections[2:kMax, i, ] - simulatedRejections[1:(kMax - 1), i, ] stopping <- cumsum(simulatedSuccessStopping[1:(kMax - 1), i] + simulatedFutilityStopping[, i]) / maxNumberOfIterations expectedNumberOfEvents[i] <- simulatedOverallEventsPerStage[1, i] + t(1 - stopping) %*% simulatedOverallEventsPerStage[2:kMax, i] } else { expectedNumberOfEvents[i] <- simulatedOverallEventsPerStage[1, i] } } simulatedConditionalPower[1, ] <- NA_real_ if (kMax > 1) { simulatedConditionalPower[2:kMax, ] <- simulatedConditionalPower[2:kMax, ] / iterations[2:kMax, ] } simulationResults$rejectAtLeastOne <- simulatedRejectAtLeastOne / maxNumberOfIterations simulationResults$numberOfPopulations <- simulatedNumberOfPopulations / iterations simulationResults$selectedPopulations <- simulatedSelections / maxNumberOfIterations simulationResults$rejectedPopulationsPerStage <- simulatedRejections / maxNumberOfIterations simulationResults$successPerStage <- simulatedSuccessStopping / maxNumberOfIterations simulationResults$futilityPerStage <- simulatedFutilityStopping / maxNumberOfIterations simulationResults$futilityStop <- base::colSums(simulatedFutilityStopping / maxNumberOfIterations) if (kMax > 1) { simulationResults$earlyStop <- simulationResults$futilityPerStage + simulationResults$successPerStage[1:(kMax - 1), ] simulationResults$conditionalPowerAchieved <- simulatedConditionalPower } simulationResults$singleNumberOfEventsPerStage <- simulatedSingleEventsPerStage simulationResults$.setParameterType("singleNumberOfEventsPerStage", C_PARAM_GENERATED) simulationResults$expectedNumberOfEvents <- expectedNumberOfEvents simulationResults$iterations <- iterations if (!all(is.na(simulationResults$conditionalPowerAchieved))) { simulationResults$.setParameterType("conditionalPowerAchieved", C_PARAM_GENERATED) } if (any(simulationResults$rejectedPopulationsPerStage < 0)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "internal error, simulation not possible due to numerical overflow") } data <- data.frame( iterationNumber = dataIterationNumber, stageNumber = dataStageNumber, populationNumber = dataArmNumber, omegaMax = dataAlternative, effect = dataEffect, numberOfEvents = dataNumberOfEvents, effectEstimate = dataEffectEstimate, testStatistics = dataTestStatistics, pValue = dataPValuesSeparate, conditionalCriticalValue = round(dataConditionalCriticalValue, 6), conditionalPowerAchieved = round(dataConditionalPowerAchieved, 6), rejectPerStage = dataRejectPerStage, successStop = dataSuccessStop, futilityPerStage = dataFutilityStop ) data <- data[!is.na(data$effectEstimate), ] simulationResults$.data <- data return(simulationResults) } rpact/R/f_analysis_multiarm.R0000644000175000017500000015364214150167045016121 0ustar nileshnilesh## | ## | *Analysis of multi-arm designs with adaptive test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5594 $ ## | Last changed: $Date: 2021-11-26 15:24:35 +0100 (Fr, 26 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | # # @title # Get Multi-Armed Analysis Results # # @description # Calculates and returns the analysis results for the specified design and data. # .getAnalysisResultsMultiArm <- function(design, dataInput, ..., intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, thetaH0 = NA_real_, nPlanned = NA_real_) { .assertIsTrialDesignInverseNormalOrFisherOrConditionalDunnett(design) .assertIsValidIntersectionTestMultiArm(design, intersectionTest) .assertIsOneSidedDesign(design, designType = "multi-arm", engineType = "analysis") stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design, showWarnings = TRUE) .assertIsSingleLogical(directionUpper, "directionUpper") .assertIsValidDataInput(dataInput = dataInput, design = design, stage = stage) on.exit(dataInput$.trim()) .assertIsValidThetaH0DataInput(thetaH0, dataInput) .assertIsValidNPlanned(nPlanned, design$kMax, stage, required = FALSE) intersectionTest <- .getCorrectedIntersectionTestMultiArmIfNecessary(design, intersectionTest) if (dataInput$isDatasetMeans()) { if (is.na(thetaH0)) { thetaH0 <- C_THETA_H0_MEANS_DEFAULT } return(.getAnalysisResultsMeansMultiArm( design = design, dataInput = dataInput, intersectionTest = intersectionTest, directionUpper = directionUpper, thetaH0 = thetaH0, nPlanned = nPlanned, stage = stage, ... )) } if (dataInput$isDatasetRates()) { if (is.na(thetaH0)) { thetaH0 <- C_THETA_H0_RATES_DEFAULT } return(.getAnalysisResultsRatesMultiArm( design = design, dataInput = dataInput, intersectionTest = intersectionTest, directionUpper = directionUpper, thetaH0 = thetaH0, nPlanned = nPlanned, stage = stage, ... )) } if (dataInput$isDatasetSurvival()) { if (is.na(thetaH0)) { thetaH0 <- C_THETA_H0_SURVIVAL_DEFAULT } return(.getAnalysisResultsSurvivalMultiArm( design = design, dataInput = dataInput, intersectionTest = intersectionTest, directionUpper = directionUpper, thetaH0 = thetaH0, nPlanned = nPlanned, stage = stage, ... )) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(dataInput), "' is not implemented yet") } # # Get Stage Results # Returns summary statistics and p-values for a given data set and a given multi-arm design. # .getStageResultsMultiArm <- function(design, dataInput, ...) { .assertIsTrialDesignInverseNormalOrFisherOrConditionalDunnett(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .assertIsValidDataInput(dataInput = dataInput, design = design, stage = stage) on.exit(dataInput$.trim()) if (dataInput$isDatasetMeans()) { return(.getStageResultsMeansMultiArm(design = design, dataInput = dataInput, userFunctionCallEnabled = TRUE, ...)) } if (dataInput$isDatasetRates()) { return(.getStageResultsRatesMultiArm(design = design, dataInput = dataInput, userFunctionCallEnabled = TRUE, ...)) } if (dataInput$isDatasetSurvival()) { return(.getStageResultsSurvivalMultiArm(design = design, dataInput = dataInput, userFunctionCallEnabled = TRUE, ...)) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(dataInput), "' is not supported") } # Get Repeated Confidence Intervals for multi-arm case # Calculates and returns the lower and upper limit of the repeated confidence intervals of the trial for multi-arm designs. # .getRepeatedConfidenceIntervalsMultiArm <- function(design, dataInput, ...) { .assertIsTrialDesignInverseNormalOrFisherOrConditionalDunnett(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .assertIsValidDataInput(dataInput = dataInput, design = design, stage = stage) on.exit(dataInput$.trim()) if (dataInput$isDatasetMeans()) { return(.getRepeatedConfidenceIntervalsMeansMultiArm( design = design, dataInput = dataInput, ... )) } if (dataInput$isDatasetRates()) { return(.getRepeatedConfidenceIntervalsRatesMultiArm( design = design, dataInput = dataInput, ... )) } if (dataInput$isDatasetSurvival()) { return(.getRepeatedConfidenceIntervalsSurvivalMultiArm( design = design, dataInput = dataInput, ... )) } stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(dataInput), "' is not implemented yet") } # # Get Conditional Power for multi-arm case # Calculates and returns the conditional power for multi-arm case. # .getConditionalPowerMultiArm <- function(..., stageResults, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT) { .assertIsStageResults(stageResults) if (stageResults$isDatasetMeans()) { if ("assumedStDev" %in% names(list(...))) { warning("For multi-arm analysis the argument for assumed standard deviation ", "is named 'assumedStDevs' and not 'assumedStDev'", call. = FALSE ) } return(.getConditionalPowerMeansMultiArm( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... )) } if (stageResults$isDatasetRates()) { return(.getConditionalPowerRatesMultiArm( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... )) } if (stageResults$isDatasetSurvival()) { return(.getConditionalPowerSurvivalMultiArm( stageResults = stageResults, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, ... )) } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(stageResults$.dataInput), "' is not implemented yet" ) } .getIndicesOfClosedHypothesesSystem <- function(gMax) { indices <- as.data.frame(expand.grid(rep(list(1:0), gMax)))[1:(2^gMax - 1), ] if (gMax == 1) { return(as.matrix(indices)) } y <- 10^(ncol(indices):1) indices$pos <- (as.matrix(indices) %*% y / 10) indices$sum <- as.numeric(rowSums(indices[, 1:gMax])) indices <- indices[order(indices$sum, indices$pos, decreasing = c(TRUE, TRUE)), ] indices <- indices[, 1:gMax] rownames(indices) <- as.character(1:nrow(indices)) return(as.matrix(indices)) } .getMultivariateDistribution <- function(..., type = c("normal", "t", "quantile"), upper, sigma, df = NA_real_, alpha = NA_real_) { .assertMnormtIsInstalled() type <- match.arg(type) if (type == "normal") { return(mnormt::sadmvn(lower = -Inf, upper = upper, mean = 0, varcov = sigma)) } else if (type == "t") { return(mnormt::sadmvt(lower = -Inf, upper = upper, mean = 0, S = sigma, df = df)) } else if (type == "quantile") { return(.getOneDimensionalRoot( function(x) { return(mnormt::pmnorm(x, varcov = sigma) - (1 - alpha)) }, lower = -8, upper = 8, tolerance = 1e-08, callingFunctionInformation = ".getMultivariateDistribution" )) } } .performClosedCombinationTest <- function(..., stageResults, design = stageResults$.design, intersectionTest = stageResults$intersectionTest) { dataInput <- stageResults$.dataInput stage <- stageResults$stage gMax <- stageResults$getGMax() kMax <- design$kMax indices <- .getIndicesOfClosedHypothesesSystem(gMax = gMax) adjustedStageWisePValues <- matrix(NA_real_, nrow = 2^gMax - 1, ncol = kMax) adjustedOverallPValues <- matrix(NA_real_, nrow = 2^gMax - 1, ncol = kMax) overallAdjustedTestStatistics <- matrix(NA_real_, nrow = 2^gMax - 1, ncol = kMax) rejected <- matrix(NA, nrow = gMax, ncol = kMax) colnames(adjustedStageWisePValues) <- paste("stage ", (1:kMax), sep = "") colnames(overallAdjustedTestStatistics) <- paste("stage ", (1:kMax), sep = "") dimnames(rejected) <- list(paste("arm ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "")) rejectedIntersections <- matrix(rep(FALSE, stage * nrow(indices)), nrow(indices), stage) rejectedIntersectionsBefore <- matrix(rep(FALSE, nrow(indices)), nrow(indices), 1) if (.isTrialDesignFisher(design)) { weightsFisher <- .getWeightsFisher(design) } else { weightsInverseNormal <- .getWeightsInverseNormal(design) } for (k in 1:stage) { for (i in 1:(2^gMax - 1)) { if (!all(is.na(stageResults$separatePValues[indices[i, ] == 1, k]))) { if ((intersectionTest == "Dunnett") || (intersectionTest == "SpiessensDebois")) { sigma <- 1 if (grepl("MultiArm", class(stageResults))) { if (.isStageResultsMultiArmSurvival(stageResults)) { allocationRatiosSelected <- as.numeric(na.omit( dataInput$getAllocationRatios(stage = k, group = 1:gMax)[indices[i, ] == 1] )) sigma <- sqrt(allocationRatiosSelected / (1 + allocationRatiosSelected)) %*% sqrt(t(allocationRatiosSelected / (1 + allocationRatiosSelected))) } else { sampleSizesSelected <- as.numeric(na.omit( dataInput$getSampleSizes(stage = k, group = 1:gMax)[indices[i, ] == 1] )) sigma <- sqrt(sampleSizesSelected / (sampleSizesSelected + dataInput$getSampleSizes(stage = k, group = gMax + 1))) %*% sqrt(t(sampleSizesSelected / (sampleSizesSelected + dataInput$getSampleSizes(stage = k, group = gMax + 1)))) } } else { if (.isStageResultsEnrichmentSurvival(stageResults)) { eventsSelected <- as.numeric(na.omit( dataInput$getEvents(stage = k, group = 1)[indices[i, ] == 1] )) if (length(eventsSelected) == 2) { if (dataInput$isStratified()) { sigma <- matrix(rep(sqrt(dataInput$getEvents(stage = k, subset = "S1") / sum(dataInput$getEvents(stage = k))), 4), nrow = 2) } else { sigma <- matrix(rep(sqrt(dataInput$getEvents(stage = k, subset = "S1") / dataInput$getEvents(stage = k, subset = "F")), 4), nrow = 2) } } } else { sampleSizesSelected <- as.numeric(na.omit( dataInput$getSampleSizes(stage = k, group = 1)[indices[i, ] == 1] )) if (length(sampleSizesSelected) == 2) { if (dataInput$isStratified()) { sigma <- matrix(rep(sqrt(sum(dataInput$getSampleSizes(stage = k, subset = "S1")) / sum(dataInput$getSampleSizes(stage = k))), 4), nrow = 2) } else { sigma <- matrix(rep(sqrt(sum(dataInput$getSampleSizes(stage = k, subset = "S1")) / sum(dataInput$getSampleSizes(stage = k, subset = "F"))), 4), nrow = 2) } } } } if (is.matrix(sigma)) { diag(sigma) <- 1 } if (stageResults$directionUpper) { maxTestStatistic <- max(stageResults$testStatistics[indices[i, ] == 1, k], na.rm = TRUE) } else { maxTestStatistic <- max(-stageResults$testStatistics[indices[i, ] == 1, k], na.rm = TRUE) } df <- NA_real_ if (.isStageResultsMultiArmMeans(stageResults)) { if (!stageResults$normalApproximation) { df <- sum(dataInput$getSampleSizes(stage = k) - 1, na.rm = TRUE) } adjustedStageWisePValues[i, k] <- 1 - .getMultivariateDistribution( type = ifelse(stageResults$normalApproximation, "normal", "t"), upper = maxTestStatistic, sigma = sigma, df = df ) } else if (.isStageResultsEnrichmentMeans(stageResults)) { if (length(sampleSizesSelected) == 1) { adjustedStageWisePValues[i, k] <- stageResults$separatePValues[min(which(indices[i, ] == 1)), k] } else { if (!stageResults$normalApproximation) { if (dataInput$isStratified()) { df <- sum(dataInput$getSampleSizes(stage = k) - 1, na.rm = TRUE) } else { df <- sum(dataInput$getSampleSizes(stage = k, subset = "F") - 2, na.rm = TRUE) } } adjustedStageWisePValues[i, k] <- 1 - .getMultivariateDistribution( type = ifelse(stageResults$normalApproximation, "normal", "t"), upper = maxTestStatistic, sigma = sigma, df = df ) } } else { adjustedStageWisePValues[i, k] <- 1 - .getMultivariateDistribution( type = "normal", upper = maxTestStatistic, sigma = sigma, df = df ) } } # Bonferroni adjusted p-values else if (intersectionTest == "Bonferroni") { adjustedStageWisePValues[i, k] <- min(c(sum(indices[ i, !is.na(stageResults$separatePValues[, k]) ]) * min(stageResults$separatePValues[indices[i, ] == 1, k], na.rm = TRUE), 1)) } # Simes adjusted p-values else if (intersectionTest == "Simes") { adjustedStageWisePValues[i, k] <- min(sum(indices[ i, !is.na(stageResults$separatePValues[, k]) ]) / (1:sum(indices[i, !is.na(stageResults$separatePValues[, k])])) * sort(stageResults$separatePValues[indices[i, ] == 1, k])) } # Sidak adjusted p-values else if (intersectionTest == "Sidak") { adjustedStageWisePValues[i, k] <- 1 - (1 - min(stageResults$separatePValues[indices[i, ] == 1, k], na.rm = TRUE))^ sum(indices[i, !is.na(stageResults$separatePValues[, k])]) } # Hierarchically ordered hypotheses else if (intersectionTest == "Hierarchical") { separatePValues <- stageResults$separatePValues separatePValues[is.na(separatePValues[, 1:stage])] <- 1 adjustedStageWisePValues[i, k] <- separatePValues[min(which(indices[i, ] == 1)), k] } if (.isTrialDesignFisher(design)) { overallAdjustedTestStatistics[i, k] <- prod(adjustedStageWisePValues[i, 1:k]^weightsFisher[1:k]) } else { overallAdjustedTestStatistics[i, k] <- (weightsInverseNormal[1:k] %*% .getOneMinusQNorm(adjustedStageWisePValues[i, 1:k])) / sqrt(sum(weightsInverseNormal[1:k]^2)) } } } if (.isTrialDesignFisher(design)) { rejectedIntersections[, k] <- (overallAdjustedTestStatistics[, k] <= design$criticalValues[k]) } else { rejectedIntersections[, k] <- (overallAdjustedTestStatistics[, k] >= design$criticalValues[k]) } rejectedIntersections[is.na(rejectedIntersections[, k]), k] <- FALSE rejectedIntersections[, k] <- rejectedIntersections[, k] | rejectedIntersectionsBefore rejectedIntersectionsBefore <- matrix(rejectedIntersections[, k], ncol = 1) for (j in 1:gMax) { rejected[j, k] <- all(rejectedIntersections[indices[, j] == 1, k], na.rm = TRUE) } } return(list( .design = design, intersectionTest = intersectionTest, separatePValues = stageResults$separatePValues, indices = indices, adjustedStageWisePValues = adjustedStageWisePValues, overallAdjustedTestStatistics = overallAdjustedTestStatistics, rejected = rejected, rejectedIntersections = rejectedIntersections )) } #' #' @title #' Get Closed Combination Test Results #' #' @description #' Calculates and returns the results from the closed combination test in multi-arm #' and population enrichment designs. #' #' @inheritParams param_stageResults #' #' @family analysis functions #' #' @template return_object_closed_combination_test_results #' @template how_to_get_help_for_generics #' #' @template examples_get_closed_combination_test_results #' #' @export #' getClosedCombinationTestResults <- function(stageResults) { .assertIsTrialDesignInverseNormalOrFisher(stageResults$.design) result <- .performClosedCombinationTest(stageResults = stageResults) return(ClosedCombinationTestResults( .design = result$.design, .enrichment = grepl("Enrichment", class(stageResults)), intersectionTest = result$intersectionTest, separatePValues = result$separatePValues, indices = result$indices, adjustedStageWisePValues = result$adjustedStageWisePValues, overallAdjustedTestStatistics = result$overallAdjustedTestStatistics, rejected = result$rejected, rejectedIntersections = result$rejectedIntersections )) } # # Repeated p-values for multi-arm designs # .getRepeatedPValuesMultiArm <- function(stageResults, ..., tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments(functionName = "getRepeatedPValuesMultiArm", ...) design <- stageResults$.design gMax <- stageResults$getGMax() kMax <- design$kMax repeatedPValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) if (.isTrialDesignInverseNormal(design)) { if (design$typeOfDesign == C_TYPE_OF_DESIGN_AS_USER) { warning("Repeated p-values not available for 'typeOfDesign' = '", C_TYPE_OF_DESIGN_AS_USER, "'", call. = FALSE ) return(repeatedPValues) } if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT_OPTIMUM) { warning("Repeated p-values not available for 'typeOfDesign' = '", C_TYPE_OF_DESIGN_WT_OPTIMUM, "'", call. = FALSE ) return(repeatedPValues) } } if (.isTrialDesignFisher(design) && design$method == C_FISHER_METHOD_USER_DEFINED_ALPHA) { warning("Repeated p-values not available for 'method' = '", C_FISHER_METHOD_USER_DEFINED_ALPHA, "'", call. = FALSE ) return(repeatedPValues) } startTime <- Sys.time() stage <- stageResults$stage if (.isTrialDesignConditionalDunnett(design)) { if (stage == 1 || stage > 2) { message("Repeated p-values can only be calculated for the second stage") return(repeatedPValues) } for (g in 1:gMax) { if (!is.na(stageResults$testStatistics[g, 2])) { prec <- 1 lower <- tolerance upper <- 0.5 maxSearchIterations <- 30 while (prec > tolerance && maxSearchIterations >= 0) { alpha <- (lower + upper) / 2 ctr <- .getClosedConditionalDunnettTestResults( design = getDesignConditionalDunnett( alpha = alpha, informationAtInterim = design$informationAtInterim, secondStageConditioning = design$secondStageConditioning ), stageResults = stageResults, stage = stage ) ifelse(ctr$rejected[g, 2], upper <- alpha, lower <- alpha) prec <- upper - lower maxSearchIterations <- maxSearchIterations - 1 } repeatedPValues[g, 2] <- upper } } .logProgress("Repeated p-values for final stage calculated", startTime = startTime) return(repeatedPValues) } if (.isTrialDesignInverseNormal(design)) { typeOfDesign <- design$typeOfDesign deltaWT <- design$deltaWT typeBetaSpending <- design$typeBetaSpending if (!design$bindingFutility) { if (design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { typeOfDesign <- C_TYPE_OF_DESIGN_WT deltaWT <- design$deltaPT1 } if (design$typeBetaSpending != "none") { typeBetaSpending <- "none" } } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_PT || design$typeBetaSpending != "none") { message("Calculation of repeated p-values might take a while for binding case, please wait...") } } intersectionTest <- stageResults$intersectionTest if (!.isTrialDesignFisher(design) && (design$typeOfDesign == C_TYPE_OF_DESIGN_HP)) { if (stage == kMax) { startTime <- Sys.time() for (g in 1:gMax) { if (!is.na(stageResults$testStatistics[g, kMax])) { prec <- 1 lower <- .getDesignGroupSequential( kMax = kMax, sided = design$sided, informationRates = design$informationRates, typeOfDesign = C_TYPE_OF_DESIGN_HP, futilityBounds = design$futilityBounds, bindingFutility = design$bindingFutility )$alphaSpent[kMax - 1] + tolerance upper <- 0.5 maxSearchIterations <- 30 while (prec > tolerance && maxSearchIterations >= 0) { alpha <- (lower + upper) / 2 designAlpha <- .getDesignInverseNormal( kMax = kMax, alpha = alpha, typeOfDesign = C_TYPE_OF_DESIGN_HP, futilityBounds = design$futilityBounds, sided = design$sided, bindingFutility = design$bindingFutility, informationRates = design$informationRates ) ctr <- .performClosedCombinationTest( stageResults = stageResults, design = designAlpha, intersectionTest = intersectionTest ) ifelse(ctr$rejected[g, kMax], upper <- alpha, lower <- alpha) prec <- upper - lower maxSearchIterations <- maxSearchIterations - 1 } repeatedPValues[g, kMax] <- upper } } .logProgress("Repeated p-values for final stage calculated", startTime = startTime) } } else if (kMax == 1) { startTime <- Sys.time() for (g in 1:gMax) { if (!is.na(stageResults$testStatistics[g, 1])) { prec <- 1 lower <- tolerance upper <- 1 - tolerance maxSearchIterations <- 30 while (prec > tolerance && maxSearchIterations >= 0) { alpha <- (lower + upper) / 2 if (.isTrialDesignFisher(design)) { designAlpha <- .getDesignFisher(kMax = 1, alpha = alpha) } else { designAlpha <- .getDesignInverseNormal(kMax = 1, alpha = alpha) } ctr <- .performClosedCombinationTest( stageResults = stageResults, design = designAlpha, intersectionTest = intersectionTest ) ifelse(ctr$rejected[g, 1], upper <- alpha, lower <- alpha) prec <- upper - lower maxSearchIterations <- maxSearchIterations - 1 } repeatedPValues[g, 1] <- upper } } .logProgress("Overall p-values calculated", startTime = startTime) } else { for (k in 1:stage) { startTime <- Sys.time() for (g in 1:gMax) { if (!is.na(stageResults$testStatistics[g, k])) { prec <- 1 lower <- tolerance upper <- 0.5 maxSearchIterations <- 30 while (prec > tolerance && maxSearchIterations >= 0) { alpha <- (lower + upper) / 2 if (.isTrialDesignFisher(design)) { designAlpha <- .getDesignFisher( kMax = kMax, alpha = alpha, method = design$method, alpha0Vec = design$alpha0Vec, sided = design$sided, bindingFutility = design$bindingFutility, informationRates = design$informationRates ) } else { designAlpha <- .getDesignInverseNormal( kMax = kMax, alpha = alpha, typeOfDesign = typeOfDesign, deltaWT = deltaWT, typeBetaSpending = typeBetaSpending, gammaB = design$gammaB, deltaPT0 = design$deltaPT0, deltaPT1 = design$deltaPT1, beta = design$beta, gammaA = design$gammaA, futilityBounds = design$futilityBounds, sided = design$sided, bindingFutility = design$bindingFutility, informationRates = design$informationRates ) } ctr <- .performClosedCombinationTest( stageResults = stageResults, design = designAlpha, intersectionTest = intersectionTest ) ifelse(ctr$rejected[g, k], upper <- alpha, lower <- alpha) prec <- upper - lower maxSearchIterations <- maxSearchIterations - 1 } repeatedPValues[g, k] <- upper } } .logProgress("Repeated p-values for stage %s calculated", startTime = startTime, k) } } return(repeatedPValues) } #' #' @title #' Get Closed Conditional Dunnett Test Results #' #' @description #' Calculates and returns the results from the closed conditional Dunnett test. #' #' @inheritParams param_stageResults #' @inheritParams param_stage #' @inheritParams param_three_dots #' #' @family analysis functions #' @details #' For performing the conditional Dunnett test the design must be defined through the function #' \code{\link{getDesignConditionalDunnett}}.\cr #' See Koenig et al. (2008) and Wassmer & Brannath (2016), chapter 11 for details of the test procedure. #' #' @template return_object_closed_combination_test_results #' @template how_to_get_help_for_generics #' #' @template examples_get_closed_conditional_dunnett_test_results #' #' @export #' getClosedConditionalDunnettTestResults <- function(stageResults, ..., stage = stageResults$stage) { .assertIsStageResultsMultiArm(stageResults) .assertIsValidStage(stage, kMax = 2) .warnInCaseOfUnknownArguments(functionName = "getClosedConditionalDunnettTestResults", ignore = c("design"), ...) design <- stageResults$.design if (!is.null(list(...)[["design"]])) { design <- list(...)[["design"]] } .assertIsTrialDesignConditionalDunnett(design) result <- .getClosedConditionalDunnettTestResults(stageResults = stageResults, design = design, stage = stage) return(ClosedCombinationTestResults( .design = result$.design, .enrichment = grepl("Enrichment", class(stageResults)), intersectionTest = result$intersectionTest, indices = result$indices, separatePValues = result$separatePValues, conditionalErrorRate = result$conditionalErrorRate, secondStagePValues = result$secondStagePValues, rejected = result$rejected, rejectedIntersections = result$rejectedIntersections )) } .getClosedConditionalDunnettTestResults <- function(..., stageResults, design = stageResults$.design, stage = stageResults$stage) { gMax <- stageResults$getGMax() informationAtInterim <- design$informationAtInterim secondStageConditioning <- design$secondStageConditioning alpha <- design$alpha if (.isStageResultsMultiArmSurvival(stageResults)) { frac1 <- stageResults$.dataInput$allocationRatios[stageResults$.dataInput$stages == 1 & stageResults$.dataInput$groups <= gMax] / (stageResults$.dataInput$allocationRatios[stageResults$.dataInput$stages == 1 & stageResults$.dataInput$groups <= gMax] + 1) if (stage == 2) { frac2 <- stageResults$.dataInput$overallAllocationRatios[stageResults$.dataInput$stages == 2 & stageResults$.dataInput$groups <= gMax] / (stageResults$.dataInput$overallAllocationRatios[stageResults$.dataInput$stages == 2 & stageResults$.dataInput$groups <= gMax] + 1) } } else { frac1 <- stageResults$.dataInput$sampleSizes[stageResults$.dataInput$stages == 1 & stageResults$.dataInput$groups <= gMax] / (stageResults$.dataInput$sampleSizes[stageResults$.dataInput$stages == 1 & stageResults$.dataInput$groups <= gMax] + stageResults$.dataInput$sampleSizes[stageResults$.dataInput$stages == 1 & stageResults$.dataInput$groups == (gMax + 1)]) if (stage == 2) { frac2 <- stageResults$.dataInput$sampleSizes[stageResults$.dataInput$stages == 2 & stageResults$.dataInput$groups <= gMax] / (stageResults$.dataInput$sampleSizes[stageResults$.dataInput$stages == 2 & stageResults$.dataInput$groups <= gMax] + stageResults$.dataInput$sampleSizes[stageResults$.dataInput$stages == 2 & stageResults$.dataInput$groups == (gMax + 1)]) } } indices <- .getIndicesOfClosedHypothesesSystem(gMax = gMax) conditionalErrorRate <- matrix(rep(NA_real_, 2 * (2^gMax - 1)), 2^gMax - 1, 2) secondStagePValues <- matrix(rep(NA_real_, 2 * (2^gMax - 1)), 2^gMax - 1, 2) rejected <- matrix(rep(FALSE, gMax * 2), gMax, 2) colnames(conditionalErrorRate) <- paste("stage ", (1:2), sep = "") colnames(secondStagePValues) <- paste("stage ", (1:2), sep = "") dimnames(rejected) <- list(paste("arm ", 1:gMax, sep = ""), paste("stage ", (1:2), sep = "")) rejectedIntersections <- matrix(rep(FALSE, stage * nrow(indices)), nrow(indices), stage) if (stageResults$directionUpper) { signedTestStatistics <- stageResults$testStatistics signedOverallTestStatistics <- stageResults$overallTestStatistics signedOverallTestStatistics[, 2] <- sqrt(informationAtInterim) * stageResults$testStatistics[, 1] + sqrt(1 - informationAtInterim) * stageResults$testStatistics[, 2] } else { signedTestStatistics <- -stageResults$testStatistics signedOverallTestStatistics <- -stageResults$overallTestStatistics signedOverallTestStatistics[, 2] <- -(sqrt(informationAtInterim) * stageResults$testStatistics[, 1] + sqrt(1 - informationAtInterim) * stageResults$testStatistics[, 2]) } for (i in 1:(2^gMax - 1)) { zeta <- sqrt(frac1[indices[i, ] == 1]) sigma <- zeta %*% t(zeta) diag(sigma) <- 1 crit <- .getMultivariateDistribution( type = "quantile", upper = NA_real_, sigma = sigma, alpha = alpha ) integrand <- function(x) { innerProduct <- 1 for (g in (1:gMax)) { if (indices[i, g] == 1) { innerProduct <- innerProduct * stats::pnorm(((crit - sqrt(informationAtInterim) * signedTestStatistics[g, 1] + sqrt(1 - informationAtInterim) * sqrt(frac1[g]) * x)) / sqrt((1 - informationAtInterim) * (1 - frac1[g]))) } } return(innerProduct * dnorm(x)) } conditionalErrorRate[i, 1] <- 1 - integrate(integrand, lower = -Inf, upper = Inf)$value if (stage == 2) { if (!all(is.na(stageResults$separatePValues[indices[i, ] == 1, 2]))) { if (secondStageConditioning) { maxOverallTestStatistic <- max( signedOverallTestStatistics[indices[i, ] == 1, 2], na.rm = TRUE ) integrand <- function(x) { innerProduct <- 1 for (g in (1:gMax)) { if ((indices[i, g] == 1) && !is.na(stageResults$overallTestStatistics[g, 2])) { innerProduct <- innerProduct * stats::pnorm(((maxOverallTestStatistic - sqrt(informationAtInterim) * signedTestStatistics[g, 1] + sqrt(1 - informationAtInterim) * sqrt(frac2[g]) * x)) / sqrt((1 - informationAtInterim) * (1 - frac2[g]))) } } return(innerProduct * dnorm(x)) } secondStagePValues[i, 2] <- 1 - integrate(integrand, lower = -Inf, upper = Inf)$value } else { maxTestStatistic <- max(signedTestStatistics[indices[i, ] == 1, 2], na.rm = TRUE) integrand <- function(x) { innerProduct <- 1 for (g in (1:gMax)) { if ((indices[i, g] == 1) && !is.na(stageResults$separatePValues[g, 2])) { innerProduct <- innerProduct * stats::pnorm(((maxTestStatistic + sqrt(frac2[g]) * x)) / sqrt(1 - frac2[g])) } } return(innerProduct * dnorm(x)) } secondStagePValues[i, 2] <- 1 - integrate(integrand, lower = -Inf, upper = Inf)$value } } } } if (stage == 2) { rejectedIntersections[, 2] <- (secondStagePValues[, 2] <= conditionalErrorRate[, 1]) rejectedIntersections[is.na(rejectedIntersections[, 2]), 2] <- FALSE for (j in 1:gMax) { rejected[j, 2] <- all(rejectedIntersections[indices[, j] == 1, 2], na.rm = TRUE) } } return(list( .design = design, intersectionTest = "Dunnett", indices = indices, separatePValues = stageResults$separatePValues, conditionalErrorRate = conditionalErrorRate, secondStagePValues = secondStagePValues, rejected = rejected, rejectedIntersections = rejectedIntersections )) } .getConditionalDunnettTestForCI <- function(..., design, stageResults, treatmentArm) { gMax <- stageResults$getGMax() informationAtInterim <- design$informationAtInterim secondStageConditioning <- design$secondStageConditioning alpha <- design$alpha if (.isStageResultsMultiArmSurvival(stageResults)) { frac1 <- stageResults$.dataInput$allocationRatios[stageResults$.dataInput$stages == 1 & stageResults$.dataInput$groups <= gMax] / (stageResults$.dataInput$allocationRatios[stageResults$.dataInput$stages == 1 & stageResults$.dataInput$groups <= gMax] + 1) frac2 <- stageResults$.dataInput$overallAllocationRatios[stageResults$.dataInput$stages == 2 & stageResults$.dataInput$groups <= gMax] / (stageResults$.dataInput$overallAllocationRatios[stageResults$.dataInput$stages == 2 & stageResults$.dataInput$groups <= gMax] + 1) } else { frac1 <- stageResults$.dataInput$sampleSizes[stageResults$.dataInput$stages == 1 & stageResults$.dataInput$groups <= gMax] / (stageResults$.dataInput$sampleSizes[stageResults$.dataInput$stages == 1 & stageResults$.dataInput$groups <= gMax] + stageResults$.dataInput$sampleSizes[stageResults$.dataInput$stages == 1 & stageResults$.dataInput$groups == (gMax + 1)]) frac2 <- stageResults$.dataInput$sampleSizes[stageResults$.dataInput$stages == 2 & stageResults$.dataInput$groups <= gMax] / (stageResults$.dataInput$sampleSizes[stageResults$.dataInput$stages == 2 & stageResults$.dataInput$groups <= gMax] + stageResults$.dataInput$sampleSizes[stageResults$.dataInput$stages == 2 & stageResults$.dataInput$groups == (gMax + 1)]) } if (stageResults$directionUpper) { signedTestStatistics <- stageResults$testStatistics signedOverallTestStatistics <- stageResults$overallTestStatistics signedOverallTestStatistics[, 2] <- sqrt(informationAtInterim) * stageResults$testStatistics[, 1] + sqrt(1 - informationAtInterim) * stageResults$testStatistics[, 2] } else { signedTestStatistics <- -stageResults$testStatistics signedOverallTestStatistics <- -stageResults$overallTestStatistics signedOverallTestStatistics[, 2] <- -(sqrt(informationAtInterim) * stageResults$testStatistics[, 1] + sqrt(1 - informationAtInterim) * stageResults$testStatistics[, 2]) } zeta <- sqrt(frac1) sigma <- zeta %*% t(zeta) diag(sigma) <- 1 crit <- .getMultivariateDistribution(type = "quantile", upper = NA_real_, sigma = sigma, alpha = alpha) integrand <- function(x) { innerProduct <- 1 for (g in (1:gMax)) { innerProduct <- innerProduct * stats::pnorm(((crit - sqrt(informationAtInterim) * signedTestStatistics[g, 1] + sqrt(1 - informationAtInterim) * sqrt(frac1[g]) * x)) / sqrt((1 - informationAtInterim) * (1 - frac1[g]))) } return(innerProduct * dnorm(x)) } conditionalErrorRate <- 1 - integrate(integrand, lower = -Inf, upper = Inf)$value if (!is.na(stageResults$separatePValues[treatmentArm, 2])) { if (secondStageConditioning) { maxOverallTestStatistic <- signedOverallTestStatistics[treatmentArm, 2] integrand <- function(x) { innerProduct <- 1 for (g in (1:gMax)) { if (!is.na(stageResults$overallTestStatistics[g, 2])) { innerProduct <- innerProduct * stats::pnorm(((maxOverallTestStatistic - sqrt(informationAtInterim) * signedTestStatistics[g, 1] + sqrt(1 - informationAtInterim) * sqrt(frac2[g]) * x)) / sqrt((1 - informationAtInterim) * (1 - frac2[g]))) } } return(innerProduct * dnorm(x)) } secondStagePValues <- 1 - integrate(integrand, lower = -Inf, upper = Inf)$value } else { maxTestStatistic <- signedTestStatistics[treatmentArm, 2] integrand <- function(x) { innerProduct <- 1 for (g in (1:gMax)) { if (!is.na(stageResults$separatePValues[g, 2])) { innerProduct <- innerProduct * stats::pnorm(((maxTestStatistic + sqrt(frac2[g]) * x)) / sqrt(1 - frac2[g])) } } return(innerProduct * dnorm(x)) } secondStagePValues <- 1 - integrate(integrand, lower = -Inf, upper = Inf)$value } } return(secondStagePValues <= conditionalErrorRate) } # # Calculation of conditional rejection probability (CRP) # .getConditionalRejectionProbabilitiesMultiArm <- function(stageResults, ..., stage = stageResults$stage, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .assertIsValidStage(stage, stageResults$.design$kMax) gMax <- stageResults$getGMax() if (.isTrialDesignInverseNormal(stageResults$.design)) { return(.getConditionalRejectionProbabilitiesMultiArmInverseNormal( stageResults = stageResults, stage = stage, ... )) } else if (.isTrialDesignFisher(stageResults$.design)) { return(.getConditionalRejectionProbabilitiesMultiArmFisher( stageResults = stageResults, stage = stage, ... )) } else if (.isTrialDesignConditionalDunnett(stageResults$.design)) { return(.getConditionalRejectionProbabilitiesMultiArmConditionalDunnett( stageResults = stageResults, ... )) } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of TrialDesignInverseNormal, TrialDesignFisher, or TrialDesignDunnett" ) } # # Calculation of CRP based on inverse normal method # .getConditionalRejectionProbabilitiesMultiArmInverseNormal <- function(..., stageResults, stage) { design <- stageResults$.design .assertIsTrialDesignInverseNormal(design) .warnInCaseOfUnknownArguments( functionName = ".getConditionalRejectionProbabilitiesMultiArmInverseNormal", ignore = c("stage", "design"), ... ) kMax <- design$kMax if (kMax == 1) { return(as.matrix(NA_real_)) } gMax <- stageResults$getGMax() conditionalRejectionProbabilities <- matrix(NA_real_, nrow = gMax, ncol = kMax) weights <- .getWeightsInverseNormal(design) informationRates <- design$informationRates ctr <- .performClosedCombinationTest(stageResults = stageResults) criticalValues <- design$criticalValues for (stageIndex in (1:min(stage, kMax - 1))) { for (g in 1:gMax) { if (!is.na(ctr$separatePValues[g, stageIndex])) { # shifted decision region for use in getGroupSeqProbs # Inverse Normal Method shiftedDecisionRegionUpper <- criticalValues[(stageIndex + 1):kMax] * sqrt(sum(weights[1:stageIndex]^2) + cumsum(weights[(stageIndex + 1):kMax]^2)) / sqrt(cumsum(weights[(stageIndex + 1):kMax]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stageIndex], na.rm = TRUE) * sqrt(sum(weights[1:stageIndex]^2)) / sqrt(cumsum(weights[(stageIndex + 1):kMax]^2)) if (stageIndex == kMax - 1) { shiftedFutilityBounds <- c() } else { shiftedFutilityBounds <- design$futilityBounds[(stageIndex + 1):(kMax - 1)] * sqrt(sum(weights[1:stageIndex]^2) + cumsum(weights[(stageIndex + 1):(kMax - 1)]^2)) / sqrt(cumsum(weights[(stageIndex + 1):(kMax - 1)]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stageIndex], na.rm = TRUE) * sqrt(sum(weights[1:stageIndex]^2)) / sqrt(cumsum(weights[(stageIndex + 1):(kMax - 1)]^2)) } # scaled information for use in getGroupSeqProbs scaledInformation <- (informationRates[(stageIndex + 1):kMax] - informationRates[stageIndex]) / (1 - informationRates[stageIndex]) decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, shiftedDecisionRegionUpper ), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = scaledInformation ) conditionalRejectionProbabilities[g, stageIndex] <- sum(probs[3, ] - probs[2, ]) } } } return(conditionalRejectionProbabilities) } # # Calculation of conditional rejection probability based on Fisher's combination test # .getConditionalRejectionProbabilitiesMultiArmFisher <- function(..., stageResults, stage) { design <- stageResults$.design .assertIsTrialDesignFisher(design) .warnInCaseOfUnknownArguments( functionName = ".getConditionalRejectionProbabilitiesMultiArmFisher", ignore = c("stage", "design"), ... ) kMax <- design$kMax if (kMax == 1) { return(as.matrix(NA_real_)) } gMax <- stageResults$getGMax() criticalValues <- design$criticalValues weights <- .getWeightsFisher(design) intersectionTest <- stageResults$intersectionTest conditionalRejectionProbabilities <- matrix(NA_real_, nrow = gMax, ncol = kMax) if (design$bindingFutility) { alpha0Vec <- design$alpha0Vec } else { alpha0Vec <- rep(1, kMax - 1) } for (g in 1:gMax) { for (stageIndex in (1:min(stage, kMax - 1))) { if (!is.na(stageResults$separatePValues[g, stageIndex])) { if (gMax == 1) { pValues <- stageResults$separatePValues[1, 1:stageIndex] } else { ctr <- .performClosedCombinationTest( stageResults = stageResults, design = design, intersectionTest = intersectionTest ) pValues <- ctr$adjustedStageWisePValues[ctr$indices[, g] == 1, ][which.max( ctr$overallAdjustedTestStatistics[ctr$indices[, g] == 1, stageIndex] ), 1:stageIndex] } if (prod(pValues^weights[1:stageIndex]) <= criticalValues[stageIndex]) { conditionalRejectionProbabilities[g, stageIndex] <- 1 } else { if (stageIndex < kMax - 1) { conditionalRejectionProbabilities[g, stageIndex] <- .getFisherCombinationSize( kMax - stageIndex, alpha0Vec[(stageIndex + 1):(kMax - 1)], (criticalValues[(stageIndex + 1):kMax] / prod(pValues^weights[1:stageIndex]))^(1 / weights[stageIndex + 1]), weights[(stageIndex + 2):kMax] / weights[stageIndex + 1] ) } else { conditionalRejectionProbabilities[g, stageIndex] <- (criticalValues[kMax] / prod(pValues^weights[1:stageIndex]))^(1 / weights[kMax]) } } if (design$bindingFutility) { if (pValues[stageIndex] > alpha0Vec[stageIndex]) { conditionalRejectionProbabilities[g, stageIndex:stage] <- 0 break } } } } } conditionalRejectionProbabilities[conditionalRejectionProbabilities >= 1] <- 1 conditionalRejectionProbabilities[conditionalRejectionProbabilities < 0] <- NA_real_ return(conditionalRejectionProbabilities) } # # Calculation of CRP based on conditional Dunnett # .getConditionalRejectionProbabilitiesMultiArmConditionalDunnett <- function(..., stageResults) { design <- stageResults$.design .assertIsTrialDesignConditionalDunnett(design) .warnInCaseOfUnknownArguments( functionName = ".getConditionalRejectionProbabilitiesMultiArmConditionalDunnett", ignore = c("stage", "intersectionTest", "design"), ... ) kMax <- 2 gMax <- stageResults$getGMax() conditionalRejectionProbabilities <- matrix(NA_real_, nrow = gMax, ncol = kMax) ctr <- getClosedConditionalDunnettTestResults(stageResults = stageResults, design = design) stage <- 1 for (g in 1:gMax) { if (!is.na(ctr$separatePValues[g, stage])) { conditionalRejectionProbabilities[g, 2] <- 1 - stats::pnorm(.getOneMinusQNorm(min(ctr$conditionalErrorRate[ ctr$indices[, g] == 1, stage ], na.rm = TRUE))) } } return(conditionalRejectionProbabilities) } # # Plotting conditional power and likelihood # .getConditionalPowerPlotMultiArm <- function(stageResults, ..., nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaRange = NA_real_, assumedStDevs = NA_real_, piTreatmentRange = NA_real_, piControl = NA_real_, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_, showArms = NA_real_) { .stopInCaseOfIllegalStageDefinition2(...) kMax <- stageResults$.design$kMax stage <- stageResults$stage if (stage == kMax && length(nPlanned) > 0) { stage <- kMax - 1 } if (stage < 1 || kMax == 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot plot conditional power of a fixed design") } if (stage >= kMax) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the conditional power plot is only available for subsequent stages. ", "Please specify a 'stage' (", stage, ") < 'kMax' (", kMax, ")" ) } .assertIsValidNPlanned(nPlanned = nPlanned, kMax = kMax, stage = stage) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) if (stageResults$isDatasetMeans()) { .warnInCaseOfUnusedArgument(piTreatmentRange, "piTreatmentRange", NA_real_, "plot") .warnInCaseOfUnusedArgument(piControl, "piControl", NA_real_, "plot") return(.getConditionalPowerLikelihoodMeansMultiArm( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaRange = thetaRange, assumedStDevs = assumedStDevs, iterations = iterations, seed = seed )) } else if (stageResults$isDatasetRates()) { .warnInCaseOfUnusedArgument(thetaRange, "thetaRange", NA_real_, "plot") .warnInCaseOfUnusedArgument(assumedStDevs, "assumedStDevs", NA_real_, "plot") return(.getConditionalPowerLikelihoodRatesMultiArm( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, piTreatmentRange = piTreatmentRange, piControl = piControl, iterations = iterations, seed = seed )) } else if (stageResults$isDatasetSurvival()) { .warnInCaseOfUnusedArgument(piTreatmentRange, "piTreatmentRange", NA_real_, "plot") .warnInCaseOfUnusedArgument(piControl, "piControl", NA_real_, "plot") .warnInCaseOfUnusedArgument(assumedStDevs, "assumedStDevs", NA_real_, "plot") return(.getConditionalPowerLikelihoodSurvivalMultiArm( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaRange = thetaRange, iterations = iterations, seed = seed )) } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' type '", class(stageResults$.dataInput), "' is not implemented yet" ) } rpact/R/f_simulation_base_means.R0000644000175000017500000011370114150167045016715 0ustar nileshnilesh## | ## | *Simulation of continuous data with group sequential and combination test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5594 $ ## | Last changed: $Date: 2021-11-26 15:24:35 +0100 (Fr, 26 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | .getTestStatisticsMeans <- function(..., designNumber, informationRates, groups, normalApproximation, meanRatio, thetaH0, allocationRatioPlanned, sampleSizesPerStage, testStatisticsPerStage) { stage <- length(sampleSizesPerStage) # This is an estimate of the overall test statistic disregarding the fact that the variance can be estimated # from the overall data (might have influence on the Type I error rate and power when choosing the conventional # group sequential design with unknown variance): overallTestStatistic <- sqrt(sampleSizesPerStage) %*% testStatisticsPerStage / sqrt(sum(sampleSizesPerStage)) if (normalApproximation) { pValuesSeparate <- 1 - stats::pnorm(testStatisticsPerStage) } else { pValuesSeparate <- 1 - stats::pt(testStatisticsPerStage, sampleSizesPerStage - groups) } if (designNumber == 1L) { if (normalApproximation) { value <- overallTestStatistic } else { value <- .getQNorm(stats::pt(overallTestStatistic, sum(sampleSizesPerStage) - groups)) } } else if (designNumber == 2L) { if (stage == 1) { if (normalApproximation) { value <- testStatisticsPerStage[1] } else { value <- .getQNorm(stats::pt(testStatisticsPerStage[1], sampleSizesPerStage[1] - groups)) } } else { if (normalApproximation) { value <- (sqrt(informationRates[1]) * testStatisticsPerStage[1] + sqrt(informationRates[2:stage] - informationRates[1:(stage - 1)]) %*% testStatisticsPerStage[2:stage]) / sqrt(informationRates[stage]) } else { value <- (sqrt(informationRates[1]) * .getQNorm(stats::pt(testStatisticsPerStage[1], sampleSizesPerStage[1] - groups)) + sqrt(informationRates[2:stage] - informationRates[1:(stage - 1)]) %*% .getQNorm(stats::pt(testStatisticsPerStage[2:stage], sampleSizesPerStage[2:stage] - groups))) / sqrt(informationRates[stage]) } } } else if (designNumber == 3L) { weightsFisher <- rep(NA_real_, stage) weightsFisher[1] <- 1 if (stage > 1) { weightsFisher[2:stage] <- sqrt(informationRates[2:stage] - informationRates[1:(stage - 1)]) / sqrt(informationRates[1]) } if (normalApproximation) { value <- prod((1 - stats::pnorm(testStatisticsPerStage[1:stage]))^weightsFisher[1:stage]) } else { value <- prod((1 - stats::pt( testStatisticsPerStage[1:stage], sampleSizesPerStage[1:stage] - groups ))^weightsFisher[1:stage]) } } if (groups == 1) { standardizedEffectEstimate <- overallTestStatistic / sqrt(sum(sampleSizesPerStage)) } else { if (!meanRatio) { standardizedEffectEstimate <- overallTestStatistic / sqrt(allocationRatioPlanned * sum(sampleSizesPerStage)) * (1 + allocationRatioPlanned) } else { standardizedEffectEstimate <- overallTestStatistic / sqrt(allocationRatioPlanned * sum(sampleSizesPerStage)) * sqrt((1 + allocationRatioPlanned) * (1 + thetaH0^2 * allocationRatioPlanned)) } } return(list( value = value, overallTestStatistic = overallTestStatistic, standardizedEffectEstimate = standardizedEffectEstimate, pValuesSeparate = pValuesSeparate )) } .getSimulationMeansStageSubjects <- function(..., stage, meanRatio, thetaH0, groups, plannedSubjects, allocationRatioPlanned, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage, sampleSizesPerStage, thetaH1, stDevH1, conditionalPower, conditionalCriticalValue) { if (is.na(conditionalPower)) { return(plannedSubjects[stage] - plannedSubjects[stage - 1]) } thetaStandardized <- thetaH1 / stDevH1 mult <- 1 if (groups == 2) { thetaH0 <- ifelse(meanRatio, thetaH0, 1) mult <- 1 + 1 / allocationRatioPlanned + thetaH0^2 * (1 + allocationRatioPlanned) } stageSubjects <- (max(0, conditionalCriticalValue + .getQNorm(conditionalPower)))^2 * mult / (max(1e-12, thetaStandardized))^2 stageSubjects <- min( max(minNumberOfSubjectsPerStage[stage], stageSubjects), maxNumberOfSubjectsPerStage[stage] ) return(stageSubjects) } .getSimulationStepMeans <- function(..., k, kMax, designNumber, informationRates, futilityBounds, alpha0Vec, criticalValues, meanRatio, thetaH0, alternative, stDev, groups, normalApproximation, plannedSubjects, directionUpper, allocationRatioPlanned, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage, conditionalPower, thetaH1, stDevH1, effectEstimate, sampleSizesPerStage, testStatisticsPerStage, testStatistic, calcSubjectsFunction) { stageSubjects <- plannedSubjects[1] # perform sample size size recalculation for stages 2, ..., kMax simulatedConditionalPower <- 0 if (k > 1) { # used effect size is either estimated from test statistic or pre-fixed if (is.na(thetaH1)) { thetaH1 <- effectEstimate } else { thetaH1 <- thetaH1 - thetaH0 } thetaStandardized <- thetaH1 / stDevH1 if (!directionUpper) { thetaH1 <- -thetaH1 thetaStandardized <- -thetaStandardized } # conditional critical value to reject the null hypotheses at the next stage of the trial if (designNumber == 3L) { conditionalCriticalValue <- .getOneMinusQNorm((criticalValues[k] / testStatistic$value)^(1 / sqrt((informationRates[k] - informationRates[k - 1]) / informationRates[1]))) } else { conditionalCriticalValue <- (criticalValues[k] * sqrt(informationRates[k]) - testStatistic$value * sqrt(informationRates[k - 1])) / sqrt(informationRates[k] - informationRates[k - 1]) } stageSubjects <- calcSubjectsFunction( stage = k, meanRatio = meanRatio, thetaH0 = thetaH0, groups = groups, plannedSubjects = plannedSubjects, sampleSizesPerStage = sampleSizesPerStage, allocationRatioPlanned = allocationRatioPlanned, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage, conditionalPower = conditionalPower, thetaH1 = thetaH1, stDevH1 = stDevH1, conditionalCriticalValue = conditionalCriticalValue ) if (is.null(stageSubjects) || length(stageSubjects) != 1 || !is.numeric(stageSubjects) || is.na(stageSubjects)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'calcSubjectsFunction' returned an illegal or undefined result (", stageSubjects, "); ", "the output must be a single numeric value" ) } # calculate conditional power for computed stageSubjects if (groups == 1) { thetaStandardized <- thetaStandardized } else { if (!meanRatio) { thetaStandardized <- thetaStandardized * sqrt(allocationRatioPlanned) / (1 + allocationRatioPlanned) } else { thetaStandardized <- thetaStandardized * sqrt(allocationRatioPlanned) / sqrt((1 + allocationRatioPlanned) * (1 + thetaH0 * allocationRatioPlanned)) } } simulatedConditionalPower <- 1 - stats::pnorm(conditionalCriticalValue - thetaStandardized * sqrt(stageSubjects)) } if (groups == 1) { nz <- (alternative - thetaH0) / stDev * sqrt(stageSubjects) if (normalApproximation) { testResult <- (2 * directionUpper - 1) * stats::rnorm(1, nz, 1) } else { testResult <- (2 * directionUpper - 1) * stats::rt(1, stageSubjects - 1, nz) } } else { if (!meanRatio) { nz <- (alternative - thetaH0) / stDev * sqrt(allocationRatioPlanned * stageSubjects) / (1 + allocationRatioPlanned) } else { nz <- (alternative - thetaH0) / stDev * sqrt(allocationRatioPlanned * stageSubjects) / sqrt((1 + allocationRatioPlanned) * (1 + thetaH0^2 * allocationRatioPlanned)) } if (normalApproximation) { testResult <- (2 * directionUpper - 1) * stats::rnorm(1, nz, 1) } else { testResult <- (2 * directionUpper - 1) * stats::rt(1, stageSubjects - 2, nz) } } sampleSizesPerStage <- c(sampleSizesPerStage, stageSubjects) testStatisticsPerStage <- c(testStatisticsPerStage, testResult) testStatistic <- .getTestStatisticsMeans( designNumber = designNumber, informationRates = informationRates, groups = groups, normalApproximation = normalApproximation, meanRatio = meanRatio, thetaH0 = thetaH0, allocationRatioPlanned = allocationRatioPlanned, sampleSizesPerStage = sampleSizesPerStage, testStatisticsPerStage = testStatisticsPerStage ) effectEstimate <- testStatistic$standardizedEffectEstimate * stDev simulatedRejections <- 0 simulatedFutilityStop <- 0 trialStop <- FALSE if (k == kMax) { trialStop <- TRUE } if (designNumber <= 2) { if (!is.na(testStatistic$value) && !is.na(criticalValues[k]) && testStatistic$value >= criticalValues[k]) { simulatedRejections <- 1 trialStop <- TRUE } if (!is.na(testStatistic$value) && !is.na(futilityBounds[k]) && k < kMax && testStatistic$value <= futilityBounds[k]) { simulatedFutilityStop <- 1 trialStop <- TRUE } } else { if (!is.na(testStatistic$value) && !is.na(criticalValues[k]) && testStatistic$value <= criticalValues[k]) { simulatedRejections <- 1 trialStop <- TRUE } if (!is.na(testStatistic$pValuesSeparate[k]) && !is.na(alpha0Vec[k]) && k < kMax && testStatistic$pValuesSeparate[k] >= alpha0Vec[k]) { simulatedFutilityStop <- 1 trialStop <- TRUE } } if (!directionUpper) { effectEstimate <- -effectEstimate } return(list( trialStop = trialStop, sampleSizesPerStage = sampleSizesPerStage, testStatisticsPerStage = testStatisticsPerStage, testStatistic = testStatistic, effectEstimate = effectEstimate, simulatedSubjects = stageSubjects, simulatedRejections = simulatedRejections, simulatedFutilityStop = simulatedFutilityStop, simulatedConditionalPower = simulatedConditionalPower )) } #' @title #' Get Simulation Means #' #' @description #' Returns the simulated power, stopping probabilities, conditional power, and expected sample size #' for testing means in a one or two treatment groups testing situation. #' #' @inheritParams param_design_with_default #' @inheritParams param_groups #' @param normalApproximation The type of computation of the p-values. Default is \code{TRUE}, #' i.e., normally distributed test statistics are generated. #' If \code{FALSE}, the t test is used for calculating the p-values, #' i.e., t distributed test statistics are generated. #' @param meanRatio If \code{TRUE}, the design characteristics for #' one-sided testing of H0: \code{mu1 / mu2 = thetaH0} are simulated, default is \code{FALSE}. #' @inheritParams param_thetaH0 #' @inheritParams param_alternative_simulation #' @inheritParams param_stDevSimulation #' @inheritParams param_directionUpper #' @inheritParams param_allocationRatioPlanned #' @inheritParams param_plannedSubjects #' @inheritParams param_minNumberOfSubjectsPerStage #' @inheritParams param_maxNumberOfSubjectsPerStage #' @inheritParams param_conditionalPowerSimulation #' @inheritParams param_thetaH1 #' @inheritParams param_stDevH1 #' @inheritParams param_maxNumberOfIterations #' @inheritParams param_calcSubjectsFunction #' @inheritParams param_seed #' @inheritParams param_three_dots #' @inheritParams param_showStatistics #' #' @details #' At given design the function simulates the power, stopping probabilities, conditional power, and expected #' sample size at given number of subjects and parameter configuration. #' Additionally, an allocation ratio = n1/n2 can be specified where n1 and n2 are the number #' of subjects in the two treatment groups. #' #' The definition of \code{thetaH1} makes only sense if \code{kMax} > 1 #' and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and #' \code{maxNumberOfSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. #' #' \code{calcSubjectsFunction}\cr #' This function returns the number of subjects at given conditional power and conditional critical value for specified #' testing situation. The function might depend on variables #' \code{stage}, #' \code{meanRatio}, #' \code{thetaH0}, #' \code{groups}, #' \code{plannedSubjects}, #' \code{sampleSizesPerStage}, #' \code{directionUpper}, #' \code{allocationRatioPlanned}, #' \code{minNumberOfSubjectsPerStage}, #' \code{maxNumberOfSubjectsPerStage}, #' \code{conditionalPower}, #' \code{conditionalCriticalValue}, #' \code{thetaH1}, and #' \code{stDevH1}. #' The function has to contain the three-dots argument '...' (see examples). #' #' @section Simulation Data: #' The summary statistics "Simulated data" contains the following parameters: median [range]; mean +/-sd\cr #' #' \code{$show(showStatistics = FALSE)} or \code{$setShowStatistics(FALSE)} can be used to disable #' the output of the aggregated simulated data.\cr #' #' Example 1: \cr #' \code{simulationResults <- getSimulationMeans(plannedSubjects = 40)} \cr #' \code{simulationResults$show(showStatistics = FALSE)}\cr #' #' Example 2: \cr #' \code{simulationResults <- getSimulationMeans(plannedSubjects = 40)} \cr #' \code{simulationResults$setShowStatistics(FALSE)}\cr #' \code{simulationResults}\cr #' #' \code{\link{getData}} can be used to get the aggregated simulated data from the #' object as \code{\link[base]{data.frame}}. The data frame contains the following columns: #' \enumerate{ #' \item \code{iterationNumber}: The number of the simulation iteration. #' \item \code{stageNumber}: The stage. #' \item \code{alternative}: The alternative hypothesis value. #' \item \code{numberOfSubjects}: The number of subjects under consideration when the #' (interim) analysis takes place. #' \item \code{rejectPerStage}: 1 if null hypothesis can be rejected, 0 otherwise. #' \item \code{futilityPerStage}: 1 if study should be stopped for futility, 0 otherwise. #' \item \code{testStatistic}: The test statistic that is used for the test decision, #' depends on which design was chosen (group sequential, inverse normal, or Fisher's combination test). #' \item \code{testStatisticsPerStage}: The test statistic for each stage if only data from #' the considered stage is taken into account. #' \item \code{effectEstimate}: Overall simulated standardized effect estimate. #' \item \code{trialStop}: \code{TRUE} if study should be stopped for efficacy or futility or final stage, \code{FALSE} otherwise. #' \item \code{conditionalPowerAchieved}: The conditional power for the subsequent stage of the trial for #' selected sample size and effect. The effect is either estimated from the data or can be #' user defined with \code{thetaH1}. #' } #' #' @template return_object_simulation_results #' @template how_to_get_help_for_generics #' #' @template examples_get_simulation_means #' #' @export #' getSimulationMeans <- function(design = NULL, ..., groups = 2L, normalApproximation = TRUE, meanRatio = FALSE, thetaH0 = ifelse(meanRatio, 1, 0), alternative = seq(0, 1, 0.2), # C_ALTERNATIVE_POWER_SIMULATION_DEFAULT stDev = 1, # C_STDEV_DEFAULT plannedSubjects = NA_real_, directionUpper = TRUE, # C_DIRECTION_UPPER_DEFAULT allocationRatioPlanned = NA_real_, minNumberOfSubjectsPerStage = NA_real_, maxNumberOfSubjectsPerStage = NA_real_, conditionalPower = NA_real_, thetaH1 = NA_real_, stDevH1 = NA_real_, maxNumberOfIterations = 1000L, # C_MAX_SIMULATION_ITERATIONS_DEFAULT seed = NA_real_, calcSubjectsFunction = NULL, showStatistics = FALSE) { if (is.null(design)) { design <- .getDefaultDesign(..., type = "simulation") .warnInCaseOfUnknownArguments( functionName = "getSimulationMeans", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "showStatistics"), ... ) } else { .assertIsTrialDesign(design) .warnInCaseOfUnknownArguments(functionName = "getSimulationMeans", ignore = "showStatistics", ...) .warnInCaseOfTwoSidedPowerArgument(...) } .assertIsSingleLogical(directionUpper, "directionUpper") .assertIsSingleNumber(thetaH0, "thetaH0") if (meanRatio) { .assertIsInOpenInterval(thetaH0, "thetaH0", 0, NULL, naAllowed = TRUE) .assertIsInOpenInterval(thetaH1, "thetaH1", 0, NULL, naAllowed = TRUE) if (identical(alternative, C_ALTERNATIVE_POWER_SIMULATION_DEFAULT)) { alternative <- C_ALTERNATIVE_POWER_SIMULATION_MEAN_RATIO_DEFAULT } .assertIsInOpenInterval(alternative, "alternative", 0, NULL, naAllowed = TRUE) } .assertIsValidGroupsParameter(groups) .assertIsNumericVector(alternative, "alternative", naAllowed = FALSE) .assertIsNumericVector(minNumberOfSubjectsPerStage, "minNumberOfSubjectsPerStage", naAllowed = TRUE) .assertIsNumericVector(maxNumberOfSubjectsPerStage, "maxNumberOfSubjectsPerStage", naAllowed = TRUE) .assertIsSingleNumber(conditionalPower, "conditionalPower", naAllowed = TRUE) .assertIsInOpenInterval(conditionalPower, "conditionalPower", 0, 1, naAllowed = TRUE) .assertIsSingleNumber(thetaH1, "thetaH1", naAllowed = TRUE) .assertIsSingleNumber(stDevH1, "stDevH1", naAllowed = TRUE) .assertIsInOpenInterval(stDevH1, "stDevH1", 0, NULL, naAllowed = TRUE) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned", naAllowed = TRUE) .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM, naAllowed = TRUE) .assertIsSinglePositiveInteger(maxNumberOfIterations, "maxNumberOfIterations", validateType = FALSE) .assertIsSingleNumber(seed, "seed", naAllowed = TRUE) .assertIsValidStandardDeviation(stDev) .assertIsSingleLogical(showStatistics, "showStatistics", naAllowed = FALSE) .assertIsSingleLogical(normalApproximation, "normalApproximation", naAllowed = FALSE) if (design$sided == 2) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "only one-sided case is implemented for the simulation design" ) } if (groups == 1L) { if (isTRUE(meanRatio)) { warning("'meanRatio' (", meanRatio, ") will be ignored ", "because it is not applicable for 'groups' = 1", call. = FALSE ) } if (!is.na(allocationRatioPlanned)) { warning("'allocationRatioPlanned' (", allocationRatioPlanned, ") will be ignored because it is not applicable for 'groups' = 1", call. = FALSE ) allocationRatioPlanned <- NA_real_ } } else if (is.na(allocationRatioPlanned)) { allocationRatioPlanned <- C_ALLOCATION_RATIO_DEFAULT } simulationResults <- SimulationResultsMeans(design, showStatistics = showStatistics) thetaH1 <- .ignoreParameterIfNotUsed( "thetaH1", thetaH1, design$kMax > 1, "design is fixed ('kMax' = 1)", "Assumed effect" ) stDevH1 <- .ignoreParameterIfNotUsed( "stDevH1", stDevH1, design$kMax > 1, "design is fixed ('kMax' = 1)", "Assumed effect" ) if (is.na(conditionalPower) && is.null(calcSubjectsFunction) && !is.na(stDevH1)) { warning("'stDevH1' will be ignored because neither 'conditionalPower' nor ", "'calcSubjectsFunction' is defined", call. = FALSE ) } conditionalPower <- .ignoreParameterIfNotUsed( "conditionalPower", conditionalPower, design$kMax > 1, "design is fixed ('kMax' = 1)" ) minNumberOfSubjectsPerStage <- .ignoreParameterIfNotUsed( "minNumberOfSubjectsPerStage", minNumberOfSubjectsPerStage, design$kMax > 1, "design is fixed ('kMax' = 1)" ) maxNumberOfSubjectsPerStage <- .ignoreParameterIfNotUsed( "maxNumberOfSubjectsPerStage", maxNumberOfSubjectsPerStage, design$kMax > 1, "design is fixed ('kMax' = 1)" ) minNumberOfSubjectsPerStage <- .assertIsValidNumberOfSubjectsPerStage(minNumberOfSubjectsPerStage, "minNumberOfSubjectsPerStage", plannedSubjects, conditionalPower, calcSubjectsFunction, design$kMax, endpoint = "means" ) maxNumberOfSubjectsPerStage <- .assertIsValidNumberOfSubjectsPerStage(maxNumberOfSubjectsPerStage, "maxNumberOfSubjectsPerStage", plannedSubjects, conditionalPower, calcSubjectsFunction, design$kMax, endpoint = "means" ) if (design$kMax > 1) { if (!normalApproximation) { if (!all(is.na(minNumberOfSubjectsPerStage)) && (any(minNumberOfSubjectsPerStage < groups * 2))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "minNumberOfSubjectsPerStage not correctly specified" ) } } if (any(maxNumberOfSubjectsPerStage - minNumberOfSubjectsPerStage < 0) && !all(is.na(maxNumberOfSubjectsPerStage - minNumberOfSubjectsPerStage))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjectsPerStage' (", .arrayToString(maxNumberOfSubjectsPerStage), ") must be not smaller than minNumberOfSubjectsPerStage' (", .arrayToString(minNumberOfSubjectsPerStage), ")" ) } .setValueAndParameterType( simulationResults, "minNumberOfSubjectsPerStage", minNumberOfSubjectsPerStage, NA_real_ ) .setValueAndParameterType( simulationResults, "maxNumberOfSubjectsPerStage", maxNumberOfSubjectsPerStage, NA_real_ ) } if (!is.na(conditionalPower) && (design$kMax == 1)) { warning("'conditionalPower' will be ignored for fixed sample design", call. = FALSE) } if (!is.null(calcSubjectsFunction) && (design$kMax == 1)) { warning("'calcSubjectsFunction' will be ignored for fixed sample design", call. = FALSE) } if (is.na(conditionalPower) && is.null(calcSubjectsFunction)) { if (length(minNumberOfSubjectsPerStage) != 1 || !is.na(minNumberOfSubjectsPerStage)) { warning("'minNumberOfSubjectsPerStage' (", .arrayToString(minNumberOfSubjectsPerStage), ") ", "will be ignored because neither 'conditionalPower' nor ", "'calcSubjectsFunction' is defined", call. = FALSE ) simulationResults$minNumberOfSubjectsPerStage <- NA_real_ } if (length(maxNumberOfSubjectsPerStage) != 1 || !is.na(maxNumberOfSubjectsPerStage)) { warning("'maxNumberOfSubjectsPerStage' (", .arrayToString(maxNumberOfSubjectsPerStage), ") ", "will be ignored because neither 'conditionalPower' nor ", "'calcSubjectsFunction' is defined", call. = FALSE ) simulationResults$maxNumberOfSubjectsPerStage <- NA_real_ } } simulationResults$.setParameterType( "calcSubjectsFunction", ifelse(design$kMax == 1, C_PARAM_NOT_APPLICABLE, ifelse(!is.null(calcSubjectsFunction) && design$kMax > 1, C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE ) ) ) if (is.null(calcSubjectsFunction)) { calcSubjectsFunction <- .getSimulationMeansStageSubjects } .assertIsValidFunction( fun = calcSubjectsFunction, funArgName = "calcSubjectsFunction", expectedFunction = .getSimulationMeansStageSubjects ) simulationResults$calcSubjectsFunction <- calcSubjectsFunction .assertIsIntegerVector(plannedSubjects, "plannedSubjects", validateType = FALSE) if (length(plannedSubjects) != design$kMax) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'plannedSubjects' (", .arrayToString(plannedSubjects), ") must have length ", design$kMax ) } .assertIsInClosedInterval(plannedSubjects, "plannedSubjects", lower = 1, upper = NULL) .assertValuesAreStrictlyIncreasing(plannedSubjects, "plannedSubjects") effect <- alternative - thetaH0 simulationResults$effect <- effect simulationResults$.setParameterType( "effect", ifelse(thetaH0 == 0, C_PARAM_NOT_APPLICABLE, C_PARAM_GENERATED) ) .setValueAndParameterType(simulationResults, "normalApproximation", normalApproximation, TRUE) .setValueAndParameterType(simulationResults, "meanRatio", meanRatio, FALSE) .setValueAndParameterType(simulationResults, "thetaH0", thetaH0, ifelse(meanRatio, 1, 0)) .setValueAndParameterType( simulationResults, "alternative", alternative, C_ALTERNATIVE_POWER_SIMULATION_DEFAULT ) .setValueAndParameterType(simulationResults, "stDev", stDev, C_STDEV_DEFAULT) .setValueAndParameterType(simulationResults, "groups", as.integer(groups), 2L) .setValueAndParameterType( simulationResults, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT ) if (groups == 1L) { simulationResults$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) } .setValueAndParameterType( simulationResults, "plannedSubjects", plannedSubjects, NA_real_ ) .setValueAndParameterType( simulationResults, "directionUpper", directionUpper, C_DIRECTION_UPPER_DEFAULT ) .setValueAndParameterType(simulationResults, "minNumberOfSubjectsPerStage", minNumberOfSubjectsPerStage, NA_real_, notApplicableIfNA = TRUE ) .setValueAndParameterType(simulationResults, "maxNumberOfSubjectsPerStage", maxNumberOfSubjectsPerStage, NA_real_, notApplicableIfNA = TRUE ) .setValueAndParameterType(simulationResults, "conditionalPower", conditionalPower, NA_real_, notApplicableIfNA = TRUE ) .setValueAndParameterType(simulationResults, "thetaH1", thetaH1, NA_real_, notApplicableIfNA = TRUE ) .setValueAndParameterType(simulationResults, "stDevH1", stDevH1, NA_real_, notApplicableIfNA = TRUE ) .setValueAndParameterType( simulationResults, "maxNumberOfIterations", as.integer(maxNumberOfIterations), C_MAX_SIMULATION_ITERATIONS_DEFAULT ) simulationResults$.setParameterType("seed", ifelse(is.na(seed), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) simulationResults$seed <- .setSeed(seed) if (.isTrialDesignGroupSequential(design)) { designNumber <- 1L } else if (.isTrialDesignInverseNormal(design)) { designNumber <- 2L } else if (.isTrialDesignFisher(design)) { designNumber <- 3L } if (.isTrialDesignFisher(design)) { alpha0Vec <- design$alpha0Vec futilityBounds <- rep(NA_real_, design$kMax - 1) } else { alpha0Vec <- rep(NA_real_, design$kMax - 1) futilityBounds <- design$futilityBounds } informationRates <- design$informationRates criticalValues <- design$criticalValues kMax <- design$kMax cols <- length(alternative) sampleSizes <- matrix(0, nrow = kMax, ncol = cols) rejectPerStage <- matrix(0, nrow = kMax, ncol = cols) overallReject <- rep(0, cols) futilityPerStage <- matrix(0, kMax - 1, cols) futilityStop <- rep(0, cols) iterations <- matrix(0, nrow = kMax, ncol = cols) expectedNumberOfSubjects <- rep(0, cols) conditionalPowerAchieved <- matrix(NA_real_, nrow = kMax, ncol = cols) len <- length(alternative) * maxNumberOfIterations * kMax dataIterationNumber <- rep(NA_real_, len) dataStageNumber <- rep(NA_real_, len) dataAlternative <- rep(NA_real_, len) dataEffect <- rep(NA_real_, len) dataNumberOfSubjects <- rep(NA_real_, len) dataNumberOfCumulatedSubjects <- rep(NA_real_, len) dataRejectPerStage <- rep(NA_real_, len) dataFutilityPerStage <- rep(NA_real_, len) dataTestStatisticsPerStage <- rep(NA_real_, len) dataTestStatistic <- rep(NA_real_, len) dataTrialStop <- rep(NA, len) dataConditionalPowerAchieved <- rep(NA_real_, len) dataEffectEstimate <- rep(NA_real_, len) if (designNumber == 3L) { dataPValuesSeparate <- rep(NA_real_, len) } if (is.na(stDevH1)) { stDevH1 <- stDev } index <- 1 for (i in 1:length(alternative)) { simulatedSubjects <- rep(0, kMax) simulatedOverallSubjects <- rep(0, kMax) simulatedRejections <- rep(0, kMax) simulatedFutilityStop <- rep(0, kMax - 1) simulatedOverallSubjects <- 0 simulatedConditionalPower <- rep(0, kMax) for (j in 1:maxNumberOfIterations) { trialStop <- FALSE sampleSizesPerStage <- c() testStatisticsPerStage <- c() testStatistic <- NULL effectEstimate <- NULL for (k in 1:kMax) { if (!trialStop) { stepResult <- .getSimulationStepMeans( k = k, kMax = kMax, designNumber = designNumber, informationRates = informationRates, futilityBounds = futilityBounds, alpha0Vec = alpha0Vec, criticalValues = criticalValues, meanRatio = meanRatio, thetaH0 = thetaH0, alternative = alternative[i], stDev = stDev, groups = groups, normalApproximation = normalApproximation, plannedSubjects = plannedSubjects, directionUpper = directionUpper, allocationRatioPlanned = allocationRatioPlanned, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage, conditionalPower = conditionalPower, thetaH1 = thetaH1, stDevH1 = stDevH1, effectEstimate = effectEstimate, sampleSizesPerStage = sampleSizesPerStage, testStatisticsPerStage = testStatisticsPerStage, testStatistic = testStatistic, calcSubjectsFunction = calcSubjectsFunction ) trialStop <- stepResult$trialStop sampleSizesPerStage <- stepResult$sampleSizesPerStage testStatisticsPerStage <- stepResult$testStatisticsPerStage testStatistic <- stepResult$testStatistic simulatedSubjectsStep <- stepResult$simulatedSubjects simulatedRejectionsStep <- stepResult$simulatedRejections simulatedFutilityStopStep <- stepResult$simulatedFutilityStop effectEstimate <- stepResult$effectEstimate simulatedConditionalPowerStep <- NA_real_ if (k > 1) { simulatedConditionalPowerStep <- stepResult$simulatedConditionalPower } iterations[k, i] <- iterations[k, i] + 1 simulatedSubjects[k] <- simulatedSubjects[k] + simulatedSubjectsStep simulatedRejections[k] <- simulatedRejections[k] + simulatedRejectionsStep if (k < kMax) { simulatedFutilityStop[k] <- simulatedFutilityStop[k] + simulatedFutilityStopStep } simulatedConditionalPower[k] <- simulatedConditionalPower[k] + simulatedConditionalPowerStep dataIterationNumber[index] <- j dataStageNumber[index] <- k dataAlternative[index] <- alternative[i] dataNumberOfSubjects[index] <- simulatedSubjectsStep dataNumberOfCumulatedSubjects[index] <- sum(sampleSizesPerStage) dataRejectPerStage[index] <- simulatedRejectionsStep dataFutilityPerStage[index] <- simulatedFutilityStopStep dataTestStatistic[index] <- testStatistic$value dataTestStatisticsPerStage[index] <- testStatisticsPerStage[k] dataTrialStop[index] <- trialStop dataConditionalPowerAchieved[index] <- simulatedConditionalPowerStep dataEffectEstimate[index] <- effectEstimate if (designNumber == 3L) { dataPValuesSeparate[index] <- testStatistic$pValuesSeparate[k] } index <- index + 1 } } } simulatedOverallSubjects <- sum(simulatedSubjects[1:k]) sampleSizes[, i] <- simulatedSubjects / iterations[, i] rejectPerStage[, i] <- simulatedRejections / maxNumberOfIterations overallReject[i] <- sum(simulatedRejections / maxNumberOfIterations) futilityPerStage[, i] <- simulatedFutilityStop / maxNumberOfIterations futilityStop[i] <- sum(simulatedFutilityStop / maxNumberOfIterations) expectedNumberOfSubjects[i] <- simulatedOverallSubjects / maxNumberOfIterations if (kMax > 1) { conditionalPowerAchieved[2:kMax, i] <- simulatedConditionalPower[2:kMax] / iterations[2:kMax, i] } } sampleSizes[is.na(sampleSizes)] <- 0 simulationResults$iterations <- iterations simulationResults$sampleSizes <- sampleSizes simulationResults$rejectPerStage <- rejectPerStage simulationResults$overallReject <- overallReject simulationResults$futilityPerStage <- futilityPerStage simulationResults$futilityStop <- futilityStop if (kMax > 1) { if (length(alternative) == 1) { simulationResults$earlyStop <- sum(futilityPerStage) + sum(rejectPerStage[1:(kMax - 1)]) } else { if (kMax > 2) { rejectPerStageColSum <- colSums(rejectPerStage[1:(kMax - 1), ]) } else { rejectPerStageColSum <- rejectPerStage[1, ] } simulationResults$earlyStop <- colSums(futilityPerStage) + rejectPerStageColSum } } else { simulationResults$earlyStop <- rep(0, length(alternative)) } simulationResults$expectedNumberOfSubjects <- expectedNumberOfSubjects simulationResults$conditionalPowerAchieved <- conditionalPowerAchieved if (!all(is.na(simulationResults$conditionalPowerAchieved))) { simulationResults$.setParameterType("conditionalPowerAchieved", C_PARAM_GENERATED) } data <- data.frame( iterationNumber = dataIterationNumber, stageNumber = dataStageNumber, alternative = dataAlternative, numberOfSubjects = dataNumberOfSubjects, numberOfCumulatedSubjects = dataNumberOfCumulatedSubjects, rejectPerStage = dataRejectPerStage, futilityPerStage = dataFutilityPerStage, testStatistic = dataTestStatistic, testStatisticsPerStage = dataTestStatisticsPerStage, effectEstimate = dataEffectEstimate, trialStop = dataTrialStop, conditionalPowerAchieved = round(dataConditionalPowerAchieved, 6) ) if (designNumber == 3L) { data$pValue <- dataPValuesSeparate } data <- data[!is.na(data$alternative), ] simulationResults$.data <- data return(simulationResults) } rpact/R/f_simulation_base_rates.R0000644000175000017500000014335414153345060016735 0ustar nileshnilesh## | ## | *Simulation of binary data with group sequential and combination test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5615 $ ## | Last changed: $Date: 2021-12-06 09:29:15 +0100 (Mo, 06 Dez 2021) $ ## | Last changed by: $Author: wassmer $ ## | .getTestStatisticsRates <- function(..., designNumber, informationRates, groups, normalApproximation, riskRatio, thetaH0, directionUpper, eventsPerStage, sampleSizesPerStage, testStatisticsPerStage) { stage <- ncol(sampleSizesPerStage) if (groups == 1) { stagewiseRates <- eventsPerStage[, stage] / sampleSizesPerStage[, stage] overallRate <- sum(eventsPerStage[, 1:stage]) / sum(sampleSizesPerStage[, 1:stage]) } else { stagewiseRates <- eventsPerStage[, stage] / sampleSizesPerStage[, stage] if (stage == 1) { overallRate <- eventsPerStage[, 1] / sampleSizesPerStage[, 1] } else { overallRate <- rowSums(eventsPerStage[, 1:stage]) / rowSums(sampleSizesPerStage[, 1:stage]) } } if (designNumber == 1L) { n1 <- sum(sampleSizesPerStage[1, ]) e1 <- sum(eventsPerStage[1, ]) r1 <- e1 / n1 if (groups == 1) { if (!normalApproximation) { if (directionUpper) { value <- .getOneMinusQNorm(stats::pbinom(e1 - 1, n1, thetaH0, lower.tail = FALSE)) } else { value <- .getOneMinusQNorm(stats::pbinom(e1, n1, thetaH0, lower.tail = TRUE)) } } else { value <- (r1 - thetaH0) / sqrt(thetaH0 * (1 - thetaH0)) * sqrt(n1) } } else { n2 <- sum(sampleSizesPerStage[2, ]) e2 <- sum(eventsPerStage[2, ]) r2 <- e2 / n2 if (!normalApproximation) { if (directionUpper) { value <- .getOneMinusQNorm(stats::phyper(e1 - 1, e1 + e2, n1 + n2 - e1 - e2, n1, lower.tail = FALSE)) } else { value <- .getOneMinusQNorm(stats::phyper(e1, e1 + e2, n1 + n2 - e1 - e2, n1, lower.tail = TRUE)) } } else { if (!riskRatio) { if (r1 - r2 - thetaH0 == 0) { value <- 0 } else { fm <- .getFarringtonManningValuesDiff(rate1 = r1, rate2 = r2, theta = thetaH0, allocation = n1 / n2) value <- (r1 - r2 - thetaH0) / sqrt(fm[1] * (1 - fm[1]) / n1 + fm[2] * (1 - fm[2]) / n2) } } else { if (r1 - r2 * thetaH0 == 0) { value <- 0 } else { fm <- .getFarringtonManningValuesRatio(rate1 = r1, rate2 = r2, theta = thetaH0, allocation = n1 / n2) value <- (r1 - r2 * thetaH0) / sqrt(fm[1] * (1 - fm[1]) / n1 + thetaH0^2 * fm[2] * (1 - fm[2]) / n2) } } value <- (2 * directionUpper - 1) * value } } pValuesSeparate <- NA_real_ testStatisticsPerStage <- NA_real_ } else { if (stage == 1) { n1 <- sampleSizesPerStage[1, 1] e1 <- eventsPerStage[1, 1] r1 <- e1 / n1 if (groups == 1) { if (!normalApproximation) { if (directionUpper) { testStatisticsPerStage <- .getOneMinusQNorm( stats::pbinom(e1 - 1, n1, thetaH0, lower.tail = FALSE)) } else { testStatisticsPerStage <- .getOneMinusQNorm( stats::pbinom(e1, n1, thetaH0, lower.tail = TRUE)) } } else { testStatisticsPerStage <- (2 * directionUpper - 1) * (r1 - thetaH0) / sqrt(thetaH0 * (1 - thetaH0)) * sqrt(n1) } } else { n2 <- sampleSizesPerStage[2, 1] e2 <- eventsPerStage[2, 1] r2 <- e2 / n2 if (!normalApproximation) { if (directionUpper) { testStatisticsPerStage <- .getOneMinusQNorm(stats::phyper( e1 - 1, e1 + e2, n1 + n2 - e1 - e2, n1, lower.tail = FALSE)) } else { testStatisticsPerStage <- .getOneMinusQNorm(stats::phyper( e1, e1 + e2, n1 + n2 - e1 - e2, n1, lower.tail = TRUE)) } } else { if (!riskRatio) { if (r1 - r2 - thetaH0 == 0) { testStatisticsPerStage <- 0 } else { fm <- .getFarringtonManningValuesDiff( rate1 = r1, rate2 = r2, theta = thetaH0, allocation = n1 / n2) testStatisticsPerStage <- (2 * directionUpper - 1) * (r1 - r2 - thetaH0) / sqrt(fm[1] * (1 - fm[1]) / n1 + fm[2] * (1 - fm[2]) / n2) } } else { if (r1 - r2 * thetaH0 == 0) { testStatisticsPerStage <- 0 } else { fm <- .getFarringtonManningValuesRatio(rate1 = r1, rate2 = r2, theta = thetaH0, allocation = n1 / n2) testStatisticsPerStage <- (2 * directionUpper - 1) * (r1 - r2 * thetaH0) / sqrt(fm[1] * (1 - fm[1]) / n1 + thetaH0^2 * fm[2] * (1 - fm[2]) / n2) } } } } } else { n1 <- sampleSizesPerStage[1, stage] e1 <- eventsPerStage[1, stage] r1 <- e1 / n1 if (groups == 1) { if (!normalApproximation) { if (directionUpper) { testStatisticsPerStage <- c( testStatisticsPerStage, .getOneMinusQNorm(stats::pbinom(e1 - 1, n1, thetaH0, lower.tail = FALSE)) ) } else { testStatisticsPerStage <- c( testStatisticsPerStage, .getOneMinusQNorm(stats::pbinom(e1, n1, thetaH0, lower.tail = TRUE)) ) } } else { testStatisticsPerStage <- c( testStatisticsPerStage, (2 * directionUpper - 1) * (r1 - thetaH0) / sqrt(thetaH0 * (1 - thetaH0)) * sqrt(n1) ) } } else { n2 <- sampleSizesPerStage[2, stage] e2 <- eventsPerStage[2, stage] r2 <- e2 / n2 if (!normalApproximation) { if (directionUpper) { testStatisticsPerStage <- c( testStatisticsPerStage, .getOneMinusQNorm(stats::phyper(e1 - 1, e1 + e2, n1 + n2 - e1 - e2, n1, lower.tail = FALSE)) ) } else { testStatisticsPerStage <- c( testStatisticsPerStage, .getOneMinusQNorm(stats::phyper(e1, e1 + e2, n1 + n2 - e1 - e2, n1, lower.tail = TRUE)) ) } } else { if (!riskRatio) { if (r1 - r2 - thetaH0 == 0) { testStatisticsPerStage <- c(testStatisticsPerStage, 0) } else { fm <- .getFarringtonManningValuesDiff(rate1 = r1, rate2 = r2, theta = thetaH0, allocation = n1 / n2) testStatisticsPerStage <- c(testStatisticsPerStage, (2 * directionUpper - 1) * (r1 - r2 - thetaH0) / sqrt(fm[1] * (1 - fm[1]) / n1 + fm[2] * (1 - fm[2]) / n2)) } } else { if (r1 - r2 * thetaH0 == 0) { testStatisticsPerStage <- c(testStatisticsPerStage, 0) } else { fm <- .getFarringtonManningValuesRatio(rate1 = r1, rate2 = r2, theta = thetaH0, allocation = n1 / n2) testStatisticsPerStage <- c(testStatisticsPerStage, (2 * directionUpper - 1) * (r1 - r2 * thetaH0) / sqrt(fm[1] * (1 - fm[1]) / n1 + thetaH0^2 * fm[2] * (1 - fm[2]) / n2)) } } } } } if (designNumber == 2L) { if (stage == 1) { value <- testStatisticsPerStage } else { value <- (sqrt(informationRates[1]) * testStatisticsPerStage[1] + sqrt(informationRates[2:stage] - informationRates[1:(stage - 1)]) %*% testStatisticsPerStage[2:stage]) / sqrt(informationRates[stage]) } } else if (designNumber == 3L) { if (stage == 1) { value <- 1 - pnorm(testStatisticsPerStage) } else { weightsFisher <- rep(NA_real_, stage) weightsFisher[1] <- 1 if (stage > 1) { weightsFisher[2:stage] <- sqrt(informationRates[2:stage] - informationRates[1:(stage - 1)]) / sqrt(informationRates[1]) } value <- prod((1 - pnorm(testStatisticsPerStage[1:stage]))^weightsFisher[1:stage]) } } pValuesSeparate <- 1 - pnorm(testStatisticsPerStage) } return(list( value = value, stagewiseRates = stagewiseRates, overallRate = overallRate, sampleSizesPerStage = sampleSizesPerStage, testStatisticsPerStage = testStatisticsPerStage, pValuesSeparate = pValuesSeparate )) } .getSimulationRatesStageSubjects <- function(..., stage, riskRatio, thetaH0, groups, plannedSubjects, directionUpper, allocationRatioPlanned, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage, sampleSizesPerStage, conditionalPower, conditionalCriticalValue, overallRate, farringtonManningValue1, farringtonManningValue2) { if (is.na(conditionalPower)) { return(plannedSubjects[stage] - plannedSubjects[stage - 1]) } if (groups == 1) { stageSubjects <- (max(0, conditionalCriticalValue * sqrt(thetaH0 * (1 - thetaH0)) + .getQNorm(conditionalPower) * sqrt(overallRate[1] * (1 - overallRate[1]))))^2 / (max(1e-12, (2 * directionUpper - 1) * (overallRate[1] - thetaH0)))^2 } else { mult <- 1 corr <- thetaH0 if (riskRatio) { mult <- thetaH0 corr <- 0 } stageSubjects <- (1 + 1 / allocationRatioPlanned) * (max(0, conditionalCriticalValue * sqrt(farringtonManningValue1 * (1 - farringtonManningValue1) + farringtonManningValue2 * (1 - farringtonManningValue2) * allocationRatioPlanned * mult^2) + .getQNorm(conditionalPower) * sqrt(overallRate[1] * (1 - overallRate[1]) + overallRate[2] * (1 - overallRate[2]) * allocationRatioPlanned * mult^2)))^2 / (max(1e-12, (2 * directionUpper - 1) * (overallRate[1] - mult * overallRate[2] - corr)))^2 } stageSubjects <- ceiling(min(max(minNumberOfSubjectsPerStage[stage], stageSubjects), maxNumberOfSubjectsPerStage[stage])) return(stageSubjects) } .getSimulationStepRates <- function(..., k, kMax, designNumber, informationRates, futilityBounds, alpha0Vec, criticalValues, riskRatio, thetaH0, pi1, pi2, groups, normalApproximation, plannedSubjects, directionUpper, allocationRatioPlanned, minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage, conditionalPower, pi1H1, pi2H1, sampleSizesPerStage, eventsPerStage, testStatisticsPerStage, testStatistic, calcSubjectsFunction) { stageSubjects <- plannedSubjects[k] # perform event size recalculation for stages 2, ..., kMax simulatedConditionalPower <- 0 if (k > 1) { # used effect size is either estimated from test statistic or pre-fixed overallRate <- testStatistic$overallRate if (!is.na(pi1H1)) { overallRate[1] <- pi1H1 } if (groups == 2 && !is.na(pi2H1)) { overallRate[2] <- pi2H1 } # conditional critical value to reject the null hypotheses at the next stage of the trial if (designNumber == 3L) { conditionalCriticalValue <- .getOneMinusQNorm((criticalValues[k] / testStatistic$value)^(1 / sqrt((informationRates[k] - informationRates[k - 1]) / informationRates[1]))) } else { if (criticalValues[k] >= 6) { conditionalCriticalValue <- Inf } else { conditionalCriticalValue <- (criticalValues[k] * sqrt(informationRates[k]) - testStatistic$value * sqrt(informationRates[k - 1])) / sqrt(informationRates[k] - informationRates[k - 1]) } } if (groups == 2) { if (!riskRatio) { fm <- .getFarringtonManningValuesDiff( rate1 = overallRate[1], rate2 = overallRate[2], theta = thetaH0, allocation = allocationRatioPlanned ) } else { fm <- .getFarringtonManningValuesRatio( rate1 = overallRate[1], rate2 = overallRate[2], theta = thetaH0, allocation = allocationRatioPlanned ) } } stageSubjects <- calcSubjectsFunction( stage = k, riskRatio = riskRatio, thetaH0 = thetaH0, groups = groups, plannedSubjects = plannedSubjects, directionUpper = directionUpper, allocationRatioPlanned = allocationRatioPlanned, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage, sampleSizesPerStage = sampleSizesPerStage, conditionalPower = conditionalPower, overallRate = overallRate, conditionalCriticalValue = conditionalCriticalValue, farringtonManningValue1 = fm[1], farringtonManningValue2 = fm[2] ) # calculate conditional power for selected stageSubjects if (groups == 1) { if (overallRate[1] * (1 - overallRate[1]) == 0) { theta <- 0 } else { theta <- (overallRate[1] - thetaH0) / sqrt(overallRate[1] * (1 - overallRate[1])) + sign(overallRate[1] - thetaH0) * conditionalCriticalValue * (1 - sqrt(thetaH0 * (1 - thetaH0) / (overallRate[1] * (1 - overallRate[1])))) / sqrt(stageSubjects) } } else { if (overallRate[1] * (1 - overallRate[1]) + overallRate[2] * (1 - overallRate[2]) == 0) { theta <- 0 } else { if (!riskRatio) { theta <- sqrt(allocationRatioPlanned) / (1 + allocationRatioPlanned) * ( (overallRate[1] - overallRate[2] - thetaH0) * sqrt(1 + allocationRatioPlanned) / sqrt(overallRate[1] * (1 - overallRate[1]) + allocationRatioPlanned * overallRate[2] * (1 - overallRate[2])) + sign(overallRate[1] - overallRate[2] - thetaH0) * conditionalCriticalValue * (1 - sqrt(fm[1] * (1 - fm[1]) + allocationRatioPlanned * fm[2] * (1 - fm[2])) / sqrt(overallRate[1] * (1 - overallRate[1]) + allocationRatioPlanned * overallRate[2] * (1 - overallRate[2]))) * (1 + allocationRatioPlanned) / sqrt(allocationRatioPlanned * stageSubjects) ) } else { theta <- sqrt(allocationRatioPlanned) / (1 + allocationRatioPlanned) * ( (overallRate[1] - thetaH0 * overallRate[2]) * sqrt(1 + allocationRatioPlanned) / sqrt(overallRate[1] * (1 - overallRate[1]) + allocationRatioPlanned * thetaH0^2 * overallRate[2] * (1 - overallRate[2])) + sign(overallRate[1] - thetaH0 * overallRate[2]) * conditionalCriticalValue * (1 - sqrt(fm[1] * (1 - fm[1]) + allocationRatioPlanned * thetaH0^2 * fm[2] * (1 - fm[2])) / sqrt(overallRate[1] * (1 - overallRate[1]) + allocationRatioPlanned * thetaH0^2 * overallRate[2] * (1 - overallRate[2]))) * (1 + allocationRatioPlanned) / sqrt(allocationRatioPlanned * stageSubjects)) } } } if (!directionUpper) { theta <- -theta } simulatedConditionalPower <- 1 - stats::pnorm(conditionalCriticalValue - theta * sqrt(stageSubjects)) } # Simulate events with achieved sample size if (groups == 1) { n1 <- stageSubjects eventsPerStage <- cbind(eventsPerStage, matrix(c(stats::rbinom(1, n1, pi1)), nrow = 1)) sampleSizesPerStage <- cbind(sampleSizesPerStage, matrix(n1, nrow = 1)) } else { n1 <- ceiling(allocationRatioPlanned * stageSubjects / (1 + allocationRatioPlanned)) n2 <- stageSubjects - n1 eventsPerStage <- cbind( eventsPerStage, matrix(c(stats::rbinom(1, n1, pi1), stats::rbinom(1, n2, pi2)), nrow = 2) ) sampleSizesPerStage <- cbind(sampleSizesPerStage, matrix(c(n1, n2), nrow = 2)) } testStatistic <- .getTestStatisticsRates( designNumber = designNumber, informationRates = informationRates, groups = groups, normalApproximation = normalApproximation, riskRatio = riskRatio, thetaH0 = thetaH0, directionUpper = directionUpper, eventsPerStage = eventsPerStage, sampleSizesPerStage = sampleSizesPerStage, testStatisticsPerStage = testStatisticsPerStage ) testStatisticsPerStage <- c(testStatisticsPerStage, testStatistic$testStatisticsPerStage[k]) simulatedRejections <- 0 simulatedFutilityStop <- 0 trialStop <- FALSE if (k == kMax) { trialStop <- TRUE } if (designNumber <= 2) { if (!is.na(testStatistic$value) && !is.na(criticalValues[k]) && testStatistic$value >= criticalValues[k]) { simulatedRejections <- 1 trialStop <- TRUE } # add small number to avoid ties if (!is.na(testStatistic$value) && !is.na(futilityBounds[k]) && k < kMax && testStatistic$value <= futilityBounds[k]) { simulatedFutilityStop <- 1 trialStop <- TRUE } } else { if (!is.na(testStatistic$value) && !is.na(criticalValues[k]) && testStatistic$value <= criticalValues[k]) { simulatedRejections <- 1 trialStop <- TRUE } if (!is.na(testStatistic$pValuesSeparate[k]) && !is.na(alpha0Vec[k]) && k < kMax && testStatistic$pValuesSeparate[k] >= alpha0Vec[k]) { simulatedFutilityStop <- 1 trialStop <- TRUE } } return(list( trialStop = trialStop, sampleSizesPerStage = sampleSizesPerStage, eventsPerStage = eventsPerStage, testStatisticsPerStage = testStatisticsPerStage, testStatistic = testStatistic, simulatedSubjects = stageSubjects, simulatedRejections = simulatedRejections, simulatedFutilityStop = simulatedFutilityStop, simulatedConditionalPower = simulatedConditionalPower )) } #' @title #' Get Simulation Rates #' #' @description #' Returns the simulated power, stopping probabilities, conditional power, and expected sample size for #' testing rates in a one or two treatment groups testing situation. #' #' @inheritParams param_design_with_default #' @inheritParams param_groups #' @inheritParams param_normalApproximation #' @param riskRatio If \code{TRUE}, the design characteristics for #' one-sided testing of H0: \code{pi1 / pi2 = thetaH0} are simulated, default is \code{FALSE}. #' @inheritParams param_thetaH0 #' @inheritParams param_pi1_rates #' @inheritParams param_pi2_rates #' @inheritParams param_directionUpper #' @inheritParams param_allocationRatioPlanned #' @inheritParams param_plannedSubjects #' @inheritParams param_minNumberOfSubjectsPerStage #' @inheritParams param_maxNumberOfSubjectsPerStage #' @inheritParams param_conditionalPowerSimulation #' @param pi1H1 If specified, the assumed probability in the active treatment group if two treatment groups #' are considered, or the assumed probability for a one treatment group design, for which the conditional #' power was calculated. #' @param pi2H1 If specified, the assumed probability in the reference group if two treatment groups #' are considered, for which the conditional power was calculated. #' @inheritParams param_maxNumberOfIterations #' @inheritParams param_calcSubjectsFunction #' @inheritParams param_seed #' @inheritParams param_three_dots #' @inheritParams param_showStatistics #' #' @details #' At given design the function simulates the power, stopping probabilities, conditional power, and expected #' sample size at given number of subjects and parameter configuration. #' Additionally, an allocation ratio = n1/n2 can be specified where n1 and n2 are the number #' of subjects in the two treatment groups. #' #' The definition of \code{pi1H1} and/or \code{pi2H1} makes only sense if \code{kMax} > 1 #' and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and #' \code{maxNumberOfSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. #' #' \code{calcSubjectsFunction}\cr #' This function returns the number of subjects at given conditional power and conditional critical value for specified #' testing situation. The function might depend on variables #' \code{stage}, #' \code{riskRatio}, #' \code{thetaH0}, #' \code{groups}, #' \code{plannedSubjects}, #' \code{sampleSizesPerStage}, #' \code{directionUpper}, #' \code{allocationRatioPlanned}, #' \code{minNumberOfSubjectsPerStage}, #' \code{maxNumberOfSubjectsPerStage}, #' \code{conditionalPower}, #' \code{conditionalCriticalValue}, #' \code{overallRate}, #' \code{farringtonManningValue1}, and \code{farringtonManningValue2}. #' The function has to contain the three-dots argument '...' (see examples). #' #' @section Simulation Data: #' The summary statistics "Simulated data" contains the following parameters: median [range]; mean +/-sd\cr #' #' \code{$show(showStatistics = FALSE)} or \code{$setShowStatistics(FALSE)} can be used to disable #' the output of the aggregated simulated data.\cr #' #' Example 1: \cr #' \code{simulationResults <- getSimulationRates(plannedSubjects = 40)} \cr #' \code{simulationResults$show(showStatistics = FALSE)}\cr #' #' Example 2: \cr #' \code{simulationResults <- getSimulationRates(plannedSubjects = 40)} \cr #' \code{simulationResults$setShowStatistics(FALSE)}\cr #' \code{simulationResults}\cr #' #' \code{\link{getData}} can be used to get the aggregated simulated data from the #' object as \code{\link[base]{data.frame}}. The data frame contains the following columns: #' \enumerate{ #' \item \code{iterationNumber}: The number of the simulation iteration. #' \item \code{stageNumber}: The stage. #' \item \code{pi1}: The assumed or derived event rate in the treatment group (if available). #' \item \code{pi2}: The assumed or derived event rate in the control group (if available). #' \item \code{numberOfSubjects}: The number of subjects under consideration when the #' (interim) analysis takes place. #' \item \code{rejectPerStage}: 1 if null hypothesis can be rejected, 0 otherwise. #' \item \code{futilityPerStage}: 1 if study should be stopped for futility, 0 otherwise. #' \item \code{testStatistic}: The test statistic that is used for the test decision, #' depends on which design was chosen (group sequential, inverse normal, #' or Fisher combination test)' #' \item \code{testStatisticsPerStage}: The test statistic for each stage if only data from #' the considered stage is taken into account. #' \item \code{overallRate1}: The cumulative rate in treatment group 1. #' \item \code{overallRate2}: The cumulative rate in treatment group 2. #' \item \code{stagewiseRates1}: The stage-wise rate in treatment group 1. #' \item \code{stagewiseRates2}: The stage-wise rate in treatment group 2. #' \item \code{sampleSizesPerStage1}: The stage-wise sample size in treatment group 1. #' \item \code{sampleSizesPerStage2}: The stage-wise sample size in treatment group 2. #' \item \code{trialStop}: \code{TRUE} if study should be stopped for efficacy or futility or final stage, \code{FALSE} otherwise. #' \item \code{conditionalPowerAchieved}: The conditional power for the subsequent stage of the trial for #' selected sample size and effect. The effect is either estimated from the data or can be #' user defined with \code{pi1H1} and \code{pi2H1}. #' } #' #' @template return_object_simulation_results #' @template how_to_get_help_for_generics #' #' @template examples_get_simulation_rates #' #' @export #' getSimulationRates <- function(design = NULL, ..., groups = 2L, normalApproximation = TRUE, riskRatio = FALSE, thetaH0 = ifelse(riskRatio, 1, 0), pi1 = seq(0.2, 0.5, 0.1), # C_PI_1_DEFAULT pi2 = NA_real_, plannedSubjects = NA_real_, directionUpper = TRUE, # C_DIRECTION_UPPER_DEFAULT allocationRatioPlanned = NA_real_, minNumberOfSubjectsPerStage = NA_real_, maxNumberOfSubjectsPerStage = NA_real_, conditionalPower = NA_real_, pi1H1 = NA_real_, pi2H1 = NA_real_, maxNumberOfIterations = 1000L, # C_MAX_SIMULATION_ITERATIONS_DEFAULT seed = NA_real_, calcSubjectsFunction = NULL, showStatistics = FALSE) { if (is.null(design)) { design <- .getDefaultDesign(..., type = "simulation") .warnInCaseOfUnknownArguments( functionName = "getSimulationRates", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "showStatistics"), ... ) } else { .assertIsTrialDesign(design) .warnInCaseOfUnknownArguments(functionName = "getSimulationRates", ignore = "showStatistics", ...) .warnInCaseOfTwoSidedPowerArgument(...) } .assertIsSingleLogical(directionUpper, "directionUpper") .assertIsSingleNumber(thetaH0, "thetaH0") .assertIsValidGroupsParameter(groups) .assertIsSingleLogical(normalApproximation, "normalApproximation") .assertIsSingleLogical(riskRatio, "riskRatio") if (groups == 1L) { .assertIsInOpenInterval(thetaH0, "thetaH0", 0, 1, naAllowed = FALSE) } else { if (riskRatio) { .assertIsInOpenInterval(thetaH0, "thetaH0", 0, NULL, naAllowed = TRUE) } else { .assertIsInOpenInterval(thetaH0, "thetaH0", -1, 1, naAllowed = TRUE) } } .assertIsNumericVector(pi1, "pi1", naAllowed = FALSE) .assertIsInOpenInterval(pi1, "pi1", 0, 1, naAllowed = FALSE) .assertIsNumericVector(pi2, "pi2", naAllowed = TRUE) .assertIsInOpenInterval(pi2, "pi2", 0, 1, naAllowed = TRUE) .assertIsNumericVector(minNumberOfSubjectsPerStage, "minNumberOfSubjectsPerStage", naAllowed = TRUE ) .assertIsNumericVector(maxNumberOfSubjectsPerStage, "maxNumberOfSubjectsPerStage", naAllowed = TRUE ) .assertIsSingleNumber(conditionalPower, "conditionalPower", naAllowed = TRUE) .assertIsInOpenInterval(conditionalPower, "conditionalPower", 0, 1, naAllowed = TRUE) .assertIsSingleNumber(pi1H1, "pi1H1", naAllowed = TRUE) .assertIsInOpenInterval(pi1H1, "pi1H1", 0, 1, naAllowed = TRUE) .assertIsSingleNumber(pi2H1, "pi2H1", naAllowed = TRUE) .assertIsInOpenInterval(pi2H1, "pi2H1", 0, 1, naAllowed = TRUE) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned", naAllowed = TRUE) .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM, naAllowed = TRUE ) .assertIsSinglePositiveInteger(maxNumberOfIterations, "maxNumberOfIterations", validateType = FALSE ) .assertIsSingleNumber(seed, "seed", naAllowed = TRUE) .assertIsSingleLogical(showStatistics, "showStatistics", naAllowed = FALSE) if (design$sided == 2) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "only one-sided case is implemented for the simulation design" ) } if (!normalApproximation && (groups == 2) && (riskRatio || (thetaH0 != 0))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "in the two-sample case, exact test is implemented only for testing H0: pi1 - pi2 = 0" ) } simulationResults <- SimulationResultsRates(design, showStatistics = showStatistics) conditionalPower <- .ignoreParameterIfNotUsed( "conditionalPower", conditionalPower, design$kMax > 1, "design is fixed ('kMax' = 1)" ) minNumberOfSubjectsPerStage <- .ignoreParameterIfNotUsed( "minNumberOfSubjectsPerStage", minNumberOfSubjectsPerStage, design$kMax > 1, "design is fixed ('kMax' = 1)" ) maxNumberOfSubjectsPerStage <- .ignoreParameterIfNotUsed( "maxNumberOfSubjectsPerStage", maxNumberOfSubjectsPerStage, design$kMax > 1, "design is fixed ('kMax' = 1)" ) minNumberOfSubjectsPerStage <- .assertIsValidNumberOfSubjectsPerStage(minNumberOfSubjectsPerStage, "minNumberOfSubjectsPerStage", plannedSubjects, conditionalPower, calcSubjectsFunction, design$kMax, endpoint = "rates" ) maxNumberOfSubjectsPerStage <- .assertIsValidNumberOfSubjectsPerStage(maxNumberOfSubjectsPerStage, "maxNumberOfSubjectsPerStage", plannedSubjects, conditionalPower, calcSubjectsFunction, design$kMax, endpoint = "rates" ) if (design$kMax > 1) { if (any(maxNumberOfSubjectsPerStage - minNumberOfSubjectsPerStage < 0) && !all(is.na(maxNumberOfSubjectsPerStage - minNumberOfSubjectsPerStage))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjectsPerStage' (", .arrayToString(maxNumberOfSubjectsPerStage), ") must be not smaller than minNumberOfSubjectsPerStage' (", .arrayToString(minNumberOfSubjectsPerStage), ")" ) } .setValueAndParameterType( simulationResults, "minNumberOfSubjectsPerStage", minNumberOfSubjectsPerStage, NA_real_ ) .setValueAndParameterType( simulationResults, "maxNumberOfSubjectsPerStage", maxNumberOfSubjectsPerStage, NA_real_ ) } if (!is.na(conditionalPower) && (design$kMax == 1)) { warning("'conditionalPower' will be ignored for fixed sample design", call. = FALSE) } if (!is.null(calcSubjectsFunction) && (design$kMax == 1)) { warning("'calcSubjectsFunction' will be ignored for fixed sample design", call. = FALSE) } else if (!is.null(calcSubjectsFunction) && is.function(calcSubjectsFunction)) { simulationResults$calcSubjectsFunction <- calcSubjectsFunction } if (is.na(conditionalPower) && is.null(calcSubjectsFunction)) { if (length(minNumberOfSubjectsPerStage) != 1 || !is.na(minNumberOfSubjectsPerStage)) { warning("'minNumberOfSubjectsPerStage' (", .arrayToString(minNumberOfSubjectsPerStage), ") ", "will be ignored because neither 'conditionalPower' nor ", "'calcSubjectsFunction' is defined", call. = FALSE ) simulationResults$minNumberOfSubjectsPerStage <- NA_real_ } if (length(maxNumberOfSubjectsPerStage) != 1 || !is.na(maxNumberOfSubjectsPerStage)) { warning("'maxNumberOfSubjectsPerStage' (", .arrayToString(maxNumberOfSubjectsPerStage), ") ", "will be ignored because neither 'conditionalPower' nor ", "'calcSubjectsFunction' is defined", call. = FALSE ) simulationResults$maxNumberOfSubjectsPerStage <- NA_real_ } } simulationResults$.setParameterType( "calcSubjectsFunction", ifelse(design$kMax == 1, C_PARAM_NOT_APPLICABLE, ifelse(!is.null(calcSubjectsFunction) && design$kMax > 1, C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE ) ) ) pi1H1 <- .ignoreParameterIfNotUsed( "pi1H1", pi1H1, design$kMax > 1, "design is fixed ('kMax' = 1)" ) pi2H1 <- .ignoreParameterIfNotUsed( "pi2H1", pi2H1, design$kMax > 1, "design is fixed ('kMax' = 1)" ) pi1H1 <- .ignoreParameterIfNotUsed("pi1H1", pi1H1, groups == 2, "'groups' = 1") pi2H1 <- .ignoreParameterIfNotUsed("pi2H1", pi2H1, groups == 2, "'groups' = 1") if (is.null(calcSubjectsFunction)) { calcSubjectsFunction <- .getSimulationRatesStageSubjects } .assertIsValidFunction( fun = calcSubjectsFunction, funArgName = "calcSubjectsFunction", expectedFunction = .getSimulationRatesStageSubjects ) .setValueAndParameterType(simulationResults, "pi2", pi2, NA_real_) .setValueAndParameterType( simulationResults, "allocationRatioPlanned", allocationRatioPlanned, NA_real_ ) if (groups == 1) { if (isTRUE(riskRatio)) { warning("'riskRatio' (", riskRatio, ") will be ignored ", "because it is not applicable for 'groups' = 1", call. = FALSE ) } if (!is.na(allocationRatioPlanned)) { warning("'allocationRatioPlanned' (", allocationRatioPlanned, ") will be ignored because it is not applicable for 'groups' = 1", call. = FALSE ) simulationResults$allocationRatioPlanned <- NA_real_ } simulationResults$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) if (!is.na(pi2)) { warning("'pi2' (", pi2, ") will be ignored because it is not applicable for 'groups' = 1", call. = FALSE ) simulationResults$pi2 <- NA_real_ } simulationResults$.setParameterType("pi2", C_PARAM_NOT_APPLICABLE) } else { if (is.na(allocationRatioPlanned)) { allocationRatioPlanned <- C_ALLOCATION_RATIO_DEFAULT simulationResults$allocationRatioPlanned <- allocationRatioPlanned simulationResults$.setParameterType("allocationRatioPlanned", C_PARAM_DEFAULT_VALUE) } if (is.na(pi2)) { pi2 <- C_PI_2_DEFAULT simulationResults$pi2 <- pi2 simulationResults$.setParameterType("pi2", C_PARAM_DEFAULT_VALUE) } } if (groups == 1) { effect <- pi1 - thetaH0 } else { if (riskRatio) { effect <- pi1 / pi2 - thetaH0 } else { effect <- pi1 - pi2 - thetaH0 } } simulationResults$effect <- effect simulationResults$.setParameterType( "effect", ifelse(groups == 1 && thetaH0 == 0, C_PARAM_NOT_APPLICABLE, C_PARAM_GENERATED) ) .assertIsIntegerVector(plannedSubjects, "plannedSubjects", validateType = FALSE) if (length(plannedSubjects) != design$kMax) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'plannedSubjects' (", .arrayToString(plannedSubjects), ") must have length ", design$kMax ) } .assertIsInClosedInterval(plannedSubjects, "plannedSubjects", lower = 1, upper = NULL) .assertValuesAreStrictlyIncreasing(plannedSubjects, "plannedSubjects") .setValueAndParameterType(simulationResults, "normalApproximation", normalApproximation, TRUE) .setValueAndParameterType(simulationResults, "riskRatio", riskRatio, FALSE) .setValueAndParameterType(simulationResults, "thetaH0", thetaH0, ifelse(riskRatio, 1, 0)) .setValueAndParameterType(simulationResults, "pi1", pi1, C_PI_1_DEFAULT) .setValueAndParameterType(simulationResults, "groups", as.integer(groups), 2L) .setValueAndParameterType( simulationResults, "plannedSubjects", plannedSubjects, NA_real_ ) .setValueAndParameterType( simulationResults, "directionUpper", directionUpper, C_DIRECTION_UPPER_DEFAULT ) .setValueAndParameterType(simulationResults, "minNumberOfSubjectsPerStage", minNumberOfSubjectsPerStage, NA_real_, notApplicableIfNA = TRUE ) .setValueAndParameterType(simulationResults, "maxNumberOfSubjectsPerStage", maxNumberOfSubjectsPerStage, NA_real_, notApplicableIfNA = TRUE ) .setValueAndParameterType(simulationResults, "conditionalPower", conditionalPower, NA_real_, notApplicableIfNA = TRUE ) .setValueAndParameterType(simulationResults, "pi1H1", pi1H1, NA_real_, notApplicableIfNA = TRUE ) .setValueAndParameterType(simulationResults, "pi2H1", pi2H1, 0.2, notApplicableIfNA = TRUE) .setValueAndParameterType( simulationResults, "maxNumberOfIterations", as.integer(maxNumberOfIterations), C_MAX_SIMULATION_ITERATIONS_DEFAULT ) simulationResults$.setParameterType("seed", ifelse(is.na(seed), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) simulationResults$seed <- .setSeed(seed) if (.isTrialDesignGroupSequential(design)) { designNumber <- 1L } else if (.isTrialDesignInverseNormal(design)) { designNumber <- 2L } else if (.isTrialDesignFisher(design)) { designNumber <- 3L } if (.isTrialDesignFisher(design)) { alpha0Vec <- design$alpha0Vec futilityBounds <- rep(NA_real_, design$kMax - 1) } else { alpha0Vec <- rep(NA_real_, design$kMax - 1) futilityBounds <- design$futilityBounds } informationRates <- design$informationRates criticalValues <- design$criticalValues kMax <- design$kMax cols <- length(pi1) sampleSizes <- matrix(0, nrow = kMax, ncol = cols) rejectPerStage <- matrix(0, nrow = kMax, ncol = cols) overallReject <- rep(0, cols) futilityPerStage <- matrix(0, kMax - 1, cols) futilityStop <- rep(0, cols) iterations <- matrix(0, nrow = kMax, ncol = cols) expectedNumberOfSubjects <- rep(0, cols) conditionalPowerAchieved <- matrix(NA_real_, nrow = kMax, ncol = cols) len <- length(pi1) * maxNumberOfIterations * kMax dataIterationNumber <- rep(NA_real_, len) dataStageNumber <- rep(NA_real_, len) dataPi1 <- rep(NA_real_, len) dataPi2 <- rep(pi2, len) dataNumberOfSubjects <- rep(NA_real_, len) dataNumberOfCumulatedSubjects <- rep(NA_real_, len) dataRejectPerStage <- rep(NA_real_, len) dataFutilityPerStage <- rep(NA_real_, len) dataTestStatistic <- rep(NA_real_, len) dataTestStatisticsPerStage <- rep(NA_real_, len) dataOverallRate1 <- rep(NA_real_, len) dataOverallRate2 <- rep(NA_real_, len) dataStagewiseRates1 <- rep(NA_real_, len) dataStagewiseRates2 <- rep(NA_real_, len) dataSampleSizesPerStage1 <- rep(NA_real_, len) dataSampleSizesPerStage2 <- rep(NA_real_, len) dataTrialStop <- rep(NA, len) dataConditionalPowerAchieved <- rep(NA_real_, len) if (designNumber != 1L) { dataPValuesSeparate <- rep(NA_real_, len) } index <- 1 for (i in 1:length(pi1)) { simulatedSubjects <- rep(0, kMax) simulatedOverallSubjects <- rep(0, kMax) simulatedRejections <- rep(0, kMax) simulatedFutilityStop <- rep(0, kMax - 1) simulatedOverallSubjects <- 0 simulatedConditionalPower <- rep(0, kMax) for (j in 1:maxNumberOfIterations) { trialStop <- FALSE sampleSizesPerStage <- matrix(rep(numeric(0), 2), nrow = groups) eventsPerStage <- matrix(rep(numeric(0), 2), nrow = groups) testStatisticsPerStage <- c() testStatistic <- NULL for (k in 1:kMax) { if (!trialStop) { stepResult <- .getSimulationStepRates( k = k, kMax = kMax, designNumber = designNumber, informationRates = informationRates, futilityBounds = futilityBounds, alpha0Vec = alpha0Vec, criticalValues = criticalValues, riskRatio = riskRatio, thetaH0 = thetaH0, pi1 = pi1[i], pi2 = pi2, groups = groups, normalApproximation = normalApproximation, plannedSubjects = plannedSubjects, directionUpper = directionUpper, allocationRatioPlanned = allocationRatioPlanned, minNumberOfSubjectsPerStage = minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage = maxNumberOfSubjectsPerStage, conditionalPower = conditionalPower, pi1H1 = pi1H1, pi2H1 = pi2H1, sampleSizesPerStage = sampleSizesPerStage, eventsPerStage = eventsPerStage, testStatisticsPerStage = testStatisticsPerStage, testStatistic = testStatistic, calcSubjectsFunction = calcSubjectsFunction ) trialStop <- stepResult$trialStop sampleSizesPerStage <- stepResult$sampleSizesPerStage eventsPerStage <- stepResult$eventsPerStage testStatisticsPerStage <- stepResult$testStatisticsPerStage testStatistic <- stepResult$testStatistic simulatedSubjectsStep <- stepResult$simulatedSubjects simulatedRejectionsStep <- stepResult$simulatedRejections simulatedFutilityStopStep <- stepResult$simulatedFutilityStop simulatedConditionalPowerStep <- NA_real_ if (k > 1) { simulatedConditionalPowerStep <- stepResult$simulatedConditionalPower } iterations[k, i] <- iterations[k, i] + 1 simulatedSubjects[k] <- simulatedSubjects[k] + simulatedSubjectsStep simulatedRejections[k] <- simulatedRejections[k] + simulatedRejectionsStep if (k < kMax) { simulatedFutilityStop[k] <- simulatedFutilityStop[k] + simulatedFutilityStopStep } simulatedConditionalPower[k] <- simulatedConditionalPower[k] + simulatedConditionalPowerStep dataIterationNumber[index] <- j dataStageNumber[index] <- k dataPi1[index] <- pi1[i] dataNumberOfSubjects[index] <- simulatedSubjectsStep dataNumberOfCumulatedSubjects[index] <- sum(sampleSizesPerStage[, ]) dataRejectPerStage[index] <- simulatedRejectionsStep dataFutilityPerStage[index] <- simulatedFutilityStopStep dataTestStatistic[index] <- testStatistic$value dataTestStatisticsPerStage[index] <- testStatisticsPerStage[k] dataOverallRate1[index] <- testStatistic$overallRate[1] dataStagewiseRates1[index] <- testStatistic$stagewiseRates[1] dataSampleSizesPerStage1[index] <- testStatistic$sampleSizesPerStage[1, k] if (length(testStatistic$stagewiseRates) > 1) { dataOverallRate2[index] <- testStatistic$overallRate[2] dataStagewiseRates2[index] <- testStatistic$stagewiseRates[2] dataSampleSizesPerStage2[index] <- testStatistic$sampleSizesPerStage[2, k] } else { dataStagewiseRates2[index] <- NA_real_ dataOverallRate2[index] <- NA_real_ dataSampleSizesPerStage2[index] <- NA_real_ } dataTrialStop[index] <- trialStop dataConditionalPowerAchieved[index] <- simulatedConditionalPowerStep if (designNumber != 1L) { dataPValuesSeparate[index] <- testStatistic$pValuesSeparate[k] } index <- index + 1 } } } simulatedOverallSubjects <- sum(simulatedSubjects[1:k]) sampleSizes[, i] <- simulatedSubjects / iterations[, i] rejectPerStage[, i] <- simulatedRejections / maxNumberOfIterations overallReject[i] <- sum(simulatedRejections / maxNumberOfIterations) futilityPerStage[, i] <- simulatedFutilityStop / maxNumberOfIterations futilityStop[i] <- sum(simulatedFutilityStop / maxNumberOfIterations) expectedNumberOfSubjects[i] <- simulatedOverallSubjects / maxNumberOfIterations if (kMax > 1) { conditionalPowerAchieved[2:kMax, i] <- simulatedConditionalPower[2:kMax] / iterations[2:kMax, i] } } sampleSizes[is.na(sampleSizes)] <- 0 simulationResults$iterations <- iterations simulationResults$sampleSizes <- sampleSizes simulationResults$rejectPerStage <- rejectPerStage simulationResults$overallReject <- overallReject simulationResults$futilityPerStage <- futilityPerStage simulationResults$futilityStop <- futilityStop if (kMax > 1) { if (length(pi1) == 1) { simulationResults$earlyStop <- sum(futilityPerStage) + sum(rejectPerStage[1:(kMax - 1)]) } else { if (kMax > 2) { rejectPerStageColSum <- colSums(rejectPerStage[1:(kMax - 1), ]) } else { rejectPerStageColSum <- rejectPerStage[1, ] } simulationResults$earlyStop <- colSums(futilityPerStage) + rejectPerStageColSum } } else { simulationResults$earlyStop <- rep(0, length(pi1)) } simulationResults$expectedNumberOfSubjects <- expectedNumberOfSubjects simulationResults$conditionalPowerAchieved <- conditionalPowerAchieved if (!all(is.na(simulationResults$conditionalPowerAchieved))) { simulationResults$.setParameterType("conditionalPowerAchieved", C_PARAM_GENERATED) } data <- data.frame( iterationNumber = dataIterationNumber, stageNumber = dataStageNumber, pi1 = dataPi1, pi2 = dataPi2, numberOfSubjects = dataNumberOfSubjects, numberOfCumulatedSubjects = dataNumberOfCumulatedSubjects, rejectPerStage = dataRejectPerStage, futilityPerStage = dataFutilityPerStage, testStatistic = dataTestStatistic, testStatisticsPerStage = dataTestStatisticsPerStage, overallRate1 = dataOverallRate1, overallRate2 = dataOverallRate2, stagewiseRates1 = dataStagewiseRates1, stagewiseRates2 = dataStagewiseRates2, sampleSizesPerStage1 = dataSampleSizesPerStage1, sampleSizesPerStage2 = dataSampleSizesPerStage2, trialStop = dataTrialStop, conditionalPowerAchieved = round(dataConditionalPowerAchieved, 6) ) if (designNumber == 3L) { data$pValue <- dataPValuesSeparate } data <- data[!is.na(data$pi1), ] simulationResults$.data <- data return(simulationResults) } rpact/R/f_design_fisher_combination_test.R0000644000175000017500000011521314165524244020612 0ustar nileshnilesh## | ## | *Fisher combination test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5684 $ ## | Last changed: $Date: 2022-01-05 12:27:24 +0100 (Mi, 05 Jan 2022) $ ## | Last changed by: $Author: wassmer $ ## | #' @include f_core_constants.R #' @include f_core_utilities.R NULL .isEqual <- function(x, y) { return(abs(x - y) < 1e-10) } .getFisherCombinationCaseKmax2 <- function(tVec) { return(ifelse(.isEqual(tVec[1], 1), 1L, 2L)) } .getFisherCombinationSizeKmax2 <- function(alpha0Vec, criticalValues, tVec, piValue, case = .getFisherCombinationCaseKmax2(tVec)) { a1 <- alpha0Vec[1] c1 <- criticalValues[1] c2 <- criticalValues[2] t2 <- tVec[1] .assertIsValidForLogarithmization(list(a1 = a1, c1 = c1)) if (case == 1) { return(piValue + c2 * (log(a1) - log(c1))) } else { return(piValue + c2^(1 / t2) * t2 / (t2 - 1) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2))) } } .getFisherCombinationCaseKmax3 <- function(tVec) { t2 <- tVec[1] t3 <- tVec[2] if (.isEqual(t2, 1) && .isEqual(t3, 1)) { return(1L) } else if (!.isEqual(t2, t3) && !.isEqual(t2, 1) && !.isEqual(t3, 1)) { return(2L) } else if (.isEqual(t2, t3) && !.isEqual(t2, 1)) { return(3L) } else if (.isEqual(t2, 1) && !.isEqual(t3, 1)) { return(4L) } else if (!.isEqual(t2, 1) && .isEqual(t3, 1)) { return(5L) } } .getFisherCombinationSizeKmax3 <- function(alpha0Vec, criticalValues, tVec, piValue, case = .getFisherCombinationCaseKmax3(tVec)) { a1 <- alpha0Vec[1] a2 <- alpha0Vec[2] c1 <- criticalValues[1] c2 <- criticalValues[2] c3 <- criticalValues[3] t2 <- tVec[1] t3 <- tVec[2] .assertIsValidForLogarithmization(list(a1 = a1, a2 = a2, c1 = c1, c2 = c2)) if (case == 1) { ## Wassmer 1999, recursive formula return(piValue + c3 * (log(a2) * log(a1) - log(a2) * log(c1) + 0.5 * (log(a1 / c2))^2 - 0.5 * (log(c1 / c2))^2)) } else if (case == 2) { return(piValue + c3^(1 / t3) * t3 / (t3 - t2) * ( a2^(1 - t2 / t3) * t3 / (t3 - 1) * (a1^(1 - 1 / t3) - c1^(1 - 1 / t3)) - c2^(1 / t2 - 1 / t3) * t2 / (t2 - 1) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)))) } else if (case == 3) { return(piValue + c3^(1 / t3) * t3 / (t3 - 1) * ( a1^(1 - 1 / t3) * (log(a2) - 1 / t2 * (log(c2) - log(a1) + t3 / (t3 - 1))) - c1^(1 - 1 / t3) * (log(a2) - 1 / t2 * (log(c2) - log(c1) + t3 / (t3 - 1))))) } else if (case == 4) { return(piValue + c3^(1 / t3) * t3 / (t3 - 1) * (a2^(1 - 1 / t3) * t3 / (t3 - 1) * (a1^(1 - 1 / t3) - c1^(1 - 1 / t3)) - c2^(1 - 1 / t3) * (log(a1) - log(c1)))) } else if (case == 5) { return(piValue + c3 / (1 - t2) * (a2^(1 - t2) * (log(a1) - log(c1)) - c2^(1 / t2 - 1) * t2 / (t2 - 1) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)))) } } .getFisherCombinationCaseKmax4 <- function(tVec) { t2 <- tVec[1] t3 <- tVec[2] t4 <- tVec[3] return(ifelse( .isEqual(t2, 1) && .isEqual(t3, 1) && .isEqual(t4, 1), 1L, 2L )) } .getFisherCombinationSizeApproximatelyKmax4 <- function(alpha0Vec, criticalValues, tVec, piValue, case = .getFisherCombinationCaseKmax4(tVec)) { a1 <- alpha0Vec[1] a2 <- alpha0Vec[2] a3 <- alpha0Vec[3] c1 <- criticalValues[1] c2 <- criticalValues[2] c3 <- criticalValues[3] c4 <- criticalValues[4] t2 <- tVec[1] t3 <- tVec[2] t4 <- tVec[3] .assertIsValidForLogarithmization(list(a1 = a1, a2 = a2, a3 = a3, c1 = c1, c2 = c2, c3 = c3)) ## Wassmer 1999, recursive formula if (case == 1) { return(piValue + c4 * (1 / 6 * log(a1 * a2 / c3)^3 - 1 / 6 * log(c1 * a2 / c3)^3 + 0.5 * log(c2 / c3)^2 * log(c1) - 0.5 * log(c2 / c3)^2 * log(a1) + 0.5 * log(a1 / c2)^2 * log(a3) - 0.5 * log(c1 / c2)^2 * log(a3) + log(a3) * log(a2) * log(a1) - log(c1) * log(a2) * log(a3))) } ## general case for K = 4 else { eps <- 1e-05 if (.isEqual(t2, 1)) t2 <- t2 + eps if (.isEqual(t3, 1)) t3 <- t3 + eps if (.isEqual(t4, 1)) t4 <- t4 + eps if (.isEqual(t2, t3)) t3 <- t2 + eps if (.isEqual(t2, t4)) t4 <- t2 + eps if (.isEqual(t3, t4)) t4 <- t3 + eps return(piValue + c4^(1 / t4) * t4 / (t4 - t3) * ( t4 / (t4 - t2) * t4 / (t4 - 1) * a3^(1 - t3 / t4) * a2^(1 - t2 / t4) * (a1^(1 - 1 / t4) - c1^(1 - 1 / t4)) - t4 / (t4 - t2) * t2 / (t2 - 1) * a3^(1 - t3 / t4) * c2^(1 / t2 - 1 / t4) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)) - t3 / (t3 - t2) * t3 / (t3 - 1) * c3^(1 / t3 - 1 / t4) * a2^(1 - t2 / t3) * (a1^(1 - 1 / t3) - c1^(1 - 1 / t3)) + t3 / (t3 - t2) * t2 / (t2 - 1) * c3^(1 / t3 - 1 / t4) * c2^(1 / t2 - 1 / t3) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)))) } } .getFisherCombinationCaseKmax5 <- function(tVec) { t2 <- tVec[1] t3 <- tVec[2] t4 <- tVec[3] t5 <- tVec[4] return(ifelse( .isEqual(t2, 1) && .isEqual(t3, 1) && .isEqual(t4, 1) && .isEqual(t5, 1), 1L, 2L )) } .getFisherCombinationSizeApproximatelyKmax5 <- function(alpha0Vec, criticalValues, tVec, piValue, case = .getFisherCombinationCaseKmax5(tVec)) { a1 <- alpha0Vec[1] a2 <- alpha0Vec[2] a3 <- alpha0Vec[3] a4 <- alpha0Vec[4] c1 <- criticalValues[1] c2 <- criticalValues[2] c3 <- criticalValues[3] c4 <- criticalValues[4] c5 <- criticalValues[5] t2 <- tVec[1] t3 <- tVec[2] t4 <- tVec[3] t5 <- tVec[4] .assertIsValidForLogarithmization(list(a1 = a1, a2 = a2, a3 = a3, a4 = a4, c1 = c1, c2 = c2, c3 = c3, c4 = c4)) ## Wassmer 1999, recursive formula if (case == 1) { return(piValue + c5 * (1 / 24 * log(a1 * a2 * a3 / c4)^4 - 1 / 24 * log(c1 * a2 * a3 / c4)^4 + 1 / 6 * log(c2 * a3 / c4)^3 * log(c1) - 1 / 6 * log(c2 * a3 / c4)^3 * log(a1) + 1 / 4 * log(c3 / c4)^2 * log(c1 / c2)^2 - 1 / 4 * log(c3 / c4)^2 * log(a1 / c2)^2 + 0.5 * log(c3 / c4)^2 * log(a2) * log(c1) - 0.5 * log(c3 / c4)^2 * log(a2) * log(a1) + 1 / 6 * log(a1 * a2 / c3)^3 * log(a4) - 1 / 6 * log(c1 * a2 / c3)^3 * log(a4) + 0.5 * log(c2 / c3)^2 * log(a4) * log(c1) - 0.5 * log(c2 / c3)^2 * log(a4) * log(a1) + 0.5 * log(a1 / c2)^2 * log(a3) * log(a4) - 0.5 * log(c1 / c2)^2 * log(a3) * log(a4) + log(a4) * log(a3) * log(a2) * log(a1) - log(c1) * log(a2) * log(a3) * log(a4))) } ## general case for K = 5 else { eps <- 1e-05 if (.isEqual(t2, 1)) t2 <- t2 + eps if (.isEqual(t3, 1)) t3 <- t3 + eps if (.isEqual(t4, 1)) t4 <- t4 + eps if (.isEqual(t5, 1)) t5 <- t5 + eps if (.isEqual(t2, t3)) t3 <- t2 + eps if (.isEqual(t2, t4)) t4 <- t2 + eps if (.isEqual(t2, t5)) t5 <- t2 + eps if (.isEqual(t3, t4)) t4 <- t3 + eps if (.isEqual(t3, t5)) t5 <- t3 + eps if (.isEqual(t4, t5)) t5 <- t4 + eps return(piValue + c5^(1 / t5) * t5 / (t5 - t4) * ( t5 / (t5 - t3) * t5 / (t5 - t2) * t5 / (t5 - 1) * a4^(1 - t4 / t5) * a3^(1 - t3 / t5) * a2^(1 - t2 / t5) * (a1^(1 - 1 / t5) - c1^(1 - 1 / t5)) - t5 / (t5 - t3) * t5 / (t5 - t2) * t2 / (t2 - 1) * a4^(1 - t4 / t5) * a3^(1 - t3 / t5) * c2^(1 / t2 - 1 / t5) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)) - t5 / (t5 - t3) * t3 / (t3 - t2) * t3 / (t3 - 1) * a4^(1 - t4 / t5) * c3^(1 / t3 - 1 / t5) * a2^(1 - t2 / t3) * (a1^(1 - 1 / t3) - c1^(1 - 1 / t3)) + t5 / (t5 - t3) * t3 / (t3 - t2) * t2 / (t2 - 1) * a4^(1 - t4 / t5) * c3^(1 / t3 - 1 / t5) * c2^(1 / t2 - 1 / t3) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)) - t4 / (t4 - t3) * t4 / (t4 - t2) * t4 / (t4 - 1) * c4^(1 / t4 - 1 / t5) * a3^(1 - t3 / t4) * a2^(1 - t2 / t4) * (a1^(1 - 1 / t4) - c1^(1 - 1 / t4)) + t4 / (t4 - t3) * t4 / (t4 - t2) * t2 / (t2 - 1) * c4^(1 / t4 - 1 / t5) * a3^(1 - t3 / t4) * c2^(1 / t2 - 1 / t4) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)) + t4 / (t4 - t3) * t3 / (t3 - t2) * t3 / (t3 - 1) * c4^(1 / t4 - 1 / t5) * c3^(1 / t3 - 1 / t4) * a2^(1 - t2 / t3) * (a1^(1 - 1 / t3) - c1^(1 - 1 / t3)) - t4 / (t4 - t3) * t3 / (t3 - t2) * t2 / (t2 - 1) * c4^(1 / t4 - 1 / t5) * c3^(1 / t3 - 1 / t4) * c2^(1 / t2 - 1 / t3) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)))) } } .getFisherCombinationCaseKmax6 <- function(tVec) { t2 <- tVec[1] t3 <- tVec[2] t4 <- tVec[3] t5 <- tVec[4] t6 <- tVec[5] return(ifelse( .isEqual(t2, 1) && .isEqual(t3, 1) && .isEqual(t4, 1) && .isEqual(t5, 1) && .isEqual(t6, 1), 1L, 2L )) } .getFisherCombinationSizeApproximatelyKmax6 <- function(alpha0Vec, criticalValues, tVec, piValue, case = .getFisherCombinationCaseKmax6(tVec)) { a1 <- alpha0Vec[1] a2 <- alpha0Vec[2] a3 <- alpha0Vec[3] a4 <- alpha0Vec[4] a5 <- alpha0Vec[5] c1 <- criticalValues[1] c2 <- criticalValues[2] c3 <- criticalValues[3] c4 <- criticalValues[4] c5 <- criticalValues[5] c6 <- criticalValues[6] t2 <- tVec[1] t3 <- tVec[2] t4 <- tVec[3] t5 <- tVec[4] t6 <- tVec[5] .assertIsValidForLogarithmization(list(a1 = a1, a2 = a2, a3 = a3, a4 = a4, a5 = a5, c1 = c1, c2 = c2, c3 = c3, c4 = c4, c5 = c5)) ## Wassmer 1999, recursive formula if (case == 1) { return(piValue + c6 * ( log(a1) * log(a2) * log(a3) * log(a4) * log(a5) + 1 / 24 * log(a1 * a2 * a3 / c4)^4 * log(a5) + 1 / 120 * log(a1 * a2 * a3 * a4 / c5)^5 - 0.5 * log(c4 / c5)^2 * log(a3) * log(a2) * log(a1) + 1 / 6 * log(a1 * a2 / c3)^3 * log(a4) * log(a5) - 0.5 * log(c3 / c4)^2 * log(a5) * log(a2) * log(a1) - 1 / 6 * log(c3 * a4 / c5)^3 * log(a2) * log(a1) - 1 / 12 * log(a1 * a2 / c3)^3 * log(c4 / c5)^2 + 0.5 * log(a1 / c2)^2 * log(a3) * log(a4) * log(a5) - 1 / 6 * log(c2 * a3 / c4)^3 * log(a5) * log(a1) - 1 / 24 * log(c2 * a3 * a4 / c5)^4 * log(a1) - 1 / 4 * log(c4 / c5)^2 * log(a3) * log(a1 / c2)^2 - 0.5 * log(c2 / c3)^2 * log(a4) * log(a5) * log(a1) - 1 / 4 * log(c3 / c4)^2 * log(a5) * log(a1 / c2)^2 - 1 / 12 * log(c3 * a4 / c5)^3 * log(a1 / c2)^2 + 1 / 4 * log(c2 / c3)^2 * log(c4 / c5)^2 * log(a1) - log(c1) * log(a2) * log(a3) * log(a4) * log(a5) - 1 / 24 * log(c1 * a2 * a3 / c4)^4 * log(a5) - 1 / 120 * log(c1 * a2 * a3 * a4 / c5)^5 + 0.5 * log(c4 / c5)^2 * log(a3) * log(a2) * log(c1) - 1 / 6 * log(c1 * a2 / c3)^3 * log(a4) * log(a5) + 0.5 * log(c3 / c4)^2 * log(a5) * log(a2) * log(c1) + 1 / 6 * log(c3 * a4 / c5)^3 * log(a2) * log(c1) + 1 / 12 * log(c1 * a2 / c3)^3 * log(c4 / c5)^2 - 0.5 * log(c1 / c2)^2 * log(a3) * log(a4) * log(a5) + 1 / 6 * log(c2 * a3 / c4)^3 * log(a5) * log(c1) + 1 / 24 * log(c2 * a3 * a4 / c5)^4 * log(c1) + 1 / 4 * log(c4 / c5)^2 * log(a3) * log(c1 / c2)^2 + 0.5 * log(c2 / c3)^2 * log(a4) * log(a5) * log(c1) + 1 / 4 * log(c3 / c4)^2 * log(a5) * log(c1 / c2)^2 + 1 / 12 * log(c3 * a4 / c5)^3 * log(c1 / c2)^2 - 1 / 4 * log(c2 / c3)^2 * log(c4 / c5)^2 * log(c1))) } ## general case for K = 6 else { eps <- 1e-04 if (.isEqual(t2, 1)) t2 <- t2 + eps if (.isEqual(t3, 1)) t3 <- t3 + eps if (.isEqual(t4, 1)) t4 <- t4 + eps if (.isEqual(t5, 1)) t5 <- t5 + eps if (.isEqual(t6, 1)) t6 <- t6 + eps if (.isEqual(t2, t3)) t3 <- t2 + eps if (.isEqual(t2, t4)) t4 <- t2 + eps if (.isEqual(t2, t5)) t5 <- t2 + eps if (.isEqual(t2, t6)) t6 <- t2 + eps if (.isEqual(t3, t4)) t4 <- t3 + eps if (.isEqual(t3, t5)) t5 <- t3 + eps if (.isEqual(t3, t6)) t6 <- t3 + eps if (.isEqual(t4, t5)) t5 <- t4 + eps if (.isEqual(t4, t6)) t6 <- t4 + eps if (.isEqual(t5, t6)) t6 <- t5 + eps return(piValue + c6^(1 / t6) * t6 / (t6 - t5) * ( t6 / (t6 - t4) * t6 / (t6 - t3) * t6 / (t6 - t2) * t6 / (t6 - 1) * a5^(1 - t5 / t6) * a4^(1 - t4 / t6) * a3^(1 - t3 / t6) * a2^(1 - t2 / t6) * (a1^(1 - 1 / t6) - c1^(1 - 1 / t6)) - t6 / (t6 - t4) * t6 / (t6 - t3) * t6 / (t6 - t2) * t2 / (t2 - 1) * a5^(1 - t5 / t6) * a4^(1 - t4 / t6) * a3^(1 - t3 / t6) * c2^(1 / t2 - 1 / t6) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)) - t6 / (t6 - t4) * t6 / (t6 - t3) * t3 / (t3 - t2) * t3 / (t3 - 1) * a5^(1 - t5 / t6) * a4^(1 - t4 / t6) * c3^(1 / t3 - 1 / t6) * a2^(1 - t2 / t3) * (a1^(1 - 1 / t3) - c1^(1 - 1 / t3)) + t6 / (t6 - t4) * t6 / (t6 - t3) * t3 / (t3 - t2) * t2 / (t2 - 1) * a5^(1 - t5 / t6) * a4^(1 - t4 / t6) * c3^(1 / t3 - 1 / t6) * c2^(1 / t2 - 1 / t3) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)) - t6 / (t6 - t4) * t4 / (t4 - t3) * t4 / (t4 - t2) * t4 / (t4 - 1) * a5^(1 - t5 / t6) * c4^(1 / t4 - 1 / t6) * a3^(1 - t3 / t4) * a2^(1 - t2 / t4) * (a1^(1 - 1 / t4) - c1^(1 - 1 / t4)) + t6 / (t6 - t4) * t4 / (t4 - t3) * t4 / (t4 - t2) * t2 / (t2 - 1) * a5^(1 - t5 / t6) * c4^(1 / t4 - 1 / t6) * a3^(1 - t3 / t4) * c2^(1 / t2 - 1 / t4) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)) + t6 / (t6 - t4) * t4 / (t4 - t3) * t3 / (t3 - t2) * t3 / (t3 - 1) * a5^(1 - t5 / t6) * c4^(1 / t4 - 1 / t6) * c3^(1 / t3 - 1 / t4) * a2^(1 - t2 / t3) * (a1^(1 - 1 / t3) - c1^(1 - 1 / t3)) - t6 / (t6 - t4) * t4 / (t4 - t3) * t3 / (t3 - t2) * t2 / (t2 - 1) * a5^(1 - t5 / t6) * c4^(1 / t4 - 1 / t6) * c3^(1 / t3 - 1 / t4) * c2^(1 / t2 - 1 / t3) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)) - t5 / (t5 - t4) * t5 / (t5 - t3) * t5 / (t5 - t2) * t5 / (t5 - 1) * c5^(1 / t5 - 1 / t6) * a4^(1 - t4 / t5) * a3^(1 - t3 / t5) * a2^(1 - t2 / t5) * (a1^(1 - 1 / t5) - c1^(1 - 1 / t5)) + t5 / (t5 - t4) * t5 / (t5 - t3) * t5 / (t5 - t2) * t2 / (t2 - 1) * c5^(1 / t5 - 1 / t6) * a4^(1 - t4 / t5) * a3^(1 - t3 / t5) * c2^(1 / t2 - 1 / t5) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)) + t5 / (t5 - t4) * t5 / (t5 - t3) * t3 / (t3 - t2) * t3 / (t3 - 1) * c5^(1 / t5 - 1 / t6) * a4^(1 - t4 / t5) * c3^(1 / t3 - 1 / t5) * a2^(1 - t2 / t3) * (a1^(1 - 1 / t3) - c1^(1 - 1 / t3)) - t5 / (t5 - t4) * t5 / (t5 - t3) * t3 / (t3 - t2) * t2 / (t2 - 1) * c5^(1 / t5 - 1 / t6) * a4^(1 - t4 / t5) * c3^(1 / t3 - 1 / t5) * c2^(1 / t2 - 1 / t3) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)) + t5 / (t5 - t4) * t4 / (t4 - t3) * t4 / (t4 - t2) * t4 / (t4 - 1) * c5^(1 / t5 - 1 / t6) * c4^(1 / t4 - 1 / t5) * a3^(1 - t3 / t4) * a2^(1 - t2 / t4) * (a1^(1 - 1 / t4) - c1^(1 - 1 / t4)) - t5 / (t5 - t4) * t4 / (t4 - t3) * t4 / (t4 - t2) * t2 / (t2 - 1) * c5^(1 / t5 - 1 / t6) * c4^(1 / t4 - 1 / t5) * a3^(1 - t3 / t4) * c2^(1 / t2 - 1 / t4) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)) - t5 / (t5 - t4) * t4 / (t4 - t3) * t3 / (t3 - t2) * t3 / (t3 - 1) * c5^(1 / t5 - 1 / t6) * c4^(1 / t4 - 1 / t5) * c3^(1 / t3 - 1 / t4) * a2^(1 - t2 / t3) * (a1^(1 - 1 / t3) - c1^(1 - 1 / t3)) + t5 / (t5 - t4) * t4 / (t4 - t3) * t3 / (t3 - t2) * t2 / (t2 - 1) * c5^(1 / t5 - 1 / t6) * c4^(1 / t4 - 1 / t5) * c3^(1 / t3 - 1 / t4) * c2^(1 / t2 - 1 / t3) * (a1^(1 - 1 / t2) - c1^(1 - 1 / t2)))) } } .getFisherCombinationSize <- function(kMax, alpha0Vec, criticalValues, tVec, cases = .getFisherCombinationCases(kMax = kMax, tVec = tVec)) { if (length(criticalValues) < 1 || length(criticalValues) > C_KMAX_UPPER_BOUND_FISHER) { stop( C_EXCEPTION_TYPE_ARGUMENT_LENGTH_OUT_OF_BOUNDS, "length of 'criticalValues' (", length(criticalValues), ") is out of bounds [1; ", C_KMAX_UPPER_BOUND_FISHER, "]" ) } piValue <- criticalValues[1] if (kMax > 1) { piValue <- .getFisherCombinationSizeKmax2(alpha0Vec, criticalValues, tVec, piValue, case = cases[1] ) } if (kMax > 2) { piValue <- .getFisherCombinationSizeKmax3(alpha0Vec, criticalValues, tVec, piValue, case = cases[2] ) } if (kMax > 3) { piValue <- .getFisherCombinationSizeApproximatelyKmax4(alpha0Vec, criticalValues, tVec, piValue, case = cases[3] ) } if (kMax > 4) { piValue <- .getFisherCombinationSizeApproximatelyKmax5(alpha0Vec, criticalValues, tVec, piValue, case = cases[4] ) } if (kMax > 5) { piValue <- .getFisherCombinationSizeApproximatelyKmax6(alpha0Vec, criticalValues, tVec, piValue, case = cases[5] ) } return(piValue) } .getRejectValueForOneTrial <- function(kMax, alpha0, criticalValues, weightsFisher, stage, pValues) { if (stage < kMax && pValues[stage] >= alpha0[stage]) { return(0) } p <- prod(pValues[1:stage]^weightsFisher[1:stage]) if (p < criticalValues[stage]) { return(1) } return(-1) } .getRejectValueRejectionProbability <- function(settings) { pValues <- stats::runif(settings$kMax) for (stage in 1:settings$kMax) { rejectValue <- .getRejectValueForOneTrial( settings$kMax, settings$alpha0, settings$criticalValues, settings$weightsFisher, stage, pValues ) if (rejectValue >= 0) { return(rejectValue) } } return(0) } .getSimulatedAlpha <- function(kMax, alpha, alpha0, criticalValues, tVec, iterations, seed) { weightsFisher <- c(1, tVec) settings <- list( kMax = kMax, alpha = alpha, alpha0 = alpha0, criticalValues = criticalValues, weightsFisher = weightsFisher, iterations = iterations, seed = seed ) cases <- rep(list(settings), iterations) # 'mclapply' requires package 'parallel' # Improvement: implement as cluster based routine if (requireNamespace("parallel", quietly = TRUE)) { simResults <- parallel::mclapply(cases, .getRejectValueRejectionProbability, mc.preschedule = TRUE) } else { simResults <- base::lapply(cases, .getRejectValueRejectionProbability) } settings$alphaSimulated <- do.call(sum, simResults) / iterations return(settings) } .setKMaxToDesign <- function(design, kMax) { if (.isUndefinedArgument(design$kMax)) { design$kMax <- as.integer(kMax) design$.setParameterType("kMax", C_PARAM_GENERATED) } else { design$.setParameterType("kMax", ifelse(design$kMax == C_KMAX_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) } } #' @title #' Get Design Fisher #' #' @description #' Performs Fisher's combination test and returns critical values for this design. #' #' @inheritParams param_kMax #' @inheritParams param_alpha #' @param method \code{"equalAlpha"}, \code{"fullAlpha"}, \code{"noInteraction"}, or \code{"userDefinedAlpha"}, #' default is \code{"equalAlpha"} (for details, see Wassmer, 1999). #' @inheritParams param_userAlphaSpending #' @param alpha0Vec Stopping for futility bounds for stage-wise p-values. #' @inheritParams param_informationRates #' @inheritParams param_sided #' @param bindingFutility If \code{bindingFutility = TRUE} is specified the calculation of #' the critical values is affected by the futility bounds (default is \code{TRUE}). #' @param tolerance The numerical tolerance, default is \code{1e-14}. #' @param iterations The number of simulation iterations, e.g., #' \code{getDesignFisher(iterations = 100000)} checks the validity of the critical values for the design. #' The default value of \code{iterations} is 0, i.e., no simulation will be executed. #' @param seed Seed for simulating the power for Fisher's combination test. See above, default is a random seed. #' @inheritParams param_three_dots #' #' @details #' \code{getDesignFisher} calculates the critical values and stage levels for #' Fisher's combination test as described in Bauer (1989), Bauer and Koehne (1994), #' Bauer and Roehmel (1995), and Wassmer (1999) for equally and unequally sized stages. #' #' @seealso \code{\link{getDesignSet}} for creating a set of designs to compare. #' #' @template return_object_trial_design #' @template how_to_get_help_for_generics #' #' @family design functions #' #' @template examples_get_design_Fisher #' #' @export #' getDesignFisher <- function(..., kMax = NA_integer_, alpha = NA_real_, method = c("equalAlpha", "fullAlpha", "noInteraction", "userDefinedAlpha"), # C_FISHER_METHOD_DEFAULT userAlphaSpending = NA_real_, alpha0Vec = NA_real_, informationRates = NA_real_, sided = 1, # C_SIDED_DEFAULT bindingFutility = NA, tolerance = 1e-14, # C_ANALYSIS_TOLERANCE_FISHER_DEFAULT iterations = 0L, seed = NA_real_) { .assertIsValidTolerance(tolerance) .assertIsValidIterationsAndSeed(iterations, seed) .warnInCaseOfUnknownArguments(functionName = "getDesignFisher", ignore = c("cppEnabled"), ...) cppEnabled <- .getOptionalArgument("cppEnabled", ..., optionalArgumentDefaultValue = FALSE) return(.getDesignFisher( kMax = kMax, alpha = alpha, method = method, userAlphaSpending = userAlphaSpending, alpha0Vec = alpha0Vec, informationRates = informationRates, sided = sided, bindingFutility = bindingFutility, tolerance = tolerance, iterations = iterations, seed = seed, userFunctionCallEnabled = TRUE, cppEnabled = cppEnabled )) } .getDesignFisherDefaultValues <- function() { return(list( kMax = NA_integer_, alpha = NA_real_, method = C_FISHER_METHOD_DEFAULT, userAlphaSpending = NA_real_, alpha0Vec = NA_real_, informationRates = NA_real_, sided = 1, bindingFutility = C_BINDING_FUTILITY_FISHER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_FISHER_DEFAULT, iterations = 0, seed = NA_real_ )) } .getFisherCombinationCases <- function(kMax, tVec) { if (kMax == 1) { return(c()) } cases <- c() if (kMax > 1) { cases <- c(cases, .getFisherCombinationCaseKmax2(tVec)) } if (kMax > 2) { cases <- c(cases, .getFisherCombinationCaseKmax3(tVec)) } if (kMax > 3) { cases <- c(cases, .getFisherCombinationCaseKmax4(tVec)) } if (kMax > 4) { cases <- c(cases, .getFisherCombinationCaseKmax5(tVec)) } if (kMax > 5) { cases <- c(cases, .getFisherCombinationCaseKmax6(tVec)) } return(cases) } # # @param userFunctionCallEnabled if \code{TRUE}, additional parameter validation methods will be called. # .getDesignFisher <- function(kMax = NA_integer_, alpha = NA_real_, method = C_FISHER_METHOD_DEFAULT, userAlphaSpending = NA_real_, alpha0Vec = NA_real_, informationRates = NA_real_, sided = 1, bindingFutility = C_BINDING_FUTILITY_FISHER_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_FISHER_DEFAULT, iterations = 0L, seed = NA_real_, userFunctionCallEnabled = FALSE, cppEnabled = FALSE) { method <- .matchArgument(method, C_FISHER_METHOD_DEFAULT) .assertIsNumericVector(alpha0Vec, "alpha0Vec", naAllowed = TRUE) if (.isDefinedArgument(kMax, argumentExistsValidationEnabled = userFunctionCallEnabled)) { .assertIsValidKMax(kMax, kMaxUpperBound = C_KMAX_UPPER_BOUND_FISHER) if (!is.integer(kMax)) { kMax <- as.integer(kMax) } } if (!is.integer(sided) && sided %in% c(1, 2)) { sided <- as.integer(sided) } if (sided != 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "Fisher's combination test only available for one-sided testing") } if (is.na(bindingFutility)) { bindingFutility <- C_BINDING_FUTILITY_FISHER_DEFAULT } else if (userFunctionCallEnabled && ((!is.na(kMax) && kMax == 1) || (!any(is.na(alpha0Vec)) && all(alpha0Vec == C_ALPHA_0_VEC_DEFAULT)))) { warning("'bindingFutility' (", bindingFutility, ") will be ignored", call. = FALSE) } design <- TrialDesignFisher( kMax = kMax, alpha = alpha, method = method, sided = sided, userAlphaSpending = userAlphaSpending, alpha0Vec = alpha0Vec, informationRates = informationRates, bindingFutility = bindingFutility, tolerance = tolerance, iterations = as.integer(iterations), seed = seed ) .assertDesignParameterExists(design, "sided", C_SIDED_DEFAULT) .assertIsValidSidedParameter(design$sided) .assertDesignParameterExists(design, "method", C_FISHER_METHOD_DEFAULT) .assertIsSingleCharacter(design$method, "method") if (!.isFisherMethod(design$method)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'method' must be one of the following: ", .printFisherMethods() ) } .assertDesignParameterExists(design, "bindingFutility", C_BINDING_FUTILITY_FISHER_DEFAULT) .assertDesignParameterExists(design, "tolerance", C_ANALYSIS_TOLERANCE_FISHER_DEFAULT) .setKmaxBasedOnAlphaSpendingDefintion(design) design$informationRates <- .getValidatedInformationRates(design) design$alpha0Vec <- .getValidatedAlpha0Vec(design) if (design$sided == 2 && design$bindingFutility && any(design$alpha0Vec < 1)) { warning("Binding futility will be ignored because the test is defined as two-sided", call. = FALSE) } if (design$method == C_FISHER_METHOD_USER_DEFINED_ALPHA) { .validateUserAlphaSpending(design) } else { design$.setParameterType("userAlphaSpending", C_PARAM_NOT_APPLICABLE) if (.isDefinedArgument(design$userAlphaSpending)) { warning("'userAlphaSpending' will be ignored because 'method' is not '", C_FISHER_METHOD_USER_DEFINED_ALPHA, "'", call. = FALSE ) } } if (.isUndefinedArgument(design$alpha)) { design$alpha <- C_ALPHA_DEFAULT } .assertDesignParameterExists(design, "alpha", C_ALPHA_DEFAULT) .assertIsSingleNumber(design$alpha, "alpha") .assertIsValidSidedParameter(sided) if (sided != 1) { design$alpha <- design$alpha / sided } if (userFunctionCallEnabled) { .assertIsValidAlpha(design$alpha) } .assertDesignParameterExists(design, "kMax", 3) .assertIsSingleInteger(design$kMax, "kMax") .assertIsValidKMax(design$kMax, kMaxUpperBound = C_KMAX_UPPER_BOUND_FISHER) if (design$method == C_FISHER_METHOD_NO_INTERACTION && design$kMax < 3) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "method '", C_FISHER_METHOD_NO_INTERACTION, "' is only allowed for kMax > 2 (kMax is ", design$kMax, ")" ) } if (design$kMax > 1) { design$scale <- round(sqrt((design$informationRates[2:design$kMax] - design$informationRates[1:(design$kMax - 1)]) / design$informationRates[1]), 10) } design$criticalValues <- rep(NA_real_, design$kMax) design$.setParameterType("scale", C_PARAM_GENERATED) design$.setParameterType("criticalValues", C_PARAM_GENERATED) if (design$bindingFutility) { alpha0Vec <- design$alpha0Vec } else { alpha0Vec <- rep(1, design$kMax - 1) } if (design$method == C_FISHER_METHOD_NO_INTERACTION && !any(is.na(alpha0Vec)) && all(alpha0Vec == C_ALPHA_0_VEC_DEFAULT)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "for specified 'method' (\"", C_FISHER_METHOD_NO_INTERACTION, "\") the 'alpha0Vec' must be unequal to ", .arrayToString(alpha0Vec, vectorLookAndFeelEnabled = TRUE) ) } design$.setParameterType("stageLevels", C_PARAM_GENERATED) design$.setParameterType("alphaSpent", C_PARAM_GENERATED) design$.setParameterType("nonStochasticCurtailment", C_PARAM_GENERATED) tryCatch({ cases <- .getFisherCombinationCases(kMax = design$kMax, tVec = design$scale) if (cppEnabled) { stop("The C++ version of Fisher's design is not supported in this rpact version") # result <- getDesignFisherTryCpp(design$kMax, design$alpha, design$tolerance, # design$criticalValues, design$scale, alpha0Vec, design$userAlphaSpending, design$method) # design$criticalValues <- result$criticalValues # design$alphaSpent <- result$alphaSpent # design$stageLevels <- result$stageLevels # design$nonStochasticCurtailment <- result$nonStochasticCurtailment } else { if (design$method == C_FISHER_METHOD_USER_DEFINED_ALPHA) { design$criticalValues[1] <- design$userAlphaSpending[1] design$alphaSpent <- design$criticalValues if (design$kMax > 1) { for (k in 2:design$kMax) { cLower <- 0 cUpper <- design$alpha prec <- 1 while (prec > design$tolerance) { alpha1 <- (cLower + cUpper) * 0.5 design$criticalValues[k] <- alpha1 size <- .getFisherCombinationSize(k, alpha0Vec[1:(k - 1)], design$criticalValues, design$scale, cases = cases ) ifelse(size < design$userAlphaSpending[k], cLower <- alpha1, cUpper <- alpha1) prec <- cUpper - cLower } } } } else { prec <- 1 cLower <- 0 cUpper <- design$alpha maxIter <- 100 while (prec > design$tolerance && maxIter >= 0) { # no use of uniroot because there might be no positive solution # (f(cl) and f(cu) might not have opposite signs) alpha1 <- (cLower + cUpper) * 0.5 if (design$method == C_FISHER_METHOD_EQUAL_ALPHA) { design$criticalValues <- sapply( 1:design$kMax, function(k) { .getOneDimensionalRoot( function(c) { .getFisherCombinationSize(k, rep(1, k - 1), rep(c, k), design$scale, cases = cases ) - alpha1 }, lower = design$tolerance, upper = design$alpha, tolerance = design$tolerance, callingFunctionInformation = ".getDesignFisher" ) } ) } else if (design$method == C_FISHER_METHOD_FULL_ALPHA) { design$criticalValues[1:(design$kMax - 1)] <- sapply(1:(design$kMax - 1), function(k) { prec2 <- 1 cLower2 <- 0 cUpper2 <- design$alpha while (prec2 > design$tolerance) { c <- (cLower2 + cUpper2) * 0.5 y <- .getFisherCombinationSize(k, rep(1, k - 1), rep(c, k), design$scale, cases = cases ) ifelse(y < alpha1, cLower2 <- c, cUpper2 <- c) prec2 <- cUpper2 - cLower2 } return(c) }) design$criticalValues[design$kMax] <- .getOneDimensionalRoot( function(c) { .getFisherCombinationSize(design$kMax, rep(1, design$kMax - 1), rep(c, design$kMax), design$scale, cases = cases ) - design$alpha }, lower = design$tolerance, upper = design$alpha, tolerance = design$tolerance, callingFunctionInformation = ".getDesignFisher" ) } else if (design$method == C_FISHER_METHOD_NO_INTERACTION) { design$criticalValues[design$kMax] <- .getOneDimensionalRoot( function(c) { .getFisherCombinationSize(design$kMax, rep(1, design$kMax - 1), rep(c, design$kMax), design$scale, cases = cases ) - design$alpha }, lower = design$tolerance, upper = design$alpha, tolerance = design$tolerance, callingFunctionInformation = ".getDesignFisher" ) design$criticalValues[1] <- alpha1 for (k in (design$kMax - 1):2) { design$criticalValues[k] <- design$criticalValues[k + 1] / design$alpha0Vec[k]^(1 / design$scale[k]) } } size <- .getFisherCombinationSize(design$kMax, alpha0Vec, design$criticalValues, design$scale, cases = cases ) ifelse(size < design$alpha, cLower <- alpha1, cUpper <- alpha1) prec <- cUpper - cLower maxIter <- maxIter - 1 } } } design$stageLevels <- sapply(1:design$kMax, function(k) { .getFisherCombinationSize(k, rep(1, k - 1), rep(design$criticalValues[k], k), design$scale, cases = cases ) }) design$alphaSpent <- sapply(1:design$kMax, function(k) { .getFisherCombinationSize(k, alpha0Vec[1:(k - 1)], design$criticalValues[1:k], design$scale, cases = cases ) }) design$nonStochasticCurtailment <- FALSE if (design$stageLevels[1] < 1e-10) { design$criticalValues[1:(design$kMax - 1)] <- design$criticalValues[design$kMax] design$stageLevels <- sapply( 1:design$kMax, function(k) { .getFisherCombinationSize(k, rep(1, k - 1), rep(design$criticalValues[k], k), design$scale, cases = cases ) } ) design$alphaSpent <- sapply( 1:design$kMax, function(k) { .getFisherCombinationSize(k, alpha0Vec[1:(k - 1)], design$criticalValues[1:k], design$scale, cases = cases ) } ) design$nonStochasticCurtailment <- TRUE } }, error = function(e) { warning("Output may be wrong because an error occured: ", e$message, call. = FALSE) }) if (userFunctionCallEnabled) { if (design$method == C_FISHER_METHOD_NO_INTERACTION && abs(size - design$alpha) > 1e-03) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "numerical overflow in computation routine") } if (design$method == C_FISHER_METHOD_EQUAL_ALPHA && !all(is.na(design$stageLevels)) && abs(mean(na.omit(design$stageLevels)) - design$stageLevels[1]) > 1e-03) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "numerical overflow in computation routine") } if (design$kMax > 1) { if (any(na.omit(design$criticalValues[2:design$kMax] - design$criticalValues[1:(design$kMax - 1)]) > 1e-12)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "no calculation possible") } if (!all(is.na(design$stageLevels)) && any(na.omit(design$stageLevels[1:(design$kMax - 1)]) > design$alpha)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'alpha' (", design$alpha, ") not correctly specified" ) } } if (design$method == C_FISHER_METHOD_USER_DEFINED_ALPHA) { if (any(abs(design$alphaSpent - design$userAlphaSpending) > 1e-05)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'alpha' (", design$alpha, ") or 'userAlphaSpending' (", .arrayToString(design$userAlphaSpending), ") not correctly specified" ) } } } design$.setParameterType("simAlpha", C_PARAM_NOT_APPLICABLE) design$simAlpha <- NA_real_ if (!is.null(design$iterations) && design$iterations > 0) { design$seed <- .setSeed(design$seed) simResult <- .getSimulatedAlpha( kMax = design$kMax, alpha = design$alpha, alpha0 = design$alpha0Vec, criticalValues = design$criticalValues, tVec = design$scale, iterations = iterations, seed = seed ) design$simAlpha <- simResult$alphaSimulated design$.setParameterType("simAlpha", C_PARAM_GENERATED) } if (design$kMax == 1) { design$.setParameterType("alpha0Vec", C_PARAM_NOT_APPLICABLE) } if (length(design$alpha0Vec) == 0 || all(design$alpha0Vec == C_ALPHA_0_VEC_DEFAULT)) { design$.setParameterType("bindingFutility", C_PARAM_NOT_APPLICABLE) } design$.initStages() return(design) } rpact/R/f_core_assertions.R0000644000175000017500000025030314153345060015554 0ustar nileshnilesh## | ## | *Core assertions* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5615 $ ## | Last changed: $Date: 2021-12-06 09:29:15 +0100 (Mo, 06 Dez 2021) $ ## | Last changed by: $Author: wassmer $ ## | .stopWithWrongDesignMessage <- function(design) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of ", .arrayToString( .getTrialDesignClassNames(), vectorLookAndFeelEnabled = FALSE), " (is '", class(design), "')") } .isParameterSet <- function(x) { return(isS4(x) && inherits(x, "ParameterSet")) } .assertIsParameterSetClass <- function(x, objectName = "x") { if (!.isParameterSet(x)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", objectName, "' (", class(x), ") must be a S4 class which inherits from class 'ParameterSet' ") } } .assertIsTrialDesignSet <- function(x, objectName = "x") { if (!.isTrialDesignSet(x)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'designSet' must be an instance of 'TrialDesignSet' (is '", class(x), "')") } } .isTrialDesignSet <- function(x) { return(class(x) == "TrialDesignSet") } .isTrialDesignGroupSequential <- function(design) { return(class(design) == C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL) } .isTrialDesignInverseNormal <- function(design) { return(class(design) == C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL) } .isTrialDesignFisher <- function(design) { return(class(design) == C_CLASS_NAME_TRIAL_DESIGN_FISHER) } .isTrialDesignConditionalDunnett <- function(design) { return(class(design) == C_CLASS_NAME_TRIAL_DESIGN_CONDITIONAL_DUNNETT) } .isTrialDesignInverseNormalOrGroupSequential <- function(design) { return(.isTrialDesignInverseNormal(design) || .isTrialDesignGroupSequential(design)) } .isTrialDesignInverseNormalOrFisher <- function(design) { return(.isTrialDesignInverseNormal(design) || .isTrialDesignFisher(design)) } .isTrialDesign <- function(design) { return(.isTrialDesignInverseNormal(design) || .isTrialDesignGroupSequential(design) || .isTrialDesignFisher(design) || .isTrialDesignConditionalDunnett(design)) } .isTrialDesignPlanMeans <- function(designPlan) { return(class(designPlan) == "TrialDesignPlanMeans") } .isTrialDesignPlanRates <- function(designPlan) { return(class(designPlan) == "TrialDesignPlanRates") } .isTrialDesignPlanSurvival <- function(designPlan) { return(class(designPlan) == "TrialDesignPlanSurvival") } .isTrialDesignPlan <- function(designPlan) { return(.isTrialDesignPlanMeans(designPlan) || .isTrialDesignPlanRates(designPlan) || .isTrialDesignPlanSurvival(designPlan)) } .assertIsTrialDesignPlan <- function(designPlan) { if (!.isTrialDesignPlan(designPlan)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'designPlan' must be an instance of 'TrialDesignPlan' (is '", class(designPlan), "')") } } .assertIsTrialDesign <- function(design) { if (!.isTrialDesign(design)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of ", .arrayToString( .getTrialDesignClassNames(), vectorLookAndFeelEnabled = FALSE), " (is '", class(design), "')") } } .assertIsTrialDesignInverseNormal <- function(design) { if (!.isTrialDesignInverseNormal(design)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of class 'TrialDesignInverseNormal' (is '", class(design), "')") } } .assertIsTrialDesignFisher <- function(design) { if (!.isTrialDesignFisher(design)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of class 'TrialDesignFisher' (is '", class(design), "')") } } .assertIsTrialDesignGroupSequential <- function(design) { if (!.isTrialDesignGroupSequential(design)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of class 'TrialDesignGroupSequential' (is '", class(design), "')") } } .assertIsTrialDesignConditionalDunnett <- function(design) { if (!.isTrialDesignConditionalDunnett(design)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of class 'TrialDesignConditionalDunnett' (is '", class(design), "')") } } .assertIsTrialDesignInverseNormalOrGroupSequential <- function(design) { if (!.isTrialDesignInverseNormalOrGroupSequential(design)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of class 'TrialDesignInverseNormal' or 'TrialDesignGroupSequential' (is '", class(design), "')") } } .assertIsTrialDesignInverseNormalOrFisher <- function(design) { if (!.isTrialDesignInverseNormalOrFisher(design)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of class 'TrialDesignInverseNormal' or 'TrialDesignFisher' (is '", class(design), "')") } } .assertIsTrialDesignInverseNormalOrFisherOrConditionalDunnett <- function(design) { if (!.isTrialDesignInverseNormalOrFisher(design) && !.isTrialDesignConditionalDunnett(design)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of class 'TrialDesignInverseNormal', ", "'TrialDesignFisher', or 'TrialDesignConditionalDunnett' (is '", class(design), "')") } } .assertIsTrialDesignInverseNormalOrGroupSequentialOrFisher <- function(design) { if (!.isTrialDesignInverseNormalOrGroupSequential(design) && !.isTrialDesignFisher(design)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of class 'TrialDesignInverseNormal', 'TrialDesignGroupSequential', ", "or 'TrialDesignFisher' (is '", class(design), "')") } } .isSimulationResults <- function(simulationResults) { return(inherits(simulationResults, "SimulationResults")) } .assertIsSimulationResults <- function(simulationResults) { if (!.isSimulationResults(simulationResults)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'simulationResults' must be an instance of SimulationResults (is '", class(simulationResults), "')") } } .isStageResults <- function(stageResults) { return(inherits(stageResults, "StageResults")) } .isStageResultsMultiArmMeans <- function(stageResults) { return(class(stageResults) == "StageResultsMultiArmMeans") } .isStageResultsMultiArmRates <- function(stageResults) { return(class(stageResults) == "StageResultsMultiArmRates") } .isStageResultsMultiArmSurvival <- function(stageResults) { return(class(stageResults) == "StageResultsMultiArmSurvival") } .isStageResultsEnrichmentMeans <- function(stageResults) { return(class(stageResults) == "StageResultsEnrichmentMeans") } .isStageResultsEnrichmentRates <- function(stageResults) { return(class(stageResults) == "StageResultsEnrichmentRates") } .isStageResultsEnrichmentSurvival <- function(stageResults) { return(class(stageResults) == "StageResultsEnrichmentSurvival") } .assertIsStageResults <- function(stageResults) { if (!.isStageResults(stageResults)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be a 'StageResults' object", " (is '", class(stageResults), "')") } } .assertIsInClosedInterval <- function(x, xName, ..., lower, upper, naAllowed = FALSE) { .warnInCaseOfUnknownArguments(functionName = ".assertIsInClosedInterval", ...) if (naAllowed && all(is.na(x))) { return(invisible()) } if (!naAllowed && length(x) > 1 && any(is.na(x))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", xName, "' (", .arrayToString(x), ") must be a valid numeric vector or a single NA") } if (is.null(upper) || is.na(upper)) { if (any(x < lower, na.rm = TRUE)) { prefix <- ifelse(length(x) > 1, "each value of ", "") stop(C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, prefix, "'", xName, "' (", .arrayToString(x), ") must be >= ", lower) } } else if (any(x < lower, na.rm = TRUE) || any(x > upper, na.rm = TRUE)) { stop(C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'", xName, "' (", .arrayToString(x), ") is out of bounds [", lower, "; ", upper, "]") } } .assertIsInOpenInterval <- function(x, xName, lower, upper, naAllowed = FALSE) { if (naAllowed && all(is.na(x))) { return(invisible()) } if (!naAllowed && length(x) > 1 && any(is.na(x))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", xName, "' (", .arrayToString(x), ") must be a valid numeric vector or a single NA") } if (is.null(upper) || is.na(upper)) { if (any(x <= lower, na.rm = TRUE)) { prefix <- ifelse(length(x) > 1, "each value of ", "") stop(C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, prefix, "'", xName, "' (", .arrayToString(x), ") must be > ", lower) } } else if (any(x <= lower, na.rm = TRUE) || any(x >= upper, na.rm = TRUE)) { stop(C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'", xName, "' (", .arrayToString(x), ") is out of bounds (", lower, "; ", upper, ")") } } .assertIsValidDataInput <- function(dataInput, design = NULL, stage = NULL) { .assertIsDataset(dataInput) if (!is.null(design)) { .assertIsTrialDesign(design) } stages <- dataInput$stages l1 <- length(stages) for (fieldName in dataInput$.getVisibleFieldNames()) { l2 <- length(dataInput[[fieldName]]) if (fieldName != "stages" && l1 != l2) { stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all parameters must have the same length ('stage' has length ", l1, ", '", fieldName, "' has length ", l2, ")") } } if (!is.null(stage)) { if (dataInput$getNumberOfGroups() == 1) { if (.isDatasetMeans(dataInput) ) { if (any(na.omit(dataInput$getStDevsUpTo(stage)) <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all standard deviations must be > 0") } if (any(na.omit(dataInput$getSampleSizesUpTo(stage)) <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all sample sizes must be > 0") } } else if (.isDatasetRates(dataInput) ) { if (any(na.omit(dataInput$getEventsUpTo(stage)) < 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all events must be >= 0") } if (any(na.omit(dataInput$getSampleSizesUpTo(stage)) <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all sample sizes must be > 0") } if (any(na.omit(dataInput$getEventsUpTo(stage)) > na.omit(dataInput$getSampleSizesUpTo(stage)))) { stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all events must be <= corresponding sample size") } } } else if (dataInput$getNumberOfGroups() == 2) { if (.isDatasetMeans(dataInput) ) { if (any(na.omit(dataInput$getStDevsUpTo(stage, 1)) <= 0) || any(na.omit(dataInput$getStDevsUpTo(stage, 2)) <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all standard deviations must be > 0") } if (any(na.omit(dataInput$getSampleSizesUpTo(stage, 1)) <= 0) || any(na.omit(dataInput$getSampleSizesUpTo(stage, 2)) <= 0) ) { stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all sample sizes must be > 0") } } else if (.isDatasetRates(dataInput) ) { if (any(na.omit(dataInput$getEventsUpTo(stage, 1)) < 0) || any(na.omit(dataInput$getEventsUpTo(stage, 2)) < 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all events must be >= 0") } if (any(na.omit(dataInput$getSampleSizesUpTo(stage, 1)) <= 0) || any(na.omit(dataInput$getSampleSizesUpTo(stage, 2)) <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all sample sizes must be > 0") } if (any(na.omit(dataInput$getEventsUpTo(stage, 1)) > na.omit(dataInput$getSampleSizesUpTo(stage, 1))) || any(na.omit(dataInput$getEventsUpTo(stage, 2)) > na.omit(dataInput$getSampleSizesUpTo(stage, 2)))) { stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all events must be <= corresponding sample size") } } } if (.isDatasetSurvival(dataInput) ) { if (any(na.omit(dataInput$getOverallEventsUpTo(stage)) < 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all cumulative events must be >= 0") } if (any(na.omit(dataInput$getOverallAllocationRatiosUpTo(stage)) <= 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_DATA_INPUT, "all cumulative allocation ratios must be > 0") } } } if (!is.null(design)) { numberOfStages <- length(unique(stats::na.omit(stages))) kMax <- design$kMax if (numberOfStages > kMax) { s <- numberOfStages - kMax plural <- ifelse(s == 1, "", "s") warning(sprintf(paste0("The data of the last %s in the dataset will be ", "ignored because the design has specified kMax = %s"), ifelse(s == 1, "stage", paste0(s, " stages")), kMax), call. = FALSE) } else if (numberOfStages < kMax) { dataInput$.fillWithNAs(kMax) } } invisible(dataInput) } .assertIsDataset <- function(dataInput) { if (!.isDataset(dataInput)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' must be an instance of class ", "'DatasetMeans', 'DatasetRates' or 'DatasetSurvival' (is '", class(dataInput), "')") } } .assertIsDatasetMeans <- function(dataInput) { if (!.isDatasetMeans(dataInput = dataInput)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' must be an instance of class ", "'DatasetMeans' (is '", class(dataInput), "')") } } .assertIsDatasetRates <- function(dataInput) { if (!.isDatasetRates(dataInput = dataInput)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' must be an instance of class ", "'DatasetRates' (is '", class(dataInput), "')") } } .assertIsDatasetSurvival <- function(dataInput) { if (!.isDatasetSurvival(dataInput = dataInput)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' must be an instance of class ", "'DatasetSurvival' (is '", class(dataInput), "')") } } .isDataset <- function(dataInput) { return(.isDatasetMeans(dataInput) || .isDatasetRates(dataInput) || .isDatasetSurvival(dataInput)) } .isDatasetMeans <- function(dataInput) { return(inherits(dataInput, "DatasetMeans")) } .isDatasetRates <- function(dataInput) { return(inherits(dataInput, "DatasetRates")) } .isDatasetSurvival <- function(dataInput) { return(inherits(dataInput, "DatasetSurvival")) } .assertIsNumericVector <- function(x, argumentName, naAllowed = FALSE, noDefaultAvailable = FALSE) { if (missing(x) || is.null(x) || length(x) == 0) { .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = FALSE) stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' must be a valid numeric value or vector") } .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = TRUE) if ((!naAllowed && any(is.na(x))) || !is.numeric(x)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", .arrayToString(x), ") must be a valid numeric value or vector") } } .assertIsIntegerVector <- function(x, argumentName, naAllowed = FALSE, validateType = TRUE, noDefaultAvailable = FALSE) { if (missing(x) || is.null(x) || length(x) == 0) { .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = FALSE) stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' must be a valid integer value or vector") } .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = TRUE) if (naAllowed && all(is.na(x))) { return(invisible()) } if (!is.numeric(x) || (!naAllowed && any(is.na(x))) || (validateType && !is.integer(x)) || (!validateType && any(as.integer(na.omit(x)) != na.omit(x)))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", .arrayToString(x), ") must be a valid integer value or vector") } } .assertIsLogicalVector <- function(x, argumentName, naAllowed = FALSE, noDefaultAvailable = FALSE) { if (missing(x) || is.null(x) || length(x) == 0) { .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = FALSE) stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' must be a valid logical value or vector") } .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = TRUE) if ((!naAllowed && all(is.na(x))) || !is.logical(x)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", x, ") must be a valid logical value or vector") } } .assertIsNoDefault <- function(x, argumentName, noDefaultAvailable, checkNA = FALSE) { if (noDefaultAvailable && (!checkNA || all(is.na(x)))) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' must be specified, there is no default value") } } .assertIsSingleLogical <- function(x, argumentName, naAllowed = FALSE, noDefaultAvailable = FALSE) { if (missing(x) || is.null(x) || length(x) == 0) { .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = FALSE) stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' must be a single logical value") } .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = TRUE) if (length(x) > 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' ", .arrayToString(x, vectorLookAndFeelEnabled = TRUE), " must be a single logical value") } if ((!naAllowed && is.na(x)) || !is.logical(x)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", ifelse(isS4(x), class(x), x), ") must be a single logical value") } } .assertIsSingleNumber <- function(x, argumentName, naAllowed = FALSE, noDefaultAvailable = FALSE) { if (missing(x) || is.null(x) || length(x) == 0) { .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = FALSE) stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' must be a valid numeric value") } .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = TRUE) if (length(x) > 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' ", .arrayToString(x, vectorLookAndFeelEnabled = TRUE), " must be a single numeric value") } if ((!naAllowed && is.na(x)) || !is.numeric(x)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", ifelse(isS4(x), class(x), x), ") must be a valid numeric value") } } .assertIsSingleInteger <- function(x, argumentName, naAllowed = FALSE, validateType = TRUE, noDefaultAvailable = FALSE) { .assertIsSinglePositiveInteger(x = x, argumentName = argumentName, naAllowed = naAllowed, validateType = validateType, mustBePositive = FALSE, noDefaultAvailable = noDefaultAvailable) } .assertIsSinglePositiveInteger <- function(x, argumentName, ..., naAllowed = FALSE, validateType = TRUE, mustBePositive = TRUE, noDefaultAvailable = FALSE) { prefix <- ifelse(mustBePositive, "single positive ", "single ") if (missing(x) || is.null(x) || length(x) == 0) { .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = FALSE) stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' must be a ", prefix, "integer value") } .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = TRUE) if (length(x) > 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' ", .arrayToString(x, vectorLookAndFeelEnabled = TRUE), " must be a ", prefix, "integer value") } if (!is.numeric(x) || (!naAllowed && is.na(x)) || (validateType && !is.integer(x)) || (!validateType && !is.na(x) && !is.infinite(x) && as.integer(x) != x)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", ifelse(isS4(x), class(x), x), ") must be a ", prefix, "integer value") } if (mustBePositive && !is.na(x) && !is.infinite(x) && x <= 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", ifelse(isS4(x), class(x), x), ") must be a ", prefix, "integer value") } } .assertIsSingleCharacter <- function(x, argumentName, naAllowed = FALSE, noDefaultAvailable = FALSE) { if (missing(x) || is.null(x) || length(x) == 0) { .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = FALSE) stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' must be a valid character value") } .assertIsNoDefault(x, argumentName, noDefaultAvailable, checkNA = TRUE) if (length(x) > 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' ", .arrayToString(x, vectorLookAndFeelEnabled = TRUE), " must be a single character value") } if (!is.character(x)) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'%s' must be a valid character value (is an instance of class '%s')"), argumentName, class(x))) } if (!naAllowed && is.na(x)) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'%s' (NA) must be a valid character value"), argumentName)) } } .assertIsCharacter <- function(x, argumentName, naAllowed = FALSE) { if (missing(x) || is.null(x) || length(x) == 0) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' must be a valid character value or vector") } if (!all(is.character(x))) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'%s' must be a valid character value or vector ", "(is an instance of class '%s')"), argumentName, class(x))) } if (!naAllowed && any(is.na(x))) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'%s' (%s) must be a valid character value (NA is not allowed)"), argumentName, .arrayToString(x))) } } .assertDesignParameterExists <- function(design, parameterName, defaultValue) { if (missing(design)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'design' must be defined") } if (missing(parameterName)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'parameterName' must be defined") } if (missing(defaultValue)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'defaultValue' must be defined") } value <- design[[parameterName]] if (is.null(value) || length(value) == 0 || all(is.na(value))) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "parameter '", parameterName, "' must be specified in design") } if (is.null(defaultValue) || length(defaultValue) == 0 || all(is.na(defaultValue))) { design$.setParameterType(parameterName, C_PARAM_USER_DEFINED) return(invisible()) } if (all(value == defaultValue)) { design$.setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) } else { design$.setParameterType(parameterName, C_PARAM_USER_DEFINED) } } .designParameterExists <- function(design, parameterName) { if (missing(design)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'design' must be defined") } if (missing(parameterName)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'parameterName' must be defined") } value <- design[[parameterName]] if (is.null(value)) { return(FALSE) } if (length(value) > 1) { return(sum(is.na(value)) < length(value)) } return(!is.na(value)) } .assertIsOptimizationCriterion <- function(x) { if (!.isOptimizationCriterion(x)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "optimization criterion must be one of the following: ", .printOptimizationCriterion()) } } .assertIsValidAlpha <- function(alpha) { .assertIsSingleNumber(alpha, "alpha") if (alpha < 1e-06 || alpha >= 0.5) { stop(C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'alpha' (", alpha, ") is out of bounds [1e-06; 0.5)") } } .assertIsValidKappa <- function(kappa) { .assertIsSingleNumber(kappa, "kappa") .assertIsInOpenInterval(kappa, "kappa", lower = 0, upper = NULL) } .assertIsValidLambda <- function(lambda, lambdaNumber = 0) { argumentName <- "lambda" if (lambdaNumber >= 1) { argumentName <- paste0("lambda", lambdaNumber) } .assertIsNumericVector(lambda, argumentName, naAllowed = TRUE) if (all(is.na(lambda))) { return(invisible()) } if (any(is.na(lambda))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", .arrayToString(lambda), ") must be a valid numeric vector") } .assertIsInClosedInterval(lambda, argumentName, lower = 0, upper = NULL) if (all(lambda == 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", .arrayToString(lambda), ") not allowed: ", "at least one lambda value must be > 0") } } .assertIsValidFollowUpTime <- function(followUpTime) { if (is.null(followUpTime) || length(followUpTime) == 0 || is.na(followUpTime)) { return(invisible()) } .assertIsSingleNumber(followUpTime, "followUpTime", naAllowed = TRUE) if (followUpTime < 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'followUpTime' (", followUpTime, ") must be >= 0") } } .assertIsValidAccrualTime <- function(accrualTime) { .assertIsNumericVector(accrualTime, "accrualTime", naAllowed = TRUE) if (is.null(accrualTime) || length(accrualTime) == 0 || all(is.na(accrualTime))) { return(invisible()) } if (any(accrualTime < 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualTime' (", .arrayToString(accrualTime), ") must be >= 0") } } .assertIsValidStandardDeviation <- function(stDev) { .assertIsSingleNumber(stDev, "stDev") if (stDev <= 0) { stop(C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "standard deviation 'stDev' (", stDev, ") must be > 0") } } .assertIsValidBeta <- function(beta, alpha) { .assertIsSingleNumber(beta, "beta") .assertIsSingleNumber(alpha, "alpha") if (beta < 1e-04 || beta >= 1 - alpha) { stop(C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'beta' (", beta, ") is out of bounds [1e-04; ", (1 - alpha), "); ", "condition: 1e-05 <= alpha < 1 - beta <= 1 - 1e-04") } } .assertIsValidAlphaAndBeta <- function(alpha, beta) { .assertIsValidAlpha(alpha) .assertIsValidBeta(beta, alpha) } .assertIsValidStage <- function(stage, kMax) { if (stage < 1 || stage > kMax) { stop(C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'stage' (", stage, ") is out of bounds [1; ", kMax, "]") } } .assertIsValidIterationsAndSeed <- function(iterations, seed, zeroIterationsAllowed = TRUE) { if (is.null(iterations) || length(iterations) == 0 || !is.numeric(iterations)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'iterations' must be a valid integer value") } if (zeroIterationsAllowed) { if (iterations < 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'iterations' (", iterations, ") must be >= 0") } } else { if (iterations < 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'iterations' (", iterations, ") must be > 0") } } if (is.null(seed) || length(seed) == 0 || (!is.na(seed) && !is.numeric(seed))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'seed' (", seed, ") must be a valid integer value") } } .assertIsValidLegendPosition <- function(legendPosition) { if (is.null(legendPosition) || length(legendPosition) != 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'legendPosition' (", .arrayToString(legendPosition), ") must be a single integer or character value") } if (is.na(legendPosition)) { return(invisible()) } if (!is.numeric(legendPosition) && !is.character(legendPosition)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'legendPosition' (", legendPosition, ") must be a single integer or character value") } if (is.numeric(legendPosition)) { .assertIsSingleInteger(legendPosition, "legendPosition", validateType = FALSE) .assertIsInClosedInterval(legendPosition, "legendPosition", lower = -1, upper = 6) } else { validLegendPositions <- c("none", "top", "bottom", "left", "right") if (!(legendPosition %in% validLegendPositions)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'legendPosition' (", legendPosition, ") must be one of the following values: ", .arrayToString(validLegendPositions)) } } } .assertIsValidKMax <- function(kMax, kMaxLowerBound = 1, kMaxUpperBound = C_KMAX_UPPER_BOUND, showWarnings = FALSE) { .assertIsSingleInteger(kMax, "kMax", validateType = FALSE) .assertIsInClosedInterval(kMax, "kMax", lower = kMaxLowerBound, upper = kMaxUpperBound) if (showWarnings && kMax > 10) { warning("The usage of 'kMax' (", kMax, ") > 10 is not validated", call. = FALSE) } } .assertAreValidInformationRates <- function(informationRates, kMax = length(informationRates), kMaxLowerBound = 1, kMaxUpperBound = C_KMAX_UPPER_BOUND) { if (length(informationRates) < kMaxLowerBound) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ARGUMENT_LENGTH_OUT_OF_BOUNDS, "length of 'informationRates' (%s) is out of bounds [%s; %s]"), length(informationRates), kMaxLowerBound, ifelse(kMax >= kMaxLowerBound && kMax < C_KMAX_UPPER_BOUND, kMax, C_KMAX_UPPER_BOUND))) } .assertIsValidKMax(kMax, kMaxLowerBound = kMaxLowerBound, kMaxUpperBound = kMaxUpperBound) if (length(informationRates) != kMax) { stop(sprintf(paste0(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "length of 'informationRates' (%s) must be equal to 'kMax' (%s)"), length(informationRates), kMax)) } if (length(informationRates) > kMaxUpperBound) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ARGUMENT_LENGTH_OUT_OF_BOUNDS, "length of 'informationRates' (%s) is out of bounds [%s; %s]"), length(informationRates), kMaxLowerBound, kMax)) } if (kMax == 1) { return(invisible()) } .assertValuesAreInsideBounds("informationRates", informationRates, 0, 1, lowerBoundInclusive = FALSE) if (min(informationRates) <= 0 || max(informationRates) > 1 || any(informationRates[2:kMax] <= informationRates[1:(kMax - 1)])) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'informationRates' (%s) ", "must be strictly increasing: 0 < x_1 < .. < x_%s <= 1"), .arrayToString(informationRates, vectorLookAndFeelEnabled = FALSE), kMax)) } } .assertValuesAreInsideBounds <- function(parameterName, values, lowerBound, upperBound, lowerBoundInclusive = TRUE, upperBoundInclusive = TRUE) { lower <- min(values) upper <- max(values) lowerInvalid <- ifelse(lowerBoundInclusive, lower < lowerBound, lower <= lowerBound) upperInvalid <- ifelse(upperBoundInclusive, upper > upperBound, upper >= upperBound) if (!is.na(lowerInvalid)) { if (lowerInvalid || upperInvalid) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'%s' (%s) is out of bounds %s%s; %s%s"), parameterName, .arrayToString(values, vectorLookAndFeelEnabled = FALSE), ifelse(lowerBoundInclusive, "[", "("), lowerBound, upperBound, ifelse(upperBoundInclusive, "]", ")"))) } } } .assertContainsNoNas <- function(values, parameterName) { if (any(is.na(values))) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'%s' (%s) ", "must contain valid numeric values (NA is not allowed)"), parameterName, .arrayToString(values, vectorLookAndFeelEnabled = FALSE))) } } .assertContainsOnlyNasAtTheEnd <- function(values, parameterName) { if (length(values) <= 1) { return(invisible()) } for (i in length(values):2) { if (!is.na(values[i]) && is.na(values[i - 1])) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'%s' (%s) ", "must contain valid numeric values (NAs are only allowed at the end of the vector)"), parameterName, .arrayToString(values, vectorLookAndFeelEnabled = FALSE))) } } } .assertValuesAreStrictlyIncreasing <- function(values, parameterName, endingNasAllowed = FALSE) { len <- length(values) if (len <= 1) { return(invisible()) } if (!endingNasAllowed) { .assertContainsNoNas(values, parameterName) } .assertContainsOnlyNasAtTheEnd(values, parameterName) valuesTemp <- values values <- na.omit(values) len <- length(values) if (len <= 1) { return(invisible()) } if (any(values[2:len] <= values[1:(len - 1)])) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'%s' (%s) ", "must be strictly increasing: x_1 < .. < x_%s"), parameterName, .arrayToString(valuesTemp, vectorLookAndFeelEnabled = FALSE), len)) } } .assertValuesAreMonotoneIncreasing <- function(values, parameterName, endingNasAllowed = FALSE) { len <- length(values) if (len <= 1) { return(invisible()) } if (!endingNasAllowed) { .assertContainsNoNas(values, parameterName) } .assertContainsOnlyNasAtTheEnd(values, parameterName) valuesTemp <- values values <- na.omit(values) len <- length(values) if (len <= 1) { return(invisible()) } if (any(values[2:len] < values[1:(len - 1)])) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'%s' (%s) ", "must be increasing: x_1 <= .. <= x_%s"), parameterName, .arrayToString(valuesTemp, vectorLookAndFeelEnabled = FALSE), len)) } } .assertAreValidFutilityBounds <- function(futilityBounds, kMax = length(futilityBounds) + 1, kMaxLowerBound = 1, kMaxUpperBound = C_KMAX_UPPER_BOUND) { if (length(futilityBounds) < kMaxLowerBound - 1) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ARGUMENT_LENGTH_OUT_OF_BOUNDS, "length of 'futilityBounds' (%s) is out of bounds [%s; %s]"), length(futilityBounds), kMaxLowerBound - 1, ifelse(kMax >= kMaxLowerBound && kMax < C_KMAX_UPPER_BOUND, kMax - 1, C_KMAX_UPPER_BOUND - 1))) } .assertIsValidKMax(kMax, kMaxLowerBound = kMaxLowerBound, kMaxUpperBound = kMaxUpperBound) if (length(futilityBounds) != kMax - 1) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "length of 'futilityBounds' (", length(futilityBounds), ") must be equal to 'kMax' (", kMax, ") - 1") } .assertValuesAreInsideBounds("futilityBounds", futilityBounds, -Inf, 6) } .assertIsValidCipher <- function(key, value) { if (getCipheredValue(value) != C_CIPHERS[[key]]) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'token' and/or 'secret' unkown") } } .assertIsValidAlpha0Vec <- function(alpha0Vec, kMax = length(alpha0Vec) - 1, kMaxLowerBound = 1, kMaxUpperBound = C_KMAX_UPPER_BOUND) { if (length(alpha0Vec) < kMaxLowerBound - 1) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ARGUMENT_LENGTH_OUT_OF_BOUNDS, "length of 'alpha0Vec' (%s) is out of bounds [%s; %s]"), length(alpha0Vec), kMaxLowerBound - 1, kMax - 1)) } .assertIsValidKMax(kMax, kMaxLowerBound = kMaxLowerBound, kMaxUpperBound = kMaxUpperBound) if (length(alpha0Vec) != kMax - 1) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "length of 'alpha0Vec' (", length(alpha0Vec), ") must be equal to 'kMax' (", kMax, ") - 1") } .assertValuesAreInsideBounds("alpha0Vec", alpha0Vec, 0, 1, lowerBoundInclusive = FALSE) } .assertIsValidSidedParameter <- function(sided) { if (sided != 1 && sided != 2) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'sided' (", sided, ") must be 1 or 2") } } .assertIsValidGroupsParameter <- function(groups) { if (groups != 1 && groups != 2) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'groups' (", groups, ") must be 1 or 2") } } .assertIsValidForLogarithmization <- function(valueList) { if (getLogLevel() %in% c(C_LOG_LEVEL_PROGRESS, C_LOG_LEVEL_DISABLED)) { return(invisible()) } if (missing(valueList)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'valueList' must be defined") } if (!is.list(valueList) || length(valueList) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'valueList' must be a valid list") } for (index in 1:length(valueList)) { value <- valueList[[index]] if (is.null(value) || is.na(value) || !is.numeric(value) || value < 0) { paramName <- names(valueList)[index] stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "logarithmization of '", paramName, "' (", value, ") produces NaN") } } } .allArgumentsAreNotNull <- function(...) { args <- list(...) naCounter <- 0 for (arg in args) { if (!is.null(arg)) { naCounter <- naCounter + sum(is.na(arg)) } } return(naCounter == 0) } .assertAssociatedArgumentsAreDefined <- function(...) { .associatedArgumentsAreDefined(..., warningOnlyEnabled = FALSE) } .associatedArgumentsAreDefined <- function(..., warningOnlyEnabled = TRUE) { args <- NULL tryCatch(expr = { args <- list(...) }, error = function(e) { stop(simpleError(paste0(C_EXCEPTION_TYPE_MISSING_ARGUMENT, e$message), call = e$call)) }) if (.allArgumentsAreNotNull(...)) { return(invisible(TRUE)) } args <- args[args != "warningOnlyEnabled" & !is.null(args)] argNames <- names(args) if (sum(argNames == "") > 0) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "each argument must have a name defined, e.g. a = a") } definedArguments <- c() undefinedArguments <- c() for (i in 1:length(args)) { arg <- args[i] argName <- argNames[i] if (missing(arg) || (!is.null(arg) && sum(is.na(arg)) > 0)) { undefinedArguments <- c(undefinedArguments, argName) } else { definedArguments <- c(definedArguments, argName) } } if (length(undefinedArguments) > 0 && length(definedArguments) > 0) { message <- paste0(.arrayToString(undefinedArguments, encapsulate = TRUE), " ", ifelse(warningOnlyEnabled, "should", "must"), " be defined because ", .arrayToString(definedArguments, encapsulate = TRUE), ifelse(length(definedArguments) > 1, " are", " is"), " defined") if (warningOnlyEnabled) { warning(C_EXCEPTION_TYPE_INCOMPLETE_ARGUMENTS, message, call. = FALSE) return(FALSE) } else { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, message) } } return(invisible(length(definedArguments) == length(args))) } .assertIsValidNPlanned <- function(nPlanned, kMax, stage, ..., required = TRUE) { if (is.null(nPlanned) || (length(nPlanned) > 0 && all(is.na(nPlanned)))) { if (!required) { return(invisible()) } stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'nPlanned' must be specified") } if (length(nPlanned) != kMax - stage) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sprintf(paste0("'nPlanned' (%s) is invalid: ", "length must be equal to %s (kMax - stage = %s - %s)"), .arrayToString(nPlanned), kMax - stage, kMax, stage)) } if (sum(is.na(nPlanned)) > 0 || sum(nPlanned <= 0) > 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sprintf(paste0("'nPlanned' (%s) is invalid: ", "all values must be > 0"), .arrayToString(nPlanned))) } } .isValidNPlanned <- function(nPlanned, kMax, stage) { if (missing(nPlanned)) { warning("'nPlanned' is missing", call. = FALSE) return(FALSE) } if (!any(is.na(nPlanned))) { if ((length(nPlanned) != kMax - stage)) { warning(sprintf(paste0("'nPlanned' (%s) will be ignored: ", "length must be equal to %s (kMax - stage = %s - %s)"), .arrayToString(nPlanned), kMax - stage, kMax, stage), call. = FALSE) return(FALSE) } if (sum(is.na(nPlanned)) > 0 || sum(nPlanned <= 0) > 0) { warning(sprintf(paste0("'nPlanned' (%s) will be ignored: ", "all values must be > 0"), .arrayToString(nPlanned)), call. = FALSE) return(FALSE) } } return(TRUE) } .warnInCaseOfUnknownArguments <- function(..., functionName, ignore = c(), numberOfAllowedUnnamedParameters = 0) { args <- list(...) if (length(args) == 0) { return(invisible()) } if (numberOfAllowedUnnamedParameters > 0) { ignore <- c(ignore, paste0("%param", 1:numberOfAllowedUnnamedParameters, "%")) } ignore <- c(ignore, "showWarnings") argNames <- names(args) for (i in 1:length(args)) { arg <- args[[i]] argName <- ifelse(is.null(argNames[i]) || argNames[i] == "", ifelse(inherits(arg, "StageResults"), "stageResultsName", paste0("%param", i, "%")), argNames[i]) if (!(argName %in% ignore) && !grepl("^\\.", argName)) { if (isS4(arg) || is.environment(arg)) { arg <- class(arg) } if (is.function(arg)) { arg <- "function(...)" } argValue <- paste0(" (", class(arg), ")") tryCatch(expr = { argValue <- .arrayToString(arg, vectorLookAndFeelEnabled = length(arg) > 1, encapsulate = is.character(arg)) argValue <- paste0(" = ", argValue) }, error = function(e) {}) warning("Argument unknown in ", functionName, "(...): '", argName, "'", argValue, " will be ignored", call. = FALSE) } } } .warnInCaseOfUnusedArgument <- function(arg, argName, defaultValue, functionName) { if (!identical(arg, defaultValue)) { warning("Unused argument in ", functionName, "(...): '", argName, "' = ", .arrayToString(arg, vectorLookAndFeelEnabled = (length(arg) > 1), maxLength = 10), " will be ignored", call. = FALSE) } } .assertIsDefined <- function(parameter, parameterName) { if (is.null(parameter) || any(is.na(parameter))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", parameterName, "' must be defined") } } .isTrialDesignWithValidFutilityBounds <- function(design) { if (is.null(design) || !.isTrialDesignInverseNormalOrGroupSequential(design)) { return(FALSE) } futilityBounds <- design[["futilityBounds"]] if (is.null(futilityBounds)) { return(FALSE) } if (length(futilityBounds) == 0 || sum(is.na(futilityBounds)) == design$kMax) { return(FALSE) } return(any(na.omit(futilityBounds) > C_FUTILITY_BOUNDS_DEFAULT)) } .isTrialDesignWithValidAlpha0Vec <- function(design) { if (is.null(design) || !.isTrialDesignFisher(design)) { return(FALSE) } alpha0Vec <- design[["alpha0Vec"]] if (is.null(alpha0Vec)) { return(FALSE) } alpha0Vec <- na.omit(alpha0Vec) if (length(alpha0Vec) == 0 || all(is.na(alpha0Vec))) { return(FALSE) } return(any(alpha0Vec != C_ALPHA_0_VEC_DEFAULT)) } .assertPackageIsInstalled <- function(packageName) { if (!requireNamespace(packageName, quietly = TRUE)) { stop("Package \"", packageName, "\" is needed for this function to work. ", "Please install using, e.g., install.packages(\"", packageName, "\")", call. = FALSE) } } .assertGgplotIsInstalled <- function() { .assertPackageIsInstalled("ggplot2") } .assertRcppIsInstalled <- function() { .assertPackageIsInstalled("Rcpp") } .assertTestthatIsInstalled <- function() { .assertPackageIsInstalled("testthat") } .assertMnormtIsInstalled <- function() { .assertPackageIsInstalled("mnormt") } .assertIsValidThetaH0 <- function(thetaH0, ..., endpoint = c("means", "rates", "survival"), groups, ratioEnabled = FALSE) { .warnInCaseOfUnknownArguments(functionName = ".assertIsValidThetaH0", ...) if (is.na(thetaH0)) { return(invisible()) } if (!is.numeric(thetaH0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'thetaH0' must be a valid numeric value") } endpoint <- match.arg(endpoint) if (endpoint == "means" || endpoint == "rates") { if (groups == 2 && ratioEnabled) { if (thetaH0 <= 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'thetaH0' (", thetaH0, ") must be > 0") } return(invisible()) } } if (endpoint == "rates") { if (groups == 1) { if (thetaH0 <= 0 || thetaH0 >= 1) { stop(C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'thetaH0' (", thetaH0, ") is out of bounds (0; 1) or not specified") } } else { if (thetaH0 <= -1 || thetaH0 >= 1) { stop(C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'thetaH0' (", thetaH0, ") is out of bounds (-1; 1)") } } } else if (endpoint == "survival") { if (thetaH0 <= 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'thetaH0' (", thetaH0, ") must be > 0") } } } .assertIsValidThetaH0DataInput <- function(thetaH0, dataInput) { if (.isDatasetRates(dataInput)) { endpoint <- "rates" } else if (.isDatasetSurvival(dataInput)) { endpoint <- "survival" } else { endpoint <- "means" } .assertIsValidThetaH0(thetaH0, endpoint = endpoint, groups = dataInput$getNumberOfGroups()) } .assertIsValidThetaRange <- function(..., thetaRange, thetaAutoSeqEnabled = TRUE, survivalDataEnabled = FALSE) { if (is.null(thetaRange) || (thetaAutoSeqEnabled && length(thetaRange) <= 1) || any(is.na(thetaRange))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'thetaRange' (", .arrayToString(thetaRange), ") must be a vector ", "with two entries defining minimum and maximum ", "or a sequence of numeric values with length > 2") } else if (length(thetaRange) == 2 && thetaAutoSeqEnabled) { minValue <- thetaRange[1] maxValue <- thetaRange[2] if (survivalDataEnabled) { .assertIsValidHazardRatio(minValue, "thetaRange[1]") .assertIsValidHazardRatio(maxValue, "thetaRange[2]") } if (minValue >= maxValue) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'thetaRange' with length 2 must contain minimum < maximum (", minValue, " >= ", maxValue , ")") } by <- (maxValue - minValue) / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT thetaRange <- seq(minValue, maxValue, by) } invisible(thetaRange) } .assertIsValidPiTreatmentRange <- function(..., piTreatmentRange, piAutoSeqEnabled = TRUE) { if (is.null(piTreatmentRange) || (piAutoSeqEnabled && length(piTreatmentRange) <= 1) || any(is.na(piTreatmentRange))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piTreatmentRange' (", .arrayToString(piTreatmentRange), ") must be a vector ", "with two entries defining minimum and maximum ", "or a sequence of numeric values with length > 2") } else if (length(piTreatmentRange) == 2) { if (piAutoSeqEnabled) { minValue <- piTreatmentRange[1] maxValue <- piTreatmentRange[2] if (minValue == 0) { minValue <- 0.00000001 } if (maxValue == 1) { maxValue <- 0.99999999 } .assertIsValidPi(minValue, "piTreatmentRange[1]") .assertIsValidPi(maxValue, "piTreatmentRange[2]") if (minValue >= maxValue) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piTreatmentRange' with length 2 must contain minimum < maximum (", minValue, " >= ", maxValue , ")") } by <- (maxValue - minValue) / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT piTreatmentRange <- seq(minValue, maxValue, by) } } invisible(piTreatmentRange) } .assertIsValidPi <- function(piValue, piName) { if (is.null(piValue) || length(piValue) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", piName, "' must be a valid numeric value") } if (all(is.na(piValue))) { return(invisible()) } if (!is.numeric(piValue) || any(is.na(piValue))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", piName, "' (", .arrayToString(piValue), ") must be a valid numeric value") } if (any(piValue <= -1e-16) || any(piValue >= 1 + 1e-16)) { stop(C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, "'", piName, "' (", .arrayToString(piValue), ") is out of bounds (0; 1) or event time too long") } } .assertIsValidPi1 <- function(pi1, stageResults = NULL, stage = NULL) { if (is.na(pi1) && !is.null(stageResults) && !is.null(stage)) { if (stageResults$isOneSampleDataset()) { pi1 <- stageResults$overallEvents[stage] / stageResults$overallSampleSizes[stage] } else { pi1 <- stageResults$overallEvents1[stage] / stageResults$overallSampleSizes1[stage] } } .assertIsInClosedInterval(pi1, "pi1", lower = 0, upper = 1) invisible(pi1) } .assertIsValidPi2 <- function(pi2, stageResults = NULL, stage = NULL) { if (is.na(pi2) && !is.null(stageResults) && !is.null(stage)) { pi2 <- stageResults$overallEvents2[stage] / stageResults$overallSampleSizes2[stage] } .assertIsInClosedInterval(pi2, "pi2", lower = 0, upper = 1) invisible(pi2) } .assertIsValidAllocationRatioPlanned <- function(allocationRatioPlanned, numberOfGroups) { if (numberOfGroups == 1) { return(invisible()) } .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) if (allocationRatioPlanned != C_ALLOCATION_RATIO_DEFAULT && numberOfGroups == 1) { warning("Planned allocation ratio ", allocationRatioPlanned, " will be ignored ", "because the specified data has only one group", call. = FALSE) } } .assertIsValidAllocationRatioPlannedSampleSize <- function( allocationRatioPlanned, maxNumberOfSubjects = NA_real_) { .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") if (allocationRatioPlanned < 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'allocationRatioPlanned' (", allocationRatioPlanned, ") must be >= 0") } if (length(maxNumberOfSubjects) > 0 && !is.na(maxNumberOfSubjects) && maxNumberOfSubjects > 0 && allocationRatioPlanned == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "determination of optimal allocation ratio not possible ", "if explicit or implicit 'maxNumberOfSubjects' (", maxNumberOfSubjects, ") > 0, i.e., follow-up time should be calculated ", "(please specify an 'allocationRatioPlanned' > 0)") } } .assertIsValidThetaH1 <- function(thetaH1, stageResults = NULL, stage = NULL, ..., results = NULL) { if (is.na(thetaH1) && !is.null(stageResults) && !is.null(stage)) { thetaH1 <- stageResults$effectSizes[stage] if (!is.null(results)) { results$.setParameterType("thetaH1", C_PARAM_GENERATED) } } .assertIsSingleNumber(thetaH1, "thetaH1") invisible(thetaH1) } .assertIsValidAssumedStDev <- function(assumedStDev, stageResults = NULL, stage = NULL, ..., results = NULL) { if (is.na(assumedStDev) && !is.null(stageResults) && !is.null(stage)) { assumedStDev <- stageResults$overallStDevs[stage] if (!is.null(results)) { results$.setParameterType("assumedStDev", C_PARAM_GENERATED) } } .assertIsSingleNumber(assumedStDev, "assumedStDev") if (assumedStDev <= 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'assumedStDev' (", assumedStDev, ") must be > 0") } invisible(assumedStDev) } .assertIsValidThetaH1ForMultiArm <- function(thetaH1, stageResults = NULL, stage = NULL, ..., results = NULL) { if (!is.null(stageResults) && all(is.na(thetaH1)) && !is.null(stage)) { thetaH1 <- stageResults$effectSizes[, stage] if (!is.null(results)) { results$.setParameterType("thetaH1", C_PARAM_GENERATED) } } .assertIsNumericVector(thetaH1, "thetaH1", naAllowed = TRUE) invisible(thetaH1) } .assertIsValidThetaH1ForEnrichment <- function(thetaH1, stageResults = NULL, stage = NULL, ..., results = NULL) { invisible(.assertIsValidThetaH1ForMultiArm(thetaH1 = thetaH1, stageResults = stageResults, stage = stage, results = results)) } .assertIsValidAssumedStDevForMultiHypotheses <- function(assumedStDev, stageResults = NULL, stage = NULL, ..., results = NULL) { if (!is.null(stageResults) && all(is.na(assumedStDev)) && !is.null(stage)) { if (is.matrix(stageResults$overallStDevs)) { # inherits(stageResults, "StageResultsMultiArmMeans") assumedStDev <- stageResults$overallStDevs[, stage] } else { assumedStDev <- stageResults$overallStDevs[stage] } if (!is.null(results)) { results$.setParameterType("assumedStDevs", C_PARAM_GENERATED) } } .assertIsNumericVector(assumedStDev, "assumedStDev", naAllowed = TRUE) if (any(assumedStDev <= 0, na.rm = TRUE)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'assumedStDev' (", .arrayToString(assumedStDev), ") must be > 0") } invisible(assumedStDev) } .assertIsValidPiTreatmentsForMultiArm <- function(piTreatments, stageResults = NULL, stage = NULL, ..., results = NULL) { if (!is.null(stageResults) && all(is.na(piTreatments)) && !is.null(stage)) { piTreatments <- stageResults$overallPiTreatments[, stage] if (!is.null(results)) { results$.setParameterType("piTreatments", C_PARAM_GENERATED) } } .assertIsNumericVector(piTreatments, "piTreatments", naAllowed = TRUE) .assertIsInClosedInterval(piTreatments, "piTreatments", lower = 0, upper = 1, naAllowed = TRUE) invisible(piTreatments) } .assertIsValidPiControlForMultiArm <- function(piControl, stageResults = NULL, stage = NULL, ..., results = NULL) { if (!is.null(stageResults) && is.na(piControl) && !is.null(stage)) { piControl <- stageResults$overallPiControl[, stage] if (!is.null(results)) { results$.setParameterType("piControl", C_PARAM_GENERATED) } } .assertIsNumericVector(piControl, "piControl", naAllowed = TRUE) .assertIsInClosedInterval(piControl, "piControl", lower = 0, upper = 1) invisible(piControl) } .assertIsValidPiTreatmentsForEnrichment <- function(piTreatments, stageResults = NULL, stage = NULL, ..., results = NULL) { if (!is.null(stageResults) && all(is.na(piTreatments)) && !is.null(stage)) { piTreatments <- stageResults$overallPisTreatment[, stage] if (!is.null(results)) { results$.setParameterType("piTreatments", C_PARAM_GENERATED) } } .assertIsNumericVector(piTreatments, "piTreatments", naAllowed = TRUE) .assertIsInClosedInterval(piTreatments, "piTreatments", lower = 0, upper = 1, naAllowed = TRUE) invisible(piTreatments) } .assertIsValidPiControlForEnrichment <- function(piControls, stageResults = NULL, stage = NULL, ..., results = NULL) { if (!is.null(stageResults) && all(is.na(piControls)) && !is.null(stage)) { piControls <- stageResults$overallPisControl[, stage] if (!is.null(results)) { results$.setParameterType("piControls", C_PARAM_GENERATED) } } .assertIsNumericVector(piControls, "piControls", naAllowed = TRUE) .assertIsInClosedInterval(piControls, "piControls", lower = 0, upper = 1, naAllowed = TRUE) invisible(piControls) } .isValidValueOrVector <- function(x) { if (is.null(x) || length(x) == 0) { return(FALSE) } return(!any(is.na(x))) } .assertIsValidHazardRatio <- function(hazardRatio, thetaH0) { .assertIsNumericVector(hazardRatio, "hazardRatio") if (any(hazardRatio == thetaH0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "alternative not correctly specified: ", "each hazard ratio (", .arrayToString(hazardRatio[1:min(length(hazardRatio), 10)]), ") must be unequal to 'thetaH0' (", thetaH0, ")") } } .assertIsValidHazardRatioVector <- function(hazardRatio) { .assertIsNumericVector(hazardRatio, "hazardRatio") if (any(hazardRatio <= 0)) { if (length(hazardRatio) == 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'hazardRatio' (", hazardRatio ,") must be > 0") } else { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "each 'hazardRatio' (", .arrayToString(hazardRatio[1:min(length(hazardRatio), 10)]), ") must be > 0") } } } .assertIsValidDirectionUpper <- function(directionUpper, sided, objectType = c("power", "sampleSize"), userFunctionCallEnabled = FALSE) { objectType <- match.arg(objectType) .assertIsSingleLogical(directionUpper, "directionUpper", naAllowed = TRUE) if (objectType == "power") { if (sided == 1 && is.na(directionUpper)) { directionUpper <- TRUE } if (userFunctionCallEnabled && sided == 2 && !is.na(directionUpper)) { warning("'directionUpper' will be ignored because it ", "is not applicable for 'sided' = 2", call. = FALSE) } } else if (is.na(directionUpper)) { directionUpper <- TRUE } return(directionUpper) } .assertIsFunction <- function(fun) { if (is.null(fun)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'fun' must be a valid function") } if (!is.function(fun)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'fun' must be a function (is ", class(fun), ")") } } .assertIsValidFunction <- function(fun, ..., funArgName = "fun", expectedArguments = NULL, expectedFunction = NULL, identical = FALSE, validateThreeDots = TRUE, showUnusedArgumentsMessage = FALSE, namedArgumentsExpected = FALSE) { fCall = match.call(expand.dots = FALSE) if (is.null(expectedArguments) && is.null(expectedFunction)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'expectedArguments' or 'expectedFunction' must be not NULL") } if (!is.function(fun)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", funArgName, "' must be a function") } functionName <- as.character(fCall$fun) if (is.null(functionName) || functionName == funArgName) { functionName <- "function" } argNames <- methods::formalArgs(fun) if (!is.null(expectedArguments)) { argNamesExpected <- expectedArguments } else if (!is.null(expectedFunction)) { if (!is.function(expectedFunction)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'expectedFunction' must be a function") } argNamesExpected <- methods::formalArgs(expectedFunction) } if (validateThreeDots) { if (!("..." %in% argNames)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", funArgName, "' must contain the three-dots argument '...', e.g., ", funArgName, " = ", functionName, "(", .arrayToString(argNames), ", ...)") } } argNames <- argNames[argNames != "..."] argNamesExpected <- argNamesExpected[argNamesExpected != "..."] if (length(argNamesExpected) < ifelse(namedArgumentsExpected, 1, 2) && length(argNames) == length(argNamesExpected)) { return(invisible()) } for (argName in argNames) { if (argName != "..." && !(argName %in% argNamesExpected)) { msg <- paste0(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the argument '", argName, "' in '", funArgName, "' (", functionName, ") is not allowed.") if (length(argNamesExpected) == 1) { stop(msg, " Expected: '", argNamesExpected, "'") } stop(msg, "\n", "Use one or more of the following arguments:\n ", .arrayToString(argNamesExpected, encapsulate = TRUE)) } } if (identical) { for (argNameExpected in argNamesExpected) { if (argNameExpected != "..." && !(argNameExpected %in% argNames)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", funArgName, "' (", functionName, ") must contain ", "an argument with name '", argNameExpected, "'") } } return(invisible()) } counter <- 0 unusedArgs <- c() for (argNameExpected in argNamesExpected) { if (argNameExpected %in% argNames) { counter <- counter + 1 } else { unusedArgs <- c(unusedArgs, argNameExpected) } } if (counter == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", funArgName, "' (", functionName, ") must contain at ", "least one of the following arguments: ", .arrayToString(argNamesExpected)) } if (showUnusedArgumentsMessage && length(unusedArgs) > 0) { message("Note that the following arguments can optionally be used in '", funArgName, "' (", functionName, "): \n", .arrayToString(unusedArgs), call. = FALSE) } } .assertIsValidThreshold <- function(threshold, activeArms) { .assertIsNumericVector(threshold, "threshold", naAllowed = TRUE) if ((length(threshold) != 1) && (length(threshold) != activeArms)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'threshold' (", .arrayToString(threshold), ") must be a single value or a vector of length ", activeArms) } } .assertIsValidNumberOfSubjectsPerStage <- function( parameterValues, parameterName, plannedSubjects, conditionalPower, calcSubjectsFunction, kMax, endpoint = c("means", "rates", "survival"), calcSubjectsFunctionEnabled = TRUE) { endpoint <- match.arg(endpoint) if (kMax == 1) { .ignoreParameterIfNotUsed("conditionalPower", conditionalPower, kMax > 1, "design is fixed ('kMax' = 1)") return(invisible(NA_real_)) } .assertIsNumericVector(parameterValues, parameterName, naAllowed = TRUE) calcSubjectsFunctionName <- ifelse(endpoint == "survival", "calcEventsFunction", "calcSubjectsFunction") if (is.na(conditionalPower) && is.null(calcSubjectsFunction)) { if (length(parameterValues) != 1 || !is.na(parameterValues)) { if (calcSubjectsFunctionEnabled) { warning("'", parameterName, "' (", .arrayToString(parameterValues), ") ", "will be ignored because neither 'conditionalPower' nor '", calcSubjectsFunctionName, "' is defined", call. = FALSE) } else { warning("'", parameterName, "' (", .arrayToString(parameterValues), ") ", "will be ignored because 'conditionalPower' is not defined", call. = FALSE) } } return(invisible(NA_real_)) } if (!is.na(conditionalPower) && length(parameterValues) == 0 || (length(parameterValues) == 1 && is.na(parameterValues))) { if (calcSubjectsFunctionEnabled) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", parameterName, "' must be defined ", "because 'conditionalPower' or '", calcSubjectsFunctionName, "' is defined") } else { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", parameterName, "' must be defined ", "because 'conditionalPower' is defined") } } if (length(parameterValues) != kMax) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", parameterName, "' (", .arrayToString(parameterValues), ") must have length ", kMax) } if (any(is.na(parameterValues[2:length(parameterValues)]))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", parameterName, "' (", .arrayToString(parameterValues), ") must contain valid numeric values") } if (!is.na(parameterValues[1]) && parameterValues[1] != plannedSubjects[1]) { warning("First value of '", parameterName, "' (", parameterValues[1], ") will be ignored", call. = FALSE) } parameterValues[1] <- plannedSubjects[1] .assertIsInClosedInterval(parameterValues, parameterName, lower = 1, upper = NULL) return(invisible(parameterValues)) } .assertIsValidMaxNumberOfSubjects <- function(maxNumberOfSubjects, naAllowed = FALSE) { .assertIsSingleNumber(maxNumberOfSubjects, "maxNumberOfSubjects", naAllowed = naAllowed) .assertIsInClosedInterval(maxNumberOfSubjects, "maxNumberOfSubjects", lower = 1, upper = NULL, naAllowed = naAllowed) } .assertAreSuitableInformationRates <- function(design, dataInput, stage) { if (!.isTrialDesignGroupSequential(design) || stage == 1) { return(invisible()) } param <- NA_character_ paramValues <- NA_real_ if (dataInput$isDatasetSurvival()) { if (any(abs(design$informationRates[2:stage] - dataInput$getOverallEventsUpTo(stage)[2:stage] / dataInput$getOverallEventsUpTo(1) * design$informationRates[1]) > C_ACCEPT_DEVIATION_INFORMATIONRATES)) { param <- "events" paramValues <- dataInput$getOverallEventsUpTo(stage) } } else { if (dataInput$getNumberOfGroups() == 1) { if (any(abs(design$informationRates[2:stage] - dataInput$getOverallSampleSizesUpTo(stage)[2:stage] / dataInput$getOverallSampleSizesUpTo(1) * design$informationRates[1]) > C_ACCEPT_DEVIATION_INFORMATIONRATES)) { param <- "sample sizes" paramValues <- dataInput$getOverallSampleSizesUpTo(stage) } } else if (dataInput$getNumberOfGroups() == 2) { if (any(abs(design$informationRates[2:stage] - dataInput$getOverallSampleSizesUpTo(stage)[2:stage] / dataInput$getOverallSampleSizesUpTo(1) * design$informationRates[1]) > C_ACCEPT_DEVIATION_INFORMATIONRATES) || any(abs(design$informationRates[2:stage] - dataInput$getOverallSampleSizesUpTo(stage,2)[2:stage] / dataInput$getOverallSampleSizesUpTo(1, 2) * design$informationRates[1]) > C_ACCEPT_DEVIATION_INFORMATIONRATES)) { param <- "sample sizes" paramValues <- dataInput$getOverallSampleSizesUpTo(stage) + dataInput$getOverallSampleSizesUpTo(stage, 2) } } } if (!is.na(param)) { warning("Observed ", param, " (", .arrayToString(paramValues), ") not according to specified information rates (", .arrayToString(design$informationRates[1:stage]), ") in ", "group sequential design. ", "Test procedure might not control Type I error rate", call. = FALSE) } } .assertIsOneSidedDesign <- function(design, designType = c("multi-arm", "enrichment"), engineType = c("simulation", "analysis")) { if (design$sided == 2) { designType <- match.arg(designType) engineType <- match.arg(engineType) stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, designType, " ", engineType, " is only applicable for one-sided testing") } } .isMultiArmDataset <- function(dataInput) { return(inherits(dataInput, "Dataset") && dataInput$getNumberOfGroups() > 2) } .isMultiArmStageResults <- function(stageResults) { return(inherits(stageResults, "StageResults") && grepl("MultiArm", class(stageResults))) } .isEnrichmentStageResults <- function(stageResults) { return(inherits(stageResults, "StageResults") && grepl("Enrichment", class(stageResults))) } .isEnrichmentConditionalPowerResults <- function(conditionalPowerResults) { return(inherits(conditionalPowerResults, "ConditionalPowerResults") && grepl("Enrichment", class(conditionalPowerResults))) } .isMultiHypothesesStageResults <- function(x) { return(.isMultiArmStageResults(x) || .isEnrichmentStageResults(x)) } .isMultiArmAnalysisResults <- function(analysisResults) { return(inherits(analysisResults, "AnalysisResultsMultiArm")) } .isMultiHypothesesAnalysisResults <- function(x) { return(.isMultiArmAnalysisResults(x) || .isEnrichmentAnalysisResults(x)) } .isEnrichmentDataset <- function(dataInput) { return(inherits(dataInput, "Dataset") && dataInput$.enrichmentEnabled) } .isEnrichmentAnalysisResults <- function(analysisResults) { return(inherits(analysisResults, "AnalysisResultsEnrichment")) } .isMultiArmSimulationResults <- function(simulationResults) { return(inherits(simulationResults, "SimulationResults") && grepl("MultiArm", class(simulationResults))) } .isEnrichmentSimulationResults <- function(simulationResults) { return(inherits(simulationResults, "SimulationResults") && grepl("Enrichment", class(simulationResults))) } .assertIsStageResultsMultiArm <- function(stageResults) { if (!inherits(stageResults, "StageResults")) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be a multi-arm stage results object (is ", class(stageResults), ")") } if (!.isMultiArmStageResults(stageResults)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be a multi-arm object (is ", class(stageResults), ")") } } .assertIsStageResultsNonMultiHypotheses <- function(stageResults) { if (inherits(stageResults, "StageResults") && .isMultiArmStageResults(stageResults)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be a non-multi-arm object (is ", class(stageResults), ")") } if (inherits(stageResults, "StageResults") && .isEnrichmentStageResults(stageResults)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be a non-enrichment object (is ", class(stageResults), ")") } allowedClasses <- c( "StageResultsMeans", "StageResultsRates", "StageResultsSurvival") if (!(class(stageResults) %in% allowedClasses)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be an instance of ", .arrayToString(allowedClasses, vectorLookAndFeelEnabled = FALSE), " (is '", class(stageResults), "')") } } .assertIsDatasetNonMultiHypotheses <- function(dataInput) { if (.isMultiArmDataset(dataInput)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' must be a non-multi-arm dataset (has ", dataInput$getNumberOfGroups(), " treatment arms)") } if (.isEnrichmentDataset(dataInput)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataInput' must be a non-enrichment dataset (has ", dataInput$getNumberOfSubsets(), " subsets)") } } .assertIsAnalysisResults <- function(analysisResults) { if (!inherits(analysisResults, "AnalysisResults")) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'analysisResults' must be a valid 'AnalysisResults' object ", " (is '", class(analysisResults), "')") } } .isValidIntersectionTestMultiArm <- function(intersectionTest) { return(!is.null(intersectionTest) && length(intersectionTest) == 1 && !is.na(intersectionTest) && is.character(intersectionTest) && intersectionTest %in% C_INTERSECTION_TESTS_MULTIARMED) } .getCorrectedIntersectionTestMultiArmIfNecessary <- function(design, intersectionTest, userFunctionCallEnabled = TRUE) { .assertIsCharacter(intersectionTest, "intersectionTest") intersectionTest <- intersectionTest[1] if (.isTrialDesignConditionalDunnett(design) && intersectionTest != "Dunnett") { if (userFunctionCallEnabled) { message <- paste0("Intersection test '", intersectionTest, "' ") if (!.isValidIntersectionTestMultiArm(intersectionTest)) { message <- paste0(message, "is invalid, ") } message <- paste0(message, "will be ignored") message <- paste0(message, ifelse(!.isValidIntersectionTestMultiArm(intersectionTest), ", ", " ")) message <- paste0(message, "and 'Dunnett' will be used instead ", "because conditional Dunnett test was specified as design") warning(message, call. = FALSE) } intersectionTest <- "Dunnett" } return(intersectionTest) } .assertIsValidIntersectionTestMultiArm <- function(design, intersectionTest) { .assertIsCharacter(intersectionTest, "intersectionTest") intersectionTest <- intersectionTest[1] if (!.isValidIntersectionTestMultiArm(intersectionTest)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'intersectionTest' (", intersectionTest, ") must be one of ", .arrayToString(C_INTERSECTION_TESTS_MULTIARMED, encapsulate = TRUE)) } if (.isTrialDesignConditionalDunnett(design) && intersectionTest != "Dunnett") { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "intersection test ('", intersectionTest, "') must be 'Dunnett' ", "because conditional Dunnett test was specified as design") } } .isValidIntersectionTestEnrichment <- function(intersectionTest) { return(!is.null(intersectionTest) && length(intersectionTest) == 1 && !is.na(intersectionTest) && is.character(intersectionTest) && intersectionTest %in% C_INTERSECTION_TESTS_ENRICHMENT) } .assertIsValidIntersectionTestEnrichment <- function(design, intersectionTest) { .assertIsCharacter(intersectionTest, "intersectionTest") intersectionTest <- intersectionTest[1] if (!.isValidIntersectionTestEnrichment(intersectionTest)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'intersectionTest' (", intersectionTest, ") must be one of ", .arrayToString(C_INTERSECTION_TESTS_ENRICHMENT, encapsulate = TRUE)) } return(intersectionTest) } .ignoreParameterIfNotUsed <- function(paramName, paramValue, requirementLogical, requirementFailedReason, prefix = NA_character_) { if (all(is.na(paramValue)) || requirementLogical) { return(paramValue) } if (is.na(prefix) || trimws(prefix) == "") { prefix <- "" } else { prefix <- paste0(trimws(prefix), " ") } warning(prefix, "'", paramName, "' (", .arrayToString(paramValue), ") will be ignored because ", requirementFailedReason, call. = FALSE) return(NA_real_) } # # This is a workaround for the following R core bug: # # rCoreBugDemonstration <- function(stageX, ...) { # result <- list(...); result$stageX <- stageX; return(result) # } # # bug: stage will be removed, stageX gets the value of stage # rCoreBugDemonstration("A", stage = 1) # # everything works as expected # rCoreBugDemonstration("A", state = 1) # .stopInCaseOfIllegalStageDefinition <- function(stageResults, ...) { stage <- list(...)[["stage"]] if (is.null(stage) && is.numeric(stageResults) && stageResults %in% 1L:C_KMAX_UPPER_BOUND) { stage <- stageResults } if (!is.null(stage)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stage' (", stage, ") can only be defined in getStageResults() or getAnalysisResults()") } } .stopInCaseOfIllegalStageDefinition2 <- function(...) { forbiddenStage <- .getOptionalArgument("stage", ...) if (!is.null(forbiddenStage)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stage' (", forbiddenStage, ") can only be defined in getStageResults() or getAnalysisResults()") } } .assertIsValidTolerance <- function(tolerance) { .assertIsSingleNumber(tolerance, "tolerance") if (tolerance > 0.1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'tolerance' (", tolerance, ") must be <= 0.1") } } .isValidVarianceOptionMultiArmed <- function(varianceOption) { return(!is.null(varianceOption) && length(varianceOption) == 1 && !is.na(varianceOption) && is.character(varianceOption) && varianceOption %in% C_VARIANCE_OPTIONS_MULTIARMED) } .assertIsValidVarianceOptionMultiArmed <- function(design, varianceOption) { if (!.isValidVarianceOptionMultiArmed(varianceOption)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'varianceOption' should be one of ", .arrayToString(C_VARIANCE_OPTIONS_MULTIARMED, encapsulate = TRUE)) } if (.isTrialDesignConditionalDunnett(design) && varianceOption != C_VARIANCE_OPTION_DUNNETT) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "variance option ('", varianceOption, "') must be '", C_VARIANCE_OPTION_DUNNETT, "' ", "because conditional Dunnett test was specified as design") } } .isValidVarianceOptionEnrichment <- function(varianceOption) { return(!is.null(varianceOption) && length(varianceOption) == 1 && !is.na(varianceOption) && is.character(varianceOption) && varianceOption %in% C_VARIANCE_OPTIONS_ENRICHMENT) } .assertIsValidVarianceOptionEnrichment <- function(design, varianceOption) { if (!.isValidVarianceOptionEnrichment(varianceOption)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'varianceOption' should be one of ", .arrayToString(C_VARIANCE_OPTIONS_ENRICHMENT, encapsulate = TRUE)) } } .assertIsValidSummaryIntervalFormat <- function(intervalFormat) { .assertIsSingleCharacter(intervalFormat, "intervalFormat") # "[%s; %s]" if (!grepl("^[^%]*%s[^%]*%s[^%]*$", intervalFormat)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'intervalFormat' (", intervalFormat, ") has an invalid format; ", "the control character %s must appear exactly twice; ", "to change it use 'options(\"rpact.summary.intervalFormat\" = \"[%s; %s]\")'") } } .isSpecialPlotShowSourceArgument <- function(showSource) { return(is.character(showSource) && showSource %in% C_PLOT_SHOW_SOURCE_ARGUMENTS) } .assertIsValidTypeOfSelection <- function(typeOfSelection, rValue, epsilonValue, activeArms) { .assertIsCharacter(typeOfSelection, "typeOfSelection") typeOfSelection <- typeOfSelection[1] if (typeOfSelection == "rbest") { typeOfSelection <- "rBest" } if (!(typeOfSelection %in% C_TYPES_OF_SELECTION)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'typeOfSelection' (", typeOfSelection, ") must be one of ", .arrayToString(C_TYPES_OF_SELECTION, encapsulate = TRUE)) } if (typeOfSelection == "rBest") { .assertIsSingleNumber(rValue, "rValue", naAllowed = FALSE, noDefaultAvailable = TRUE) if (activeArms == 1) { warning("'typeOfSelection' (\"", typeOfSelection, "\") will be ignored because 'activeArms' = 1", call. = FALSE) } else if (rValue > activeArms) { warning("'rValue' (", rValue, ") is larger than activeArms (", activeArms, ") and will be ignored", call. = FALSE) } } else if (!is.na(rValue)) { warning("'rValue' (", rValue, ") will be ignored because 'typeOfSelection' != \"rBest\"", call. = FALSE) } if (typeOfSelection == "epsilon") { .assertIsSingleNumber(epsilonValue, "epsilonValue", naAllowed = FALSE, noDefaultAvailable = TRUE) .assertIsInClosedInterval(epsilonValue, "epsilonValue", lower = 0, upper = NULL, naAllowed = TRUE) } else if (!is.na(epsilonValue)) { warning("'epsilonValue' (", epsilonValue, ") will be ignored because 'typeOfSelection' != \"epsilon\"", call. = FALSE) } return(typeOfSelection) } .assertIsValidSuccessCriterion <- function(successCriterion) { .assertIsCharacter(successCriterion, "successCriterion") successCriterion <- successCriterion[1] if (!(successCriterion %in% C_SUCCESS_CRITERIONS)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'successCriterion' (", successCriterion, ") must be one of ", .arrayToString(C_SUCCESS_CRITERIONS, encapsulate = TRUE)) } return(successCriterion) } .assertIsValidEffectMeasure <- function(effectMeasure) { .assertIsCharacter(effectMeasure, "effectMeasure") effectMeasure <- effectMeasure[1] if (!(effectMeasure %in% C_EFFECT_MEASURES)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'effectMeasure' (", effectMeasure, ") must be one of ", .arrayToString(C_EFFECT_MEASURES, encapsulate = TRUE)) } return(effectMeasure) } .assertIsValidMatrix <- function(x, argumentName, ..., expectedNumberOfColumns = NA_integer_, naAllowed = FALSE, returnSingleValueAsMatrix = FALSE) { if (missing(x) || is.null(x) || length(x) == 0) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'", argumentName, "' must be a valid matrix") } if (returnSingleValueAsMatrix && !is.matrix(x) && (is.numeric(x) || is.character(x) || is.logical(x))) { if (length(x) == 1) { x <- matrix(x) } else if (length(x) > 1 && !is.na(expectedNumberOfColumns)) { if (length(x) %% expectedNumberOfColumns != 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the length of '", argumentName, "' (", .arrayToString(x), ") must be a divisor or a multiple ", expectedNumberOfColumns) } x <- matrix(x, ncol = expectedNumberOfColumns) } } if (!is.matrix(x)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", class(x), ") must be a valid matrix") } if (!naAllowed && any(is.na(x))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", .arrayToString(x), ") must not contain NA's") } if (!is.numeric(x)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", .arrayToString(x), ") must be a valid numeric matrix") } if (!is.na(expectedNumberOfColumns) && ncol(x) != expectedNumberOfColumns) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", .arrayToString(x), ") must be a numeric matrix with ", expectedNumberOfColumns, " columns") } return(invisible(x)) } .assertIsValidTypeOfShape <- function(typeOfShape) { .assertIsCharacter(typeOfShape, "typeOfShape") typeOfShape <- typeOfShape[1] if (!(typeOfShape %in% C_TYPES_OF_SHAPE)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'typeOfShape' (", typeOfShape, ") must be one of ", .arrayToString(C_TYPES_OF_SHAPE, encapsulate = TRUE)) } return(typeOfShape) } .assertIsValidEffectMatrixMeans <- function(typeOfShape, effectMatrix, muMaxVector, gED50, gMax, slope) { if (typeOfShape == "userDefined") { effectMatrix <- .assertIsValidMatrix(effectMatrix, "effectMatrix", expectedNumberOfColumns = gMax, naAllowed = FALSE, returnSingleValueAsMatrix = TRUE) .assertIsNumericVector(muMaxVector, "muMaxVector", naAllowed = TRUE) if (!all(is.na(muMaxVector)) && !identical(muMaxVector, C_ALTERNATIVE_POWER_SIMULATION_DEFAULT)) { warning("'muMaxVector' (", .arrayToString(muMaxVector), ") will be ignored because it will be set to first column of 'effectMatrix'", call. = FALSE) } } else if (!is.null(effectMatrix)) { warning("'effectMatrix' will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE) } if (typeOfShape == "sigmoidEmax") { .assertIsNumericVector(muMaxVector, "muMaxVector", naAllowed = FALSE, noDefaultAvailable = TRUE) .assertIsSingleNumber(gED50, "gED50", naAllowed = FALSE, noDefaultAvailable = TRUE) effectMatrix <- matrix(muMaxVector, nrow = length(muMaxVector), ncol = 1) %*% matrix((1:gMax)^slope / (gED50^slope + (1:gMax)^slope), nrow = 1, ncol = gMax) return(effectMatrix) } if (!is.null(gED50) && !is.na(gED50)) { warning("'gED50' (", gED50, ") will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE) } if (typeOfShape == "linear") { .assertIsNumericVector(muMaxVector, "muMaxVector", naAllowed = FALSE, noDefaultAvailable = TRUE) effectMatrix <- matrix(muMaxVector, nrow = length(muMaxVector), ncol = 1) %*% matrix((1:gMax) / gMax, nrow = 1, ncol = gMax) } if (!is.null(slope) && !is.na(slope) && slope != 1) { warning("'slope' (", slope, ") will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE) } return(effectMatrix) } .assertIsValidEffectMatrixRates <- function(typeOfShape, effectMatrix, piMaxVector, piControl, gED50, gMax, slope) { if (typeOfShape == "userDefined") { effectMatrix <- .assertIsValidMatrix(effectMatrix, "effectMatrix", expectedNumberOfColumns = gMax, naAllowed = FALSE, returnSingleValueAsMatrix = TRUE) .assertIsInOpenInterval(effectMatrix, "effectMatrix", 0, 1, naAllowed = FALSE) .assertIsNumericVector(piMaxVector, "piMaxVector", naAllowed = TRUE) if (!all(is.na(piMaxVector)) && !identical(piMaxVector, C_PI_1_DEFAULT)) { warning("'piMaxVector' (", .arrayToString(piMaxVector), ") will be ignored because it will be set to first column of 'effectMatrix'", call. = FALSE) } } else if (!is.null(effectMatrix)) { warning("'effectMatrix' will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE) } if (typeOfShape == "sigmoidEmax") { .assertIsNumericVector(piMaxVector, "piMaxVector", naAllowed = FALSE, noDefaultAvailable = TRUE) .assertIsInOpenInterval(piMaxVector, "piMaxVector", 0, 1, naAllowed = FALSE) .assertIsSingleNumber(gED50, "gED50", naAllowed = FALSE, noDefaultAvailable = TRUE) effectMatrix <- matrix(piMaxVector, nrow = length(piMaxVector), ncol = 1) %*% matrix((1:gMax)^slope / (gED50^slope + (1:gMax)^slope), nrow = 1, ncol = gMax) return(effectMatrix) } if (!is.null(gED50) && !is.na(gED50)) { warning("'gED50' (", gED50, ") will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE) } if (typeOfShape == "linear") { .assertIsNumericVector(piMaxVector, "piMaxVector", naAllowed = FALSE, noDefaultAvailable = TRUE) .assertIsInOpenInterval(piMaxVector, "piMaxVector", 0, 1, naAllowed = FALSE) .assertIsSingleNumber(piControl, "piControl", naAllowed = FALSE, noDefaultAvailable = TRUE) .assertIsInOpenInterval(piControl, "piControl", 0, 1, naAllowed = FALSE) effectMatrix <- piControl + matrix(piMaxVector - piControl, nrow = length(piMaxVector), ncol = 1) %*% matrix((1:gMax) / gMax, nrow = 1, ncol = gMax) } if (!is.null(slope) && !is.na(slope) && slope != 1) { warning("'slope' (", slope, ") will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE) } return(effectMatrix) } .assertIsValidEffectMatrixSurvival <- function(typeOfShape, effectMatrix, omegaMaxVector, gED50, gMax, slope) { if (typeOfShape == "userDefined") { effectMatrix <- .assertIsValidMatrix(effectMatrix, "effectMatrix", expectedNumberOfColumns = gMax, naAllowed = FALSE, returnSingleValueAsMatrix = TRUE) .assertIsInOpenInterval(effectMatrix, "effectMatrix", 0, NULL, naAllowed = FALSE) .assertIsNumericVector(omegaMaxVector, "omegaMaxVector", naAllowed = TRUE) if (!all(is.na(omegaMaxVector)) && !identical(omegaMaxVector, C_RANGE_OF_HAZARD_RATIOS_DEFAULT)) { warning("'omegaMaxVector' (", .arrayToString(omegaMaxVector), ") will be ignored because it will be set to first column of 'effectMatrix'", call. = FALSE) } } else if (!is.null(effectMatrix)) { warning("'effectMatrix' will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE) } if (typeOfShape == "sigmoidEmax") { .assertIsNumericVector(omegaMaxVector, "omegaMaxVector", naAllowed = FALSE, noDefaultAvailable = TRUE) .assertIsInOpenInterval(omegaMaxVector, "omegaMaxVector", 0, NULL, naAllowed = FALSE) .assertIsSingleNumber(gED50, "gED50", naAllowed = FALSE, noDefaultAvailable = TRUE) effectMatrix <- matrix(omegaMaxVector - 1, nrow = length(omegaMaxVector), ncol = 1) %*% matrix((1:gMax)^slope / (gED50^slope + (1:gMax)^slope), nrow = 1, ncol = gMax) + 1 return(effectMatrix) } if (!is.null(gED50) && !is.na(gED50)) { warning("'gED50' (", gED50, ") will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE) } if (typeOfShape == "linear") { .assertIsNumericVector(omegaMaxVector, "omegaMaxVector", naAllowed = FALSE, noDefaultAvailable = TRUE) .assertIsInOpenInterval(omegaMaxVector, "omegaMaxVector", 0, NULL, naAllowed = FALSE) effectMatrix <- matrix(omegaMaxVector - 1, nrow = length(omegaMaxVector), ncol = 1) %*% matrix((1:gMax) / gMax, nrow = 1, ncol = gMax) + 1 } if (!is.null(slope) && !is.na(slope) && slope != 1) { warning("'slope' (", slope, ") will be ignored because 'typeOfShape' is defined as '", typeOfShape, "'", call. = FALSE) } return(effectMatrix) } .assertIsValidPlannedSubjects <- function(plannedSubjects, kMax) { .assertIsIntegerVector(plannedSubjects, "plannedSubjects", validateType = FALSE) if (length(plannedSubjects) != kMax) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'plannedSubjects' (", .arrayToString(plannedSubjects), ") must have length 'kMax' (", kMax, ")") } .assertIsInClosedInterval(plannedSubjects, "plannedSubjects", lower = 1, upper = NULL) .assertValuesAreStrictlyIncreasing(plannedSubjects, "plannedSubjects") } .isAlphaSpendingDesign <- function(design) { if (!.isTrialDesignInverseNormalOrGroupSequential(design)) { return(FALSE) } return(grepl("^as", design$typeOfDesign)) } rpact/R/f_design_utilities.R0000644000175000017500000010472114152117501015714 0ustar nileshnilesh## | ## | *Design utilities* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5611 $ ## | Last changed: $Date: 2021-12-02 11:26:05 +0100 (Do, 02 Dez 2021) $ ## | Last changed by: $Author: pahlke $ ## | #' @include f_core_assertions.R NULL .getDefaultDesign <- function(..., type = c("sampleSize", "power", "simulation", "analysis"), ignore = c()) { type <- match.arg(type) alpha <- .getOptionalArgument("alpha", ...) if (is.null(alpha)) { alpha <- NA_real_ } else { ignore <- c(ignore, "alpha") } beta <- .getOptionalArgument("beta", ...) if (is.null(beta)) { beta <- NA_real_ } else { ignore <- c(ignore, "beta") } sided <- .getOptionalArgument("sided", ...) if (is.null(sided)) { sided <- 1L } else { ignore <- c(ignore, "sided") } twoSidedPower <- .getOptionalArgument("twoSidedPower", ...) if (is.null(twoSidedPower)) { if (type %in% c("power", "simulation") && sided == 2) { twoSidedPower <- TRUE } else { twoSidedPower <- C_TWO_SIDED_POWER_DEFAULT } } else { ignore <- c(ignore, "twoSidedPower") } if (type %in% c("analysis", "simulation")) { design <- getDesignInverseNormal(kMax = 1, alpha = alpha, beta = beta, sided = sided, twoSidedPower = twoSidedPower) } else { design <- getDesignGroupSequential(kMax = 1, alpha = alpha, beta = beta, sided = sided, twoSidedPower = twoSidedPower) } return(design) } .getDesignArgumentsToIgnoreAtUnknownArgumentCheck <- function(design, powerCalculationEnabled = FALSE) { baseArgsToIgnore <- c("showObservedInformationRatesMessage") if (design$kMax > 1) { return(baseArgsToIgnore) } if (powerCalculationEnabled) { return(c(baseArgsToIgnore, "alpha", "sided")) } return(c(baseArgsToIgnore, "alpha", "beta", "sided", "twoSidedPower")) } .getValidatedFutilityBounds <- function(design, kMaxLowerBound = 1, writeToDesign = TRUE, twoSidedWarningForDefaultValues = TRUE) { .assertIsTrialDesignInverseNormalOrGroupSequential(design) return(.getValidatedFutilityBoundsOrAlpha0Vec(design = design, parameterName = "futilityBounds", defaultValue = C_FUTILITY_BOUNDS_DEFAULT, kMaxLowerBound = kMaxLowerBound, writeToDesign = writeToDesign, twoSidedWarningForDefaultValues = twoSidedWarningForDefaultValues)) } .getValidatedAlpha0Vec <- function(design, kMaxLowerBound = 1, writeToDesign = TRUE, twoSidedWarningForDefaultValues = TRUE) { .assertIsTrialDesignFisher(design) return(.getValidatedFutilityBoundsOrAlpha0Vec(design = design, parameterName = "alpha0Vec", defaultValue = C_ALPHA_0_VEC_DEFAULT, kMaxLowerBound = kMaxLowerBound, writeToDesign = writeToDesign, twoSidedWarningForDefaultValues = twoSidedWarningForDefaultValues)) } .getValidatedFutilityBoundsOrAlpha0Vec <- function(design, parameterName, defaultValue, kMaxLowerBound, writeToDesign, twoSidedWarningForDefaultValues = TRUE) { parameterValues <- design[[parameterName]] if (length(parameterValues) > 1) { .assertIsNumericVector(parameterValues, parameterName, naAllowed = TRUE) } kMaxUpperBound <- ifelse(.isTrialDesignFisher(design), C_KMAX_UPPER_BOUND_FISHER, C_KMAX_UPPER_BOUND) if (.isDefinedArgument(parameterValues) && .isDefinedArgument(design$kMax)) { if (.isTrialDesignFisher(design)) { .assertIsValidAlpha0Vec(parameterValues, kMax = design$kMax, kMaxLowerBound = kMaxLowerBound, kMaxUpperBound = kMaxUpperBound) } else { .assertAreValidFutilityBounds(parameterValues, kMax = design$kMax, kMaxLowerBound = kMaxLowerBound, kMaxUpperBound = kMaxUpperBound) } } if (design$sided == 2 && .isDefinedArgument(parameterValues) && (!.isTrialDesignInverseNormalOrGroupSequential(design) || design$typeOfDesign != C_TYPE_OF_DESIGN_PT) && (twoSidedWarningForDefaultValues && !all(is.na(parameterValues)) || (!twoSidedWarningForDefaultValues && any(na.omit(parameterValues) != defaultValue)))) { warning("'", parameterName, "' (", .arrayToString(parameterValues), ") will be ignored because the design is two-sided", call. = FALSE) parameterValues <- rep(defaultValue, design$kMax - 1) } if (writeToDesign) { .setParameterType(design, parameterName, C_PARAM_USER_DEFINED) } if (.isUndefinedArgument(design$informationRates) && .isUndefinedArgument(parameterValues)) { if (writeToDesign) { if (.setKMaxToDefaultIfUndefined(design, writeToDesign) || design$kMax == C_KMAX_DEFAULT) { .setParameterType(design, parameterName, C_PARAM_DEFAULT_VALUE) } else { .setParameterType(design, parameterName, C_PARAM_DERIVED) } } return(rep(defaultValue, design$kMax - 1)) } if (.isDefinedArgument(design$informationRates) && .isUndefinedArgument(parameterValues)) { if (writeToDesign) { if (.isUndefinedArgument(design$kMax)) { .setKMax(design, kMax = length(design$informationRates)) } .setParameterType(design, parameterName, ifelse(design$kMax == C_KMAX_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_DERIVED)) } return(rep(defaultValue, design$kMax - 1)) } if (.isUndefinedArgument(design$informationRates) && .isDefinedArgument(parameterValues, argumentExistsValidationEnabled = FALSE)) { if (writeToDesign) { .setKMax(design, kMax = length(parameterValues) + 1) if (.isDefaultVector(parameterValues, rep(defaultValue, design$kMax - 1))) { .setParameterType(design, parameterName, C_PARAM_DEFAULT_VALUE) } } if (.isBetaSpendingOrPampallonaTsiatisDesignWithDefinedFutilityBounds(design, parameterName, writeToDesign)) { return(rep(defaultValue, design$kMax - 1)) } return(parameterValues) } if (writeToDesign) { .setKMax(design, kMax = length(parameterValues) + 1) if (.isDefaultVector(parameterValues, rep(defaultValue, design$kMax - 1))) { .setParameterType(design, parameterName, C_PARAM_DEFAULT_VALUE) } } if (.isTrialDesignFisher(design)) { .assertIsValidAlpha0Vec(parameterValues, kMax = design$kMax, kMaxLowerBound = kMaxLowerBound, kMaxUpperBound = kMaxUpperBound) } else { .assertAreValidFutilityBounds(parameterValues, kMax = design$kMax, kMaxLowerBound = kMaxLowerBound, kMaxUpperBound = kMaxUpperBound) } if (.isBetaSpendingOrPampallonaTsiatisDesignWithDefinedFutilityBounds(design, parameterName, writeToDesign)) { return(rep(defaultValue, design$kMax - 1)) } return(parameterValues) } # Check whether design is a beta spending or Pampallona Tsiatis design .isBetaSpendingOrPampallonaTsiatisDesignWithDefinedFutilityBounds <- function(design, parameterName, writeToDesign) { if (.isTrialDesignFisher(design)) { return(FALSE) } if (!.isBetaSpendingDesignType(design$typeBetaSpending) && design$typeOfDesign != C_TYPE_OF_DESIGN_PT) { return(FALSE) } if (design$.getParameterType(parameterName) == C_PARAM_USER_DEFINED) { warning("'", parameterName, "' (", .arrayToString(design[[parameterName]]), ") will be ignored because it will be calculated", call. = FALSE) } else if (design$.getParameterType(parameterName) == C_PARAM_GENERATED) { return(FALSE) } if (writeToDesign) { .setParameterType(design, parameterName, C_PARAM_DEFAULT_VALUE) } return(TRUE) } .setKMax <- function(design, kMax) { design$kMax <- as.integer(kMax) .setParameterType(design, "kMax", C_PARAM_DERIVED) invisible(kMax) } .getValidatedInformationRates <- function(design, kMaxLowerBound = 1, writeToDesign = TRUE) { kMaxUpperBound <- ifelse(.isTrialDesignFisher(design), C_KMAX_UPPER_BOUND_FISHER, C_KMAX_UPPER_BOUND) if (.isDefinedArgument(design$informationRates) && .isDefinedArgument(design$kMax)) { .assertAreValidInformationRates(informationRates = design$informationRates, kMax = design$kMax, kMaxLowerBound = kMaxLowerBound, kMaxUpperBound = kMaxUpperBound) } .setParameterType(design, "informationRates", C_PARAM_USER_DEFINED) if (.isTrialDesignFisher(design)) { futilityBounds <- design$alpha0Vec } else { futilityBounds <- design$futilityBounds } if (.isUndefinedArgument(design$informationRates) && .isUndefinedArgument(futilityBounds)) { if (writeToDesign) { if (.setKMaxToDefaultIfUndefined(design, writeToDesign) || design$kMax == C_KMAX_DEFAULT) { .setParameterType(design, "informationRates", C_PARAM_DEFAULT_VALUE) } else { .setParameterType(design, "informationRates", C_PARAM_DERIVED) } } return((1:design$kMax) / design$kMax) } if (.isDefinedArgument(design$informationRates) && .isUndefinedArgument(futilityBounds)) { if (writeToDesign) { .setKMax(design, kMax = length(design$informationRates)) if (.isDefaultVector(design$informationRates, (1:design$kMax) / design$kMax)) { .setParameterType(design, "informationRates", C_PARAM_DEFAULT_VALUE) } } .assertAreValidInformationRates(informationRates = design$informationRates, kMax = design$kMax, kMaxLowerBound = kMaxLowerBound, kMaxUpperBound = kMaxUpperBound) return(design$informationRates) } if (.isUndefinedArgument(design$informationRates) && .isDefinedArgument(futilityBounds, argumentExistsValidationEnabled = FALSE)) { if (writeToDesign) { if (.isUndefinedArgument(design$kMax)) { .setKMax(design, kMax = length(futilityBounds) + 1) } .setParameterType(design, "informationRates", ifelse(design$kMax == C_KMAX_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_DERIVED)) } return((1:design$kMax) / design$kMax) } if (writeToDesign) { .setKMax(design, kMax = length(design$informationRates)) if (.isDefaultVector(design$informationRates, (1:design$kMax) / design$kMax)) { .setParameterType(design, "informationRates", C_PARAM_DEFAULT_VALUE) } } .assertAreValidInformationRates(informationRates = design$informationRates, kMax = design$kMax, kMaxLowerBound = kMaxLowerBound, kMaxUpperBound = kMaxUpperBound) return(design$informationRates) } .setKMaxToDefaultIfUndefined <- function(design, writeToDesign = TRUE) { if (writeToDesign && .isUndefinedArgument(design$kMax)) { design$kMax <- C_KMAX_DEFAULT design$.setParameterType("kMax", C_PARAM_DEFAULT_VALUE) return(TRUE) } return(FALSE) } .validateAlphaAndBeta <- function(design) { .assertDesignParameterExists(design, "alpha", C_ALPHA_DEFAULT) .assertDesignParameterExists(design, "beta", C_BETA_DEFAULT) .assertIsValidAlphaAndBeta(alpha = design$alpha, beta = design$beta) } .validateUserAlphaSpending <- function(design) { .assertIsTrialDesign(design) .assertDesignParameterExists(design, "userAlphaSpending", NA_real_) if ((design$isUserDefinedParameter("informationRates") || (design$isDefaultParameter("informationRates") && !design$isUserDefinedParameter("kMax"))) && length(design$informationRates) != length(design$userAlphaSpending)) { stop(sprintf(paste0(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "length of 'userAlphaSpending' (%s) must be equal to length of 'informationRates' (%s)"), length(design$userAlphaSpending), length(design$informationRates))) } if (length(design$userAlphaSpending) != design$kMax) { stop(sprintf(paste0(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "length of 'userAlphaSpending' (%s) must be equal to 'kMax' (%s)"), length(design$userAlphaSpending), design$kMax)) } .validateUserAlphaSpendingLength(design) if (.isUndefinedArgument(design$alpha)) { design$alpha <- design$userAlphaSpending[design$kMax] design$.setParameterType("alpha", ifelse(design$alpha == C_ALPHA_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_DERIVED)) } .assertIsValidAlpha(design$alpha) if (design$kMax > 1 && (design$userAlphaSpending[1] < 0 || design$userAlphaSpending[design$kMax] > design$alpha || any(design$userAlphaSpending[2:design$kMax] - design$userAlphaSpending[1:(design$kMax - 1)] < 0))) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'userAlphaSpending' = %s must be a vector that satisfies the following condition: ", "0 <= alpha_1 <= .. <= alpha_%s <= alpha = %s"), .arrayToString(design$userAlphaSpending, vectorLookAndFeelEnabled = TRUE), design$kMax, design$alpha)) } } .validateUserBetaSpending <- function(design) { .assertIsTrialDesign(design) .assertDesignParameterExists(design, "userBetaSpending", NA_real_) if ((design$isUserDefinedParameter("informationRates") || (design$isDefaultParameter("informationRates") && !design$isUserDefinedParameter("kMax"))) && length(design$informationRates) != length(design$userBetaSpending)) { stop(sprintf(paste0(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "length of 'userBetaSpending' (%s) must be equal to length of 'informationRates' (%s)"), length(design$userBetaSpending), length(design$informationRates))) } if (length(design$userBetaSpending) != design$kMax) { stop(sprintf(paste0(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "length of 'userBetaSpending' (%s) must be equal to 'kMax' (%s)"), length(design$userBetaSpending), design$kMax)) } if (length(design$userBetaSpending) < 2 || length(design$userBetaSpending) > C_KMAX_UPPER_BOUND) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ARGUMENT_LENGTH_OUT_OF_BOUNDS, "length of 'userBetaSpending' (%s) is out of bounds [2; %s]"), length(design$userBetaSpending), C_KMAX_UPPER_BOUND)) } if (.isUndefinedArgument(design$beta)) { design$beta <- design$userBetaSpending[design$kMax] design$.setParameterType("beta", ifelse(design$beta == C_BETA_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_DERIVED)) } .assertIsValidBeta(beta = design$beta, alpha = design$alpha) if (design$kMax > 1 && (design$userBetaSpending[1] < 0 || design$userBetaSpending[design$kMax] > design$beta || any(design$userBetaSpending[2:design$kMax] - design$userBetaSpending[1:(design$kMax - 1)] < 0))) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'userBetaSpending' = %s must be a vector that satisfies the following condition: ", "0 <= beta_1 <= .. <= beta_%s <= beta = %s"), .arrayToString(design$userBetaSpending, vectorLookAndFeelEnabled = TRUE), design$kMax, design$beta)) } } .validateUserAlphaSpendingLength <- function(design) { if (length(design$userAlphaSpending) < 1 || length(design$userAlphaSpending) > C_KMAX_UPPER_BOUND) { stop(sprintf(paste0(C_EXCEPTION_TYPE_ARGUMENT_LENGTH_OUT_OF_BOUNDS, "length of 'userAlphaSpending' (%s) is out of bounds [1; %s]"), length(design$userAlphaSpending), C_KMAX_UPPER_BOUND)) } } .setKmaxBasedOnAlphaSpendingDefintion <- function(design) { if (.isTrialDesignFisher(design)) { if (design$method != C_FISHER_METHOD_USER_DEFINED_ALPHA) { return(invisible()) } } else { if (design$typeOfDesign != C_TYPE_OF_DESIGN_AS_USER) { return(invisible()) } } if (.isDefinedArgument(design$kMax)) { return(invisible()) } if (.isUndefinedArgument(design$userAlphaSpending)) { return(invisible()) } if (.isDefinedArgument(design$informationRates)) { return(invisible()) } if (.isTrialDesignFisher(design)) { if (.isDefinedArgument(design$alpha0Vec)) { return(invisible()) } } else { if (.isDefinedArgument(design$futilityBounds)) { return(invisible()) } } .validateUserAlphaSpendingLength(design) .setKMax(design, kMax = length(design$userAlphaSpending)) } # This function generates the piecewise exponential survival function or (if kappa != 1) a Weibull cdf .getPiecewiseExponentialDistributionSingleTime <- function( time, piecewiseLambda, piecewiseSurvivalTime = NA_real_, kappa) { if (length(piecewiseLambda) == 1) { if (kappa <= 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'kappa' (", kappa, ") must be > 0") } return(pweibull(time, kappa, scale = 1 / piecewiseLambda, lower.tail = TRUE, log.p = FALSE)) } if (length(piecewiseSurvivalTime) != length(piecewiseLambda)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "length of 'piecewiseSurvivalTime' (", .arrayToString(piecewiseSurvivalTime), ") must be equal to length of 'piecewiseLambda' (", .arrayToString(piecewiseLambda), ")") } piecewiseSurvivalTime <- .getPiecewiseExpStartTimesWithoutLeadingZero(piecewiseSurvivalTime) if (kappa != 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "Weibull distribution cannot be used for piecewise survival definition") } len <- length(piecewiseSurvivalTime) for (i in 1:len) { if (time <= piecewiseSurvivalTime[i]) { if (i == 1) { return(1 - exp(-(piecewiseLambda[1] * time))) } y <- piecewiseLambda[1] * piecewiseSurvivalTime[1] if (i > 2) { y <- y + sum(piecewiseLambda[2:(i - 1)] * (piecewiseSurvivalTime[2:(i - 1)] - piecewiseSurvivalTime[1:(i - 2)])) } y <- y + piecewiseLambda[i] * (time - piecewiseSurvivalTime[i - 1]) return(1 - exp(-y)) } } if (len == 1) { y <- piecewiseLambda[1] * piecewiseSurvivalTime[1] + piecewiseLambda[len + 1] * (time - piecewiseSurvivalTime[len]) } else { y <- piecewiseLambda[1] * piecewiseSurvivalTime[1] + sum(piecewiseLambda[2:len] * (piecewiseSurvivalTime[2:len] - piecewiseSurvivalTime[1:(len - 1)])) + piecewiseLambda[len + 1] * (time - piecewiseSurvivalTime[len]) } return(1 - exp(-y)) } .getPiecewiseExponentialSingleQuantile <- function( quantile, piecewiseLambda, piecewiseSurvivalTime, kappa) { if (length(piecewiseLambda) == 1) { if (kappa <= 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "kappa needs to a positive number") } return((-log(1 - quantile))^(1 / kappa) / piecewiseLambda[1]) } if (kappa != 1) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "Weibull distribution cannot be used for piecewise survival definition") } cdfValues <- .getPiecewiseExponentialDistribution(piecewiseSurvivalTime, piecewiseSurvivalTime = piecewiseSurvivalTime, piecewiseLambda = piecewiseLambda, kappa = 1) cdfValues <- cdfValues[2:length(cdfValues)] # use values without a leading 0 piecewiseSurvivalTime <- .getPiecewiseExpStartTimesWithoutLeadingZero(piecewiseSurvivalTime) len <- length(piecewiseSurvivalTime) for (i in 1:len) { if (quantile <= cdfValues[i]) { if (i == 1) { return(-log(1 - quantile) / piecewiseLambda[1]) } y <- piecewiseLambda[1] * piecewiseSurvivalTime[1] if (i > 2) { y <- y + sum(piecewiseLambda[2:(i - 1)] * (piecewiseSurvivalTime[2:(i - 1)] - piecewiseSurvivalTime[1:(i - 2)])) } return(piecewiseSurvivalTime[i - 1] - (log(1 - quantile) + y) / piecewiseLambda[i]) } } if (len == 1) { return(piecewiseSurvivalTime[1] - (log(1 - quantile) + piecewiseLambda[1] * piecewiseSurvivalTime[1]) / piecewiseLambda[2]) } y <- piecewiseLambda[1] * piecewiseSurvivalTime[1] + sum(piecewiseLambda[2:len] * (piecewiseSurvivalTime[2:len] - piecewiseSurvivalTime[1:(len - 1)])) return(piecewiseSurvivalTime[len] - (log(1 - quantile) + y) / piecewiseLambda[len + 1]) } .getPiecewiseExponentialDistribution <- function(time, piecewiseLambda, piecewiseSurvivalTime, kappa) { if (length(time) == 1 && length(piecewiseSurvivalTime) == 1 && identical(time, piecewiseSurvivalTime) && length(piecewiseLambda) > 1) { result <- c() for (lambda in piecewiseLambda) { result <- c(result, .getPiecewiseExponentialDistributionSingleTime( time, lambda, piecewiseSurvivalTime, kappa)) } return(result) } result <- c() for (timeValue in time) { result <- c(result, .getPiecewiseExponentialDistributionSingleTime( timeValue, piecewiseLambda, piecewiseSurvivalTime, kappa)) } return(result) } .getPiecewiseExponentialSettings <- function(..., piecewiseSurvivalTime = NA_real_, piecewiseLambda = NA_real_, kappa = 1) { if (!all(is.na(piecewiseLambda)) && is.list(piecewiseSurvivalTime)) { stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "'piecewiseSurvivalTime' needs to be a numeric vector and not a list ", "because 'piecewiseLambda' (", piecewiseLambda, ") is defined separately") } if (any(is.na(piecewiseSurvivalTime))) { .assertIsSingleNumber(kappa, "kappa") } if (length(piecewiseLambda) == 1 && !is.na(piecewiseLambda) && length(piecewiseSurvivalTime) > 0 && !all(is.na(piecewiseSurvivalTime))) { warning("Argument 'piecewiseSurvivalTime' will be ignored because ", "length of 'piecewiseLambda' is 1", call. = FALSE) } setting <- PiecewiseSurvivalTime( piecewiseSurvivalTime = piecewiseSurvivalTime, lambda2 = piecewiseLambda, hazardRatio = 1, kappa = kappa, delayedResponseAllowed = FALSE) return(list(piecewiseSurvivalTime = setting$piecewiseSurvivalTime, piecewiseLambda = setting$lambda2)) } #' #' @title #' The Piecewise Exponential Distribution #' #' @description #' Distribution function, quantile function and random number generation for the #' piecewise exponential distribution. #' #' @param t,time Vector of time values. #' @param q,quantile Vector of quantiles. #' @param n Number of observations. #' @param s,piecewiseSurvivalTime Vector of start times defining the "time pieces". #' @param lambda,piecewiseLambda Vector of lambda values (hazard rates) corresponding to the start times. #' @inheritParams param_kappa #' @inheritParams param_three_dots #' #' @details #' \code{getPiecewiseExponentialDistribution} (short: \code{ppwexp}), #' \code{getPiecewiseExponentialQuantile} (short: \code{qpwexp}), and #' \code{getPiecewiseExponentialRandomNumbers} (short: \code{rpwexp}) provide #' probabilities, quantiles, and random numbers according to a piecewise #' exponential or a Weibull distribution. #' The piecewise definition is performed through a vector of #' starting times (\code{piecewiseSurvivalTime}) and a vector of hazard rates (\code{piecewiseLambda}). #' You can also use a list that defines the starting times and piecewise #' lambdas together and define piecewiseSurvivalTime as this list. #' The list needs to have the form, e.g., #' piecewiseSurvivalTime <- list( #' "0 - <6" = 0.025, #' "6 - <9" = 0.04, #' "9 - <15" = 0.015, #' ">=15" = 0.007) . #' For the Weibull case, you can also specify a shape parameter kappa in order to #' calculate probabilities, quantiles, or random numbers. #' In this case, no piecewise definition is possible, i.e., only piecewiseLambda #' (as a single value) and kappa need to be specified. #' #' @return A \code{\link[base]{numeric}} value or vector will be returned. #' #' @examples #' # Calculate probabilties for a range of time values for a #' # piecewise exponential distribution with hazard rates #' # 0.025, 0.04, 0.015, and 0.007 in the intervals #' # [0, 6), [6, 9), [9, 15), [15, Inf), respectively, #' # and re-return the time values: #' piecewiseSurvivalTime <- list( #' "0 - <6" = 0.025, #' "6 - <9" = 0.04, #' "9 - <15" = 0.015, #' ">=15" = 0.01) #' y <- getPiecewiseExponentialDistribution(seq(0, 150, 15), #' piecewiseSurvivalTime = piecewiseSurvivalTime) #' getPiecewiseExponentialQuantile(y, #' piecewiseSurvivalTime = piecewiseSurvivalTime) #' #' @name utilitiesForPiecewiseExponentialDistribution #' NULL #' @rdname utilitiesForPiecewiseExponentialDistribution #' @export getPiecewiseExponentialDistribution <- function(time, ..., piecewiseSurvivalTime = NA_real_, piecewiseLambda = NA_real_, kappa = 1) { .warnInCaseOfUnknownArguments(functionName = "getPiecewiseExponentialDistribution", ...) .assertIsNumericVector(time, "time") if (any(time < 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "time needs to be a non-negative number") } settings <- .getPiecewiseExponentialSettings(piecewiseSurvivalTime = piecewiseSurvivalTime, piecewiseLambda = piecewiseLambda, kappa = kappa) return(.getPiecewiseExponentialDistribution(time = time, piecewiseSurvivalTime = settings$piecewiseSurvivalTime, piecewiseLambda = settings$piecewiseLambda, kappa = kappa)) } #' @rdname utilitiesForPiecewiseExponentialDistribution #' @export ppwexp <- function(t, ..., s = NA_real_, lambda = NA_real_, kappa = 1) { getPiecewiseExponentialDistribution(time = t, piecewiseSurvivalTime = s, piecewiseLambda = lambda, kappa = kappa, ...) } #' @rdname utilitiesForPiecewiseExponentialDistribution #' @export getPiecewiseExponentialQuantile <- function(quantile, ..., piecewiseSurvivalTime = NA_real_, piecewiseLambda = NA_real_, kappa = 1) { .warnInCaseOfUnknownArguments(functionName = "getPiecewiseExponentialQuantile", ...) .assertIsNumericVector(quantile, "quantile") if (any(quantile < 0) || any(quantile > 1)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "quantile needs to be within [0; 1]") } settings <- .getPiecewiseExponentialSettings(piecewiseSurvivalTime = piecewiseSurvivalTime, piecewiseLambda = piecewiseLambda, kappa = kappa) result <- c() for (quantileValue in quantile) { result <- c(result, .getPiecewiseExponentialSingleQuantile(quantileValue, piecewiseSurvivalTime = settings$piecewiseSurvivalTime, piecewiseLambda = settings$piecewiseLambda, kappa)) } return(result) } #' @rdname utilitiesForPiecewiseExponentialDistribution #' @export qpwexp <- function(q, ..., s = NA_real_, lambda = NA_real_, kappa = 1) { getPiecewiseExponentialQuantile(quantile = q, piecewiseSurvivalTime = s, piecewiseLambda = lambda, kappa = kappa, ...) } .getPiecewiseExponentialRandomNumbersFast <- function(n, piecewiseSurvivalTime, piecewiseLambda) { result <- rexp(n, rate = piecewiseLambda[1]) if (length(piecewiseSurvivalTime) > 1) { for (i in 2:length(piecewiseSurvivalTime)) { result <- ifelse(result < piecewiseSurvivalTime[i], result, piecewiseSurvivalTime[i] + rexp(n, rate = piecewiseLambda[i])) } } result } #' @rdname utilitiesForPiecewiseExponentialDistribution #' @export getPiecewiseExponentialRandomNumbers <- function(n, ..., piecewiseSurvivalTime = NA_real_, piecewiseLambda = NA_real_, kappa = 1) { .warnInCaseOfUnknownArguments(functionName = "getPiecewiseExponentialRandomNumbers", ...) .assertIsSingleInteger(n, "n", validateType = FALSE) .assertIsInClosedInterval(n, "n", lower = 1, upper = NULL) settings <- .getPiecewiseExponentialSettings(piecewiseSurvivalTime = piecewiseSurvivalTime, piecewiseLambda = piecewiseLambda, kappa = kappa) if (kappa == 1) { return(.getPiecewiseExponentialRandomNumbersFast(n, piecewiseSurvivalTime = settings$piecewiseSurvivalTime, piecewiseLambda = settings$piecewiseLambda)) } randomQuantiles <- runif(n, 0, 1) result <- c() for (quantile in randomQuantiles) { result <- c(result, .getPiecewiseExponentialSingleQuantile(quantile, piecewiseSurvivalTime = settings$piecewiseSurvivalTime, piecewiseLambda = settings$piecewiseLambda, kappa = kappa)) } return(result) } #' @rdname utilitiesForPiecewiseExponentialDistribution #' @export rpwexp <- function(n, ..., s = NA_real_, lambda = NA_real_, kappa = 1) { getPiecewiseExponentialRandomNumbers(n = n, piecewiseSurvivalTime = s, piecewiseLambda = lambda, kappa = kappa, ...) } #' #' @title #' Survival Helper Functions for Conversion of Pi, Lambda, Median #' #' @description #' Functions to convert pi, lambda and median values into each other. #' #' @param piValue,pi1,pi2,lambda,median Value that shall be converted. #' @inheritParams param_eventTime #' @inheritParams param_kappa #' #' @details #' Can be used, e.g., to convert median values into pi or lambda values for usage in #' \code{\link{getSampleSizeSurvival}} or \code{\link{getPowerSurvival}}. #' #' @return Returns a \code{\link[base]{numeric}} value or vector will be returned. #' #' @name utilitiesForSurvivalTrials #' NULL #' @rdname utilitiesForSurvivalTrials #' @export getLambdaByPi <- function(piValue, eventTime = 12L, # C_EVENT_TIME_DEFAULT kappa = 1) { .assertIsValidPi(piValue, "pi") .assertIsValidKappa(kappa) .assertIsSingleNumber(eventTime, "eventTime") .assertIsInOpenInterval(eventTime, "eventTime", lower = 0, upper = NULL) for (value in piValue) { if (value > 1 - 1e-16 && value < 1 + 1e-16) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'pi' must be != 1") } } return((-log(1 - piValue))^(1 / kappa) / eventTime) } #' @rdname utilitiesForSurvivalTrials #' @export getLambdaByMedian <- function(median, kappa = 1) { .assertIsNumericVector(median, "median") .assertIsValidKappa(kappa) return(log(2)^(1 / kappa) / median) } #' @rdname utilitiesForSurvivalTrials #' @export getHazardRatioByPi <- function(pi1, pi2, eventTime = 12L, # C_EVENT_TIME_DEFAULT kappa = 1) { .assertIsValidPi(pi1, "pi1") .assertIsValidPi(pi2, "pi2") .assertIsValidKappa(kappa) .assertIsSingleNumber(eventTime, "eventTime") .assertIsInOpenInterval(eventTime, "eventTime", lower = 0, upper = NULL) return((getLambdaByPi(pi1, eventTime, kappa) / getLambdaByPi(pi2, eventTime, kappa))^kappa) } #' @rdname utilitiesForSurvivalTrials #' @export getPiByLambda <- function(lambda, eventTime = 12L, # C_EVENT_TIME_DEFAULT kappa = 1) { .assertIsValidLambda(lambda) .assertIsValidKappa(kappa) .assertIsSingleNumber(eventTime, "eventTime") .assertIsInOpenInterval(eventTime, "eventTime", lower = 0, upper = NULL) x <- exp(-(lambda * eventTime)^kappa) if (any(x < 1e-15)) { warning("Calculation of pi (1) by lambda (", .arrayToString(round(lambda, 4)), ") results in a possible loss of precision because pi = 1 was returned but pi is not exactly 1", call. = FALSE) } return(1 - x) } # alternative: return(1 - exp(-(log(2)^(1 / kappa) / median * eventTime)^kappa)) #' @rdname utilitiesForSurvivalTrials #' @export getPiByMedian <- function(median, eventTime = 12L, # C_EVENT_TIME_DEFAULT kappa = 1) { .assertIsNumericVector(median, "median") .assertIsValidKappa(kappa) .assertIsSingleNumber(eventTime, "eventTime") .assertIsInOpenInterval(eventTime, "eventTime", lower = 0, upper = NULL) return(1 - 2^(-(eventTime / median)^kappa)) } #' @rdname utilitiesForSurvivalTrials #' @export getMedianByLambda <- function(lambda, kappa = 1) { .assertIsValidLambda(lambda) .assertIsValidKappa(kappa) return(log(2)^(1 / kappa) / lambda) } #' @rdname utilitiesForSurvivalTrials #' @export getMedianByPi <- function(piValue, eventTime = 12L, # C_EVENT_TIME_DEFAULT kappa = 1) { .assertIsValidPi(piValue, "piValue") .assertIsSingleNumber(eventTime, "eventTime") .assertIsInOpenInterval(eventTime, "eventTime", lower = 0, upper = NULL) .assertIsValidKappa(kappa) getMedianByLambda(getLambdaByPi(piValue, eventTime, kappa), kappa) } .convertStageWiseToOverallValuesInner <- function(valuesPerStage) { eventsOverStages <- matrix(valuesPerStage, nrow = nrow(as.matrix(valuesPerStage))) eventsOverStages[is.na(eventsOverStages)] <- 0 for (i in 1:ncol(as.matrix(valuesPerStage))) { eventsOverStages[, i] <- cumsum(eventsOverStages[, i]) } return(eventsOverStages) } # example: .convertStageWiseToOverallValues(array(1:4, c(3, 4))) .convertStageWiseToOverallValues <- function(valuesPerStage) { if (is.array(valuesPerStage) && length(dim(valuesPerStage)) == 3) { eventsOverStages <- array(dim = dim(valuesPerStage)) for (g in 1:dim(valuesPerStage)[3]) { eventsTemp <- matrix(valuesPerStage[, , g], nrow = dim(valuesPerStage)[1]) eventsOverStages[, , g] <- .convertStageWiseToOverallValuesInner(eventsTemp) } return(eventsOverStages) } return(.convertStageWiseToOverallValuesInner(valuesPerStage)) } .getDesignParametersToShow <- function(paramaterSet) { if (is.null(paramaterSet[[".design"]])) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'paramaterSet' (", class(paramaterSet), ") does not contain '.design' field") } designParametersToShow <- c(".design$stages") if (grepl("Dunnett", class(paramaterSet))) { designParametersToShow <- c( designParametersToShow, ".design$alpha", ".design$informationAtInterim", ".design$secondStageConditioning", ".design$sided") } else { design <- paramaterSet$.design designParametersToShow <- c() if (design$kMax > 1) { if (is.null(paramaterSet[[".stageResults"]]) || .isTrialDesignGroupSequential(design)) { designParametersToShow <- c(designParametersToShow, ".design$informationRates") } else if (.isTrialDesignInverseNormal(design)) { designParametersToShow <- c(designParametersToShow, ".stageResults$weightsInverseNormal") } else if (.isTrialDesignFisher(design)) { designParametersToShow <- c(designParametersToShow, ".stageResults$weightsFisher") } } designParametersToShow <- c(designParametersToShow, ".design$criticalValues") if (design$kMax > 1) { if (.isTrialDesignFisher(design)) { designParametersToShow <- c(designParametersToShow, ".design$alpha0Vec") } else { designParametersToShow <- c(designParametersToShow, ".design$futilityBounds") } designParametersToShow <- c(designParametersToShow, ".design$alphaSpent") designParametersToShow <- c(designParametersToShow, ".design$stageLevels") } if (design$sided == 2 && !grepl("Analysis|Simulation", class(paramaterSet)) && (!inherits(paramaterSet, "TrialDesignPlan") || paramaterSet$.isSampleSizeObject())) { designParametersToShow <- c(designParametersToShow, ".design$twoSidedPower") } designParametersToShow <- c(designParametersToShow, ".design$alpha") if (!grepl("Analysis|Simulation", class(paramaterSet)) && (!inherits(paramaterSet, "TrialDesignPlan") || paramaterSet$.isSampleSizeObject())) { designParametersToShow <- c(designParametersToShow, ".design$beta") } designParametersToShow <- c(designParametersToShow, ".design$sided") } return(designParametersToShow) } .isNoEarlyEfficacy <- function(design) { .assertIsTrialDesignInverseNormalOrGroupSequential(design) if (design$kMax == 1) { return(FALSE) } if (design$typeOfDesign == C_TYPE_OF_DESIGN_NO_EARLY_EFFICACY) { return(TRUE) } if (design$typeOfDesign != C_TYPE_OF_DESIGN_AS_USER) { return(FALSE) } indices <- design$userAlphaSpending == 0 return(all(indices[1:(length(indices) - 1)])) } rpact/R/RcppExports.R0000644000175000017500000000455714165524620014352 0ustar nileshnilesh# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 getW <- function(dx, M) { .Call(`_rpact_getW`, dx, M) } getGroupSequentialProbabilitiesCpp <- function(decisionMatrix, informationRates) { .Call(`_rpact_getGroupSequentialProbabilitiesCpp`, decisionMatrix, informationRates) } getDesignGroupSequentialPampallonaTsiatisCpp <- function(tolerance, beta, alpha, kMax, deltaPT0, deltaPT1, informationRates, sided, bindingFutility) { .Call(`_rpact_getDesignGroupSequentialPampallonaTsiatisCpp`, tolerance, beta, alpha, kMax, deltaPT0, deltaPT1, informationRates, sided, bindingFutility) } getSimulationSurvivalCpp <- function(designNumber, kMax, sided, criticalValues, informationRates, conditionalPower, plannedEvents, thetaH1, minNumberOfEventsPerStage, maxNumberOfEventsPerStage, directionUpper, allocation1, allocation2, accrualTime, treatmentGroup, thetaH0, futilityBounds, alpha0Vec, pi1Vec, pi2, eventTime, piecewiseSurvivalTime, cdfValues1, cdfValues2, lambdaVec1, lambdaVec2, phi, maxNumberOfSubjects, maxNumberOfIterations, maxNumberOfRawDatasetsPerStage, kappa) { .Call(`_rpact_getSimulationSurvivalCpp`, designNumber, kMax, sided, criticalValues, informationRates, conditionalPower, plannedEvents, thetaH1, minNumberOfEventsPerStage, maxNumberOfEventsPerStage, directionUpper, allocation1, allocation2, accrualTime, treatmentGroup, thetaH0, futilityBounds, alpha0Vec, pi1Vec, pi2, eventTime, piecewiseSurvivalTime, cdfValues1, cdfValues2, lambdaVec1, lambdaVec2, phi, maxNumberOfSubjects, maxNumberOfIterations, maxNumberOfRawDatasetsPerStage, kappa) } getStratifiedLogRankTestCpp <- function(survivalDataSet, time, directionUpper, thetaH0 = 1.0) { .Call(`_rpact_getStratifiedLogRankTestCpp`, survivalDataSet, time, directionUpper, thetaH0) } getSimulationStratifiedLogRankCpp <- function(kMax, criticalValues, lambda2, lambda1, prevalences, directionUpper, maxNumberOfSubjects, accrualTime, plannedEvents, allocation1, allocation2, maxIterations, survivalDataSet) { .Call(`_rpact_getSimulationStratifiedLogRankCpp`, kMax, criticalValues, lambda2, lambda1, prevalences, directionUpper, maxNumberOfSubjects, accrualTime, plannedEvents, allocation1, allocation2, maxIterations, survivalDataSet) } getCipheredValue <- function(x) { .Call(`_rpact_getCipheredValue`, x) } rpact/R/f_analysis_multiarm_means.R0000644000175000017500000021240014165522624017274 0ustar nileshnilesh## | ## | *Analysis of means in multi-arm designs with adaptive test* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | rpact package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File version: $Revision: 5684 $ ## | Last changed: $Date: 2022-01-05 12:27:24 +0100 (Mi, 05 Jan 2022) $ ## | Last changed by: $Author: wassmer $ ## | .getAnalysisResultsMeansMultiArm <- function(..., design, dataInput) { if (.isTrialDesignInverseNormal(design)) { return(.getAnalysisResultsMeansInverseNormalMultiArm(design = design, dataInput = dataInput, ...)) } if (.isTrialDesignFisher(design)) { return(.getAnalysisResultsMeansFisherMultiArm(design = design, dataInput = dataInput, ...)) } if (.isTrialDesignConditionalDunnett(design)) { return(.getAnalysisResultsMeansConditionalDunnettMultiArm(design = design, dataInput = dataInput, ...)) } .stopWithWrongDesignMessage(design) } .getAnalysisResultsMeansInverseNormalMultiArm <- function(..., design, dataInput, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, thetaH0 = C_THETA_H0_MEANS_DEFAULT, thetaH1 = NA_real_, assumedStDevs = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, calculateSingleStepAdjusted = FALSE, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .assertIsTrialDesignInverseNormal(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsMeansInverseNormalMultiArm", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsMultiArmInverseNormal(design = design, dataInput = dataInput) results <- .getAnalysisResultsMeansMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, varianceOption = varianceOption, thetaH0 = thetaH0, thetaH1 = thetaH1, assumedStDevs = assumedStDevs, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, calculateSingleStepAdjusted = calculateSingleStepAdjusted, tolerance = tolerance ) return(results) } .getAnalysisResultsMeansFisherMultiArm <- function(..., design, dataInput, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, thetaH0 = C_THETA_H0_MEANS_DEFAULT, thetaH1 = NA_real_, assumedStDevs = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, calculateSingleStepAdjusted = FALSE, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsMeansFisherMultiArm", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsMultiArmFisher(design = design, dataInput = dataInput) results <- .getAnalysisResultsMeansMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, varianceOption = varianceOption, thetaH0 = thetaH0, thetaH1 = thetaH1, assumedStDevs = assumedStDevs, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, calculateSingleStepAdjusted = calculateSingleStepAdjusted, tolerance = tolerance, iterations = iterations, seed = seed ) return(results) } .getAnalysisResultsMeansConditionalDunnettMultiArm <- function(..., design, dataInput, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, thetaH0 = C_THETA_H0_MEANS_DEFAULT, thetaH1 = NA_real_, assumedStDevs = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, calculateSingleStepAdjusted = FALSE, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .assertIsTrialDesignConditionalDunnett(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( functionName = ".getAnalysisResultsMeansConditionalDunnettMultiArm", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) results <- AnalysisResultsConditionalDunnett(design = design, dataInput = dataInput) results <- .getAnalysisResultsMeansMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, normalApproximation = normalApproximation, varianceOption = varianceOption, thetaH0 = thetaH0, thetaH1 = thetaH1, assumedStDevs = assumedStDevs, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, calculateSingleStepAdjusted = calculateSingleStepAdjusted, tolerance = tolerance, iterations = iterations, seed = seed ) return(results) } .getAnalysisResultsMeansMultiArmAll <- function(..., results, design, dataInput, intersectionTest, stage, directionUpper, normalApproximation, varianceOption, thetaH0, thetaH1, assumedStDevs, nPlanned, allocationRatioPlanned, calculateSingleStepAdjusted, tolerance, iterations, seed) { startTime <- Sys.time() intersectionTest <- .getCorrectedIntersectionTestMultiArmIfNecessary(design, intersectionTest) stageResults <- .getStageResultsMeansMultiArm( design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, thetaH0 = thetaH0, directionUpper = directionUpper, normalApproximation = normalApproximation, varianceOption = varianceOption, calculateSingleStepAdjusted = calculateSingleStepAdjusted, userFunctionCallEnabled = TRUE ) normalApproximation <- stageResults$normalApproximation intersectionTest <- stageResults$intersectionTest results$.setStageResults(stageResults) .logProgress("Stage results calculated", startTime = startTime) numberOfGroups <- dataInput$getNumberOfGroups() thetaH1 <- .assertIsValidThetaH1ForMultiArm(thetaH1, stageResults, stage, results = results) assumedStDevs <- .assertIsValidAssumedStDevForMultiHypotheses( assumedStDevs, stageResults, stage, results = results ) .setValueAndParameterType( results, "intersectionTest", intersectionTest, C_INTERSECTION_TEST_MULTIARMED_DEFAULT ) .setValueAndParameterType( results, "directionUpper", directionUpper, C_DIRECTION_UPPER_DEFAULT ) .setValueAndParameterType( results, "normalApproximation", normalApproximation, C_NORMAL_APPROXIMATION_MEANS_DEFAULT ) .setValueAndParameterType( results, "varianceOption", varianceOption, C_VARIANCE_OPTION_MULTIARMED_DEFAULT ) .setValueAndParameterType(results, "thetaH0", thetaH0, C_THETA_H0_MEANS_DEFAULT) .setConditionalPowerArguments(results, dataInput, nPlanned, allocationRatioPlanned) .setNPlannedAndThetaH1AndAssumedStDevs(results, nPlanned, thetaH1, assumedStDevs) startTime <- Sys.time() if (!.isTrialDesignConditionalDunnett(design)) { results$.closedTestResults <- getClosedCombinationTestResults(stageResults = stageResults) } else { results$.closedTestResults <- getClosedConditionalDunnettTestResults( stageResults = stageResults, design = design, stage = stage ) } .logProgress("Closed test calculated", startTime = startTime) results$.setParameterType("seed", C_PARAM_NOT_APPLICABLE) results$.setParameterType("iterations", C_PARAM_NOT_APPLICABLE) if (design$kMax > 1) { # conditional power startTime <- Sys.time() if (.isTrialDesignFisher(design)) { conditionalPowerResults <- .getConditionalPowerMeansMultiArm( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, assumedStDevs = assumedStDevs, iterations = iterations, seed = seed ) if (conditionalPowerResults$simulated) { results$conditionalPowerSimulated <- conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalPowerSimulated", C_PARAM_GENERATED) } else { results$conditionalPower <- conditionalPowerResults$conditionalPower results$conditionalPowerSimulated <- matrix(numeric(0)) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$.setParameterType("conditionalPowerSimulated", C_PARAM_NOT_APPLICABLE) } } else { conditionalPowerResults <- .getConditionalPowerMeansMultiArm( stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, assumedStDevs = assumedStDevs ) results$conditionalPower <- conditionalPowerResults$conditionalPower results$.setParameterType("conditionalPower", C_PARAM_GENERATED) } results$thetaH1 <- matrix(conditionalPowerResults$thetaH1, ncol = 1) results$assumedStDevs <- matrix(conditionalPowerResults$assumedStDevs, ncol = 1) results$.conditionalPowerResults <- conditionalPowerResults .logProgress("Conditional power calculated", startTime = startTime) # CRP - conditional rejection probabilities startTime <- Sys.time() results$conditionalRejectionProbabilities <- .getConditionalRejectionProbabilitiesMultiArm( stageResults = stageResults, stage = stage ) results$.setParameterType("conditionalRejectionProbabilities", C_PARAM_GENERATED) .logProgress("Conditional rejection probabilities (CRP) calculated", startTime = startTime) } else { results$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalPowerSimulated", C_PARAM_NOT_APPLICABLE) results$.setParameterType("conditionalRejectionProbabilities", C_PARAM_NOT_APPLICABLE) } # RCI - repeated confidence interval repeatedConfidenceIntervals <- .getRepeatedConfidenceIntervalsMeansMultiArm( design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, normalApproximation = normalApproximation, varianceOption = varianceOption, tolerance = tolerance ) gMax <- stageResults$getGMax() results$repeatedConfidenceIntervalLowerBounds <- matrix(rep(NA_real_, gMax * design$kMax), nrow = gMax, ncol = design$kMax) results$repeatedConfidenceIntervalUpperBounds <- results$repeatedConfidenceIntervalLowerBounds for (k in 1:design$kMax) { for (treatmentArm in 1:gMax) { results$repeatedConfidenceIntervalLowerBounds[treatmentArm, k] <- repeatedConfidenceIntervals[treatmentArm, 1, k] results$repeatedConfidenceIntervalUpperBounds[treatmentArm, k] <- repeatedConfidenceIntervals[treatmentArm, 2, k] } } results$.setParameterType("repeatedConfidenceIntervalLowerBounds", C_PARAM_GENERATED) results$.setParameterType("repeatedConfidenceIntervalUpperBounds", C_PARAM_GENERATED) # repeated p-value results$repeatedPValues <- .getRepeatedPValuesMultiArm( stageResults = stageResults, tolerance = tolerance ) results$.setParameterType("repeatedPValues", C_PARAM_GENERATED) return(results) } .getStageResultsMeansMultiArm <- function(..., design, dataInput, thetaH0 = C_THETA_H0_MEANS_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, calculateSingleStepAdjusted = FALSE, userFunctionCallEnabled = FALSE) { .assertIsTrialDesign(design) .assertIsDatasetMeans(dataInput) .assertIsValidThetaH0DataInput(thetaH0, dataInput) .assertIsValidDirectionUpper(directionUpper, design$sided) .assertIsSingleLogical(normalApproximation, "normalApproximation") .assertIsValidVarianceOptionMultiArmed(design, varianceOption) .warnInCaseOfUnknownArguments( functionName = ".getStageResultsMeansMultiArm", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) gMax <- dataInput$getNumberOfGroups() - 1 kMax <- design$kMax if (.isTrialDesignConditionalDunnett(design)) { if (normalApproximation == FALSE) { if (userFunctionCallEnabled) { warning("'normalApproximation' was set to TRUE ", "because conditional Dunnett test was specified as design", call. = FALSE ) } normalApproximation <- TRUE } } intersectionTest <- .getCorrectedIntersectionTestMultiArmIfNecessary( design, intersectionTest, userFunctionCallEnabled ) .assertIsValidIntersectionTestMultiArm(design, intersectionTest) if (intersectionTest == "Dunnett" && varianceOption != "overallPooled" && !normalApproximation) { stop("Dunnett t test can only be performed with overall variance estimation, select 'varianceOption' = \"overallPooled\"", call. = FALSE) } stageResults <- StageResultsMultiArmMeans( design = design, dataInput = dataInput, thetaH0 = thetaH0, direction = ifelse(directionUpper, C_DIRECTION_UPPER, C_DIRECTION_LOWER), normalApproximation = normalApproximation, directionUpper = directionUpper, varianceOption = varianceOption, stage = stage ) .setValueAndParameterType( stageResults, "intersectionTest", intersectionTest, C_INTERSECTION_TEST_MULTIARMED_DEFAULT ) effectSizes <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallStDevs <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallPooledStDevs <- matrix(rep(NA_real_, kMax), 1, kMax) testStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallTestStatistics <- matrix(NA_real_, nrow = gMax, ncol = kMax) separatePValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) overallPValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) dimnames(testStatistics) <- list(paste("arm ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "")) dimnames(overallTestStatistics) <- list( paste("arm ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "") ) dimnames(separatePValues) <- list(paste("arm ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "")) dimnames(overallPValues) <- list(paste("arm ", 1:gMax, sep = ""), paste("stage ", (1:kMax), sep = "")) for (k in 1:stage) { overallPooledStDevs[1, k] <- sqrt(sum((dataInput$getOverallSampleSizes(stage = k) - 1) * dataInput$getOverallStDevs(stage = k)^2, na.rm = TRUE) / sum(dataInput$getOverallSampleSizes(stage = k) - 1, na.rm = TRUE)) if (varianceOption == "overallPooled") { stDev <- sqrt(sum((dataInput$getSampleSizes(stage = k) - 1) * dataInput$getStDevs(stage = k)^2, na.rm = TRUE) / sum(dataInput$getSampleSizes(stage = k) - 1, na.rm = TRUE)) overallStDevForTest <- overallPooledStDevs[1, k] } for (treatmentArm in 1:gMax) { effectSizes[treatmentArm, k] <- dataInput$getOverallMeans(stage = k, group = treatmentArm) - dataInput$getOverallMeans(stage = k, group = gMax + 1) overallStDevs[treatmentArm, k] <- sqrt(sum(( dataInput$getOverallSampleSize(stage = k, group = c(treatmentArm, gMax + 1)) - 1) * dataInput$getOverallStDev(stage = k, group = c(treatmentArm, gMax + 1))^2, na.rm = TRUE) / sum(dataInput$getOverallSampleSize(stage = k, group = c(treatmentArm, gMax + 1)) - 1)) if (varianceOption == "pairwisePooled") { stDev <- sqrt(sum((dataInput$getSampleSizes(stage = k, group = c(treatmentArm, gMax + 1)) - 1) * dataInput$getStDevs(stage = k, group = c(treatmentArm, gMax + 1))^2, na.rm = TRUE) / sum(dataInput$getSampleSizes(stage = k, group = c(treatmentArm, gMax + 1)) - 1)) overallStDevForTest <- overallStDevs[treatmentArm, k] } if (varianceOption == "notPooled") { testStatistics[treatmentArm, k] <- (dataInput$getMeans(stage = k, group = treatmentArm) - dataInput$getMeans(stage = k, group = gMax + 1) - thetaH0) / sqrt(dataInput$getStDevs(stage = k, group = treatmentArm)^2 / dataInput$getSampleSizes(stage = k, group = treatmentArm) + dataInput$getStDevs(stage = k, group = gMax + 1)^2 / dataInput$getSampleSizes(stage = k, group = gMax + 1)) overallTestStatistics[treatmentArm, k] <- ( dataInput$getOverallMeans(stage = k, group = treatmentArm) - dataInput$getOverallMeans(stage = k, group = gMax + 1) - thetaH0) / sqrt(dataInput$getOverallStDevs(stage = k, group = treatmentArm)^2 / dataInput$getOverallSampleSizes(stage = k, group = treatmentArm) + dataInput$getOverallStDevs(stage = k, group = gMax + 1)^2 / dataInput$getOverallSampleSizes(stage = k, group = gMax + 1)) } else { testStatistics[treatmentArm, k] <- (dataInput$getMeans(stage = k, group = treatmentArm) - dataInput$getMeans(stage = k, group = gMax + 1) - thetaH0) / stDev / sqrt(1 / dataInput$getSampleSizes(stage = k, group = treatmentArm) + 1 / dataInput$getSampleSizes(stage = k, group = gMax + 1)) overallTestStatistics[treatmentArm, k] <- ( dataInput$getOverallMeans(stage = k, group = treatmentArm) - dataInput$getOverallMeans(stage = k, group = gMax + 1) - thetaH0) / overallStDevForTest / sqrt(1 / dataInput$getOverallSampleSizes(stage = k, group = treatmentArm) + 1 / dataInput$getOverallSampleSizes(stage = k, group = gMax + 1)) } if (normalApproximation) { separatePValues[treatmentArm, k] <- 1 - stats::pnorm(testStatistics[treatmentArm, k]) overallPValues[treatmentArm, k] <- 1 - stats::pnorm(overallTestStatistics[treatmentArm, k]) } else { if (varianceOption == "overallPooled") { separatePValues[treatmentArm, k] <- 1 - stats::pt( testStatistics[treatmentArm, k], sum(dataInput$getSampleSizes(stage = k) - 1, na.rm = TRUE) ) overallPValues[treatmentArm, k] <- 1 - stats::pt( overallTestStatistics[treatmentArm, k], sum(dataInput$getOverallSampleSizes(stage = k) - 1, na.rm = TRUE) ) } else if (varianceOption == "pairwisePooled") { separatePValues[treatmentArm, k] <- 1 - stats::pt( testStatistics[treatmentArm, k], sum(dataInput$getSampleSizes(stage = k, group = c(treatmentArm, gMax + 1)) - 1) ) overallPValues[treatmentArm, k] <- 1 - stats::pt( overallTestStatistics[treatmentArm, k], sum(dataInput$getOverallSampleSizes(stage = k, group = c(treatmentArm, gMax + 1)) - 1) ) } else if (varianceOption == "notPooled") { u <- dataInput$getStDevs(stage = k, group = treatmentArm)^2 / dataInput$getSampleSizes(stage = k, group = treatmentArm) / (dataInput$getStDevs(stage = k, group = treatmentArm)^2 / dataInput$getSampleSizes(stage = k, group = treatmentArm) + dataInput$getStDevs(stage = k, group = gMax + 1)^2 / dataInput$getSampleSizes(stage = k, group = gMax + 1)) separatePValues[treatmentArm, k] <- 1 - stats::pt( testStatistics[treatmentArm, k], 1 / (u^2 / (dataInput$getSampleSizes(stage = k, group = treatmentArm) - 1) + (1 - u)^2 / (dataInput$getSampleSizes(stage = k, group = gMax + 1) - 1)) ) u <- dataInput$getOverallStDevs(stage = k, group = treatmentArm)^2 / dataInput$getOverallSampleSizes(stage = k, group = treatmentArm) / (dataInput$getOverallStDevs(stage = k, group = treatmentArm)^2 / dataInput$getOverallSampleSizes(stage = k, group = treatmentArm) + dataInput$getOverallStDevs(stage = k, group = gMax + 1)^2 / dataInput$getOverallSampleSizes(stage = k, group = gMax + 1)) overallPValues[treatmentArm, k] <- 1 - stats::pt( overallTestStatistics[treatmentArm, k], 1 / (u^2 / (dataInput$getOverallSampleSizes(stage = k, group = treatmentArm) - 1) + (1 - u)^2 / (dataInput$getOverallSampleSizes(stage = k, group = gMax + 1) - 1)) ) } } if (!directionUpper) { separatePValues[treatmentArm, k] <- 1 - separatePValues[treatmentArm, k] overallPValues[treatmentArm, k] <- 1 - overallPValues[treatmentArm, k] # testStatistics[g, k] <- -testStatistics[g, k] # overallTestStatistics[g, k] <- -overallTestStatistics[g, k] } } } .setWeightsToStageResults(design, stageResults) # Calculation of single stage adjusted p-Values and overall test statistics # for determination of RCIs if (calculateSingleStepAdjusted) { singleStepAdjustedPValues <- matrix(NA_real_, nrow = gMax, ncol = kMax) combInverseNormal <- matrix(NA_real_, nrow = gMax, ncol = kMax) combFisher <- matrix(NA_real_, nrow = gMax, ncol = kMax) if (.isTrialDesignInverseNormal(design)) { weightsInverseNormal <- stageResults$weightsInverseNormal } else if (.isTrialDesignFisher(design)) { weightsFisher <- stageResults$weightsFisher } for (k in 1:stage) { selected <- sum(!is.na(separatePValues[, k])) sampleSizesSelected <- as.numeric(na.omit( dataInput$getSampleSizes(stage = k, group = -(gMax + 1)) )) sigma <- sqrt(sampleSizesSelected / (sampleSizesSelected + dataInput$getSampleSize(k, gMax + 1))) %*% sqrt(t(sampleSizesSelected / (sampleSizesSelected + dataInput$getSampleSize(k, gMax + 1)))) diag(sigma) <- 1 for (treatmentArm in 1:gMax) { if (intersectionTest == "Bonferroni" || intersectionTest == "Simes") { if (.isTrialDesignGroupSequential(design)) { overallPValues[treatmentArm, k] <- min(1, overallPValues[treatmentArm, k] * selected) } else { singleStepAdjustedPValues[treatmentArm, k] <- min( 1, separatePValues[treatmentArm, k] * selected ) } } else if (intersectionTest == "Sidak") { if (.isTrialDesignGroupSequential(design)) { overallPValues[treatmentArm, k] <- 1 - (1 - overallPValues[treatmentArm, k])^selected } else { singleStepAdjustedPValues[treatmentArm, k] <- 1 - (1 - separatePValues[treatmentArm, k])^selected } } else if (intersectionTest == "Dunnett") { if (!is.na(testStatistics[treatmentArm, k])) { df <- NA_real_ if (!normalApproximation) { df <- sum(dataInput$getSampleSizes(stage = k) - 1, na.rm = TRUE) } singleStepAdjustedPValues[treatmentArm, k] <- 1 - .getMultivariateDistribution( type = ifelse(normalApproximation, "normal", "t"), upper = ifelse(directionUpper, testStatistics[treatmentArm, k], -testStatistics[treatmentArm, k] ), sigma = sigma, df = df ) } } if (.isTrialDesignInverseNormal(design)) { combInverseNormal[treatmentArm, k] <- (weightsInverseNormal[1:k] %*% .getOneMinusQNorm(singleStepAdjustedPValues[treatmentArm, 1:k])) / sqrt(sum(weightsInverseNormal[1:k]^2)) } else if (.isTrialDesignFisher(design)) { combFisher[treatmentArm, k] <- prod( singleStepAdjustedPValues[treatmentArm, 1:k]^weightsFisher[1:k] ) } } } stageResults$overallTestStatistics <- overallTestStatistics stageResults$overallPValues <- overallPValues stageResults$effectSizes <- effectSizes stageResults$overallStDevs <- overallStDevs stageResults$testStatistics <- testStatistics stageResults$separatePValues <- separatePValues stageResults$singleStepAdjustedPValues <- singleStepAdjustedPValues stageResults$.setParameterType("singleStepAdjustedPValues", C_PARAM_GENERATED) if (.isTrialDesignFisher(design)) { stageResults$combFisher <- combFisher stageResults$.setParameterType("combFisher", C_PARAM_GENERATED) } else if (.isTrialDesignInverseNormal(design)) { stageResults$combInverseNormal <- combInverseNormal stageResults$.setParameterType("combInverseNormal", C_PARAM_GENERATED) } } else { stageResults$overallTestStatistics <- overallTestStatistics stageResults$overallPValues <- overallPValues stageResults$effectSizes <- effectSizes stageResults$overallStDevs <- overallStDevs stageResults$overallPooledStDevs <- overallPooledStDevs stageResults$testStatistics <- testStatistics stageResults$separatePValues <- separatePValues } return(stageResults) } .getRootThetaMeansMultiArm <- function(..., design, dataInput, treatmentArm, stage, directionUpper, normalApproximation, varianceOption, intersectionTest, thetaLow, thetaUp, firstParameterName, secondValue, tolerance) { result <- .getOneDimensionalRoot( function(theta) { stageResults <- .getStageResultsMeansMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, intersectionTest = intersectionTest, normalApproximation = normalApproximation, varianceOption = varianceOption, calculateSingleStepAdjusted = TRUE ) firstValue <- stageResults[[firstParameterName]][treatmentArm, stage] if (.isTrialDesignGroupSequential(design)) { firstValue <- .getOneMinusQNorm(firstValue) } return(firstValue - secondValue) }, lower = thetaLow, upper = thetaUp, tolerance = tolerance, callingFunctionInformation = ".getRootThetaMeansMultiArm" ) return(result) } .getUpperLowerThetaMeansMultiArm <- function(..., design, dataInput, theta, treatmentArm, stage, directionUpper, normalApproximation, varianceOption, conditionFunction, intersectionTest, firstParameterName, secondValue) { stageResults <- .getStageResultsMeansMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, intersectionTest = intersectionTest, normalApproximation = normalApproximation, varianceOption = varianceOption, calculateSingleStepAdjusted = TRUE ) firstValue <- stageResults[[firstParameterName]][treatmentArm, stage] maxSearchIterations <- 30 while (conditionFunction(secondValue, firstValue)) { theta <- 2 * theta stageResults <- .getStageResultsMeansMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = directionUpper, intersectionTest = intersectionTest, normalApproximation = normalApproximation, varianceOption = varianceOption, calculateSingleStepAdjusted = TRUE ) firstValue <- stageResults[[firstParameterName]][treatmentArm, stage] maxSearchIterations <- maxSearchIterations - 1 if (maxSearchIterations < 0) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, sprintf( paste0( "failed to find theta (k = %s, firstValue = %s, ", "secondValue = %s, levels(firstValue) = %s, theta = %s)" ), stage, stageResults[[firstParameterName]][treatmentArm, stage], secondValue, firstValue, theta ) ) } } return(theta) } .getRepeatedConfidenceIntervalsMeansMultiArmAll <- function(..., design, dataInput, directionUpper = C_DIRECTION_UPPER_DEFAULT, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, firstParameterName) { .assertIsValidIntersectionTestMultiArm(design, intersectionTest) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) stageResults <- .getStageResultsMeansMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = 0, directionUpper = directionUpper, intersectionTest = intersectionTest, normalApproximation = normalApproximation, varianceOption = varianceOption, calculateSingleStepAdjusted = FALSE ) gMax <- dataInput$getNumberOfGroups() - 1 repeatedConfidenceIntervals <- array(NA_real_, dim = c(gMax, 2, design$kMax)) # Confidence interval for second stage when using conditional Dunnett test if (.isTrialDesignConditionalDunnett(design)) { startTime <- Sys.time() for (treatmentArm in 1:gMax) { if (!is.na(stageResults$testStatistics[treatmentArm, 2])) { thetaLowLimit <- -1 iteration <- 30 rejected <- FALSE while (!rejected && iteration >= 0) { stageResults <- .getStageResultsMeansMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaLowLimit, directionUpper = TRUE, intersectionTest = intersectionTest, normalApproximation = normalApproximation, varianceOption = varianceOption, calculateSingleStepAdjusted = FALSE ) rejected <- .getConditionalDunnettTestForCI( design = design, stageResults = stageResults, treatmentArm = treatmentArm ) iteration <- iteration - 1 thetaLowLimit <- 2 * thetaLowLimit } iteration <- 30 thetaUpLimit <- 1 rejected <- FALSE while (!rejected && iteration >= 0) { stageResults <- .getStageResultsMeansMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = thetaUpLimit, directionUpper = FALSE, intersectionTest = intersectionTest, normalApproximation = normalApproximation, varianceOption = varianceOption, calculateSingleStepAdjusted = FALSE ) rejected <- .getConditionalDunnettTestForCI( design = design, stageResults = stageResults, treatmentArm = treatmentArm ) iteration <- iteration - 1 thetaUpLimit <- 2 * thetaUpLimit } thetaLow <- thetaLowLimit thetaUp <- thetaUpLimit iteration <- 30 prec <- 1 while (prec > tolerance) { theta <- (thetaLow + thetaUp) / 2 stageResults <- .getStageResultsMeansMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = TRUE, intersectionTest = intersectionTest, normalApproximation = normalApproximation, varianceOption = varianceOption, calculateSingleStepAdjusted = FALSE ) conditionalDunnettSingleStepRejected <- .getConditionalDunnettTestForCI( design = design, stageResults = stageResults, treatmentArm = treatmentArm ) ifelse(conditionalDunnettSingleStepRejected, thetaLow <- theta, thetaUp <- theta) ifelse(iteration > 0, prec <- thetaUp - thetaLow, prec <- 0) iteration <- iteration - 1 } repeatedConfidenceIntervals[treatmentArm, 1, 2] <- theta thetaLow <- thetaLowLimit thetaUp <- thetaUpLimit iteration <- 30 prec <- 1 while (prec > tolerance) { theta <- (thetaLow + thetaUp) / 2 stageResults <- .getStageResultsMeansMultiArm( design = design, dataInput = dataInput, stage = stage, thetaH0 = theta, directionUpper = FALSE, intersectionTest = intersectionTest, normalApproximation = normalApproximation, varianceOption = varianceOption, calculateSingleStepAdjusted = FALSE ) conditionalDunnettSingleStepRejected <- .getConditionalDunnettTestForCI( design = design, stageResults = stageResults, treatmentArm = treatmentArm ) ifelse(conditionalDunnettSingleStepRejected, thetaUp <- theta, thetaLow <- theta) ifelse(iteration > 0, prec <- thetaUp - thetaLow, prec <- 0) iteration <- iteration - 1 } repeatedConfidenceIntervals[treatmentArm, 2, 2] <- theta if (!is.na(repeatedConfidenceIntervals[treatmentArm, 1, 2]) && !is.na(repeatedConfidenceIntervals[treatmentArm, 2, 2]) && repeatedConfidenceIntervals[treatmentArm, 1, 2] > repeatedConfidenceIntervals[treatmentArm, 2, 2]) { repeatedConfidenceIntervals[treatmentArm, , 2] <- rep(NA_real_, 2) } } } .logProgress("Confidence intervals for final stage calculated", startTime = startTime) } else { # Repeated onfidence intervals when using combination tests if (intersectionTest == "Hierarchical") { warning("Repeated confidence intervals not available for ", "'intersectionTest' = \"Hierarchical\"", call. = FALSE ) return(repeatedConfidenceIntervals) } if (.isTrialDesignFisher(design)) { bounds <- design$alpha0Vec border <- C_ALPHA_0_VEC_DEFAULT criticalValues <- design$criticalValues conditionFunction <- .isFirstValueSmallerThanSecondValue } else if (.isTrialDesignInverseNormal(design)) { bounds <- design$futilityBounds border <- C_FUTILITY_BOUNDS_DEFAULT criticalValues <- design$criticalValues criticalValues[is.infinite(criticalValues) & criticalValues > 0] <- C_QNORM_MAXIMUM criticalValues[is.infinite(criticalValues) & criticalValues < 0] <- C_QNORM_MINIMUM conditionFunction <- .isFirstValueGreaterThanSecondValue } # Necessary for adjustment for binding futility boundaries futilityCorr <- rep(NA_real_, design$kMax) stages <- (1:stage) for (k in stages) { startTime <- Sys.time() for (treatmentArm in 1:gMax) { if (!is.na(stageResults$testStatistics[treatmentArm, k])) { # finding maximum upper and minimum lower bounds for RCIs thetaLow <- .getUpperLowerThetaMeansMultiArm( design = design, dataInput = dataInput, theta = -1, treatmentArm = treatmentArm, stage = k, directionUpper = TRUE, normalApproximation = normalApproximation, varianceOption = varianceOption, conditionFunction = conditionFunction, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k] ) thetaUp <- .getUpperLowerThetaMeansMultiArm( design = design, dataInput = dataInput, theta = 1, treatmentArm = treatmentArm, stage = k, directionUpper = FALSE, normalApproximation = normalApproximation, varianceOption = varianceOption, conditionFunction = conditionFunction, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k] ) # finding upper and lower RCI limits through root function repeatedConfidenceIntervals[treatmentArm, 1, k] <- .getRootThetaMeansMultiArm( design = design, dataInput = dataInput, treatmentArm = treatmentArm, stage = k, directionUpper = TRUE, normalApproximation = normalApproximation, varianceOption = varianceOption, thetaLow = thetaLow, thetaUp = thetaUp, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance ) repeatedConfidenceIntervals[treatmentArm, 2, k] <- .getRootThetaMeansMultiArm( design = design, dataInput = dataInput, treatmentArm = treatmentArm, stage = k, directionUpper = FALSE, normalApproximation = normalApproximation, varianceOption = varianceOption, thetaLow = thetaLow, thetaUp = thetaUp, intersectionTest = intersectionTest, firstParameterName = firstParameterName, secondValue = criticalValues[k], tolerance = tolerance ) # adjustment for binding futility bounds if (k > 1 && conditionFunction(bounds[k - 1], border) & design$bindingFutility) { parameterName <- ifelse(.isTrialDesignFisher(design), "singleStepAdjustedPValues", firstParameterName ) # Calculate new lower and upper bounds if (directionUpper) { thetaLow <- .getUpperLowerThetaMeansMultiArm( design = design, dataInput = dataInput, theta = -1, treatmentArm = treatmentArm, stage = k - 1, directionUpper = TRUE, normalApproximation = normalApproximation, varianceOption = varianceOption, conditionFunction = conditionFunction, intersectionTest = intersectionTest, firstParameterName = parameterName, secondValue = bounds[k - 1] ) } else { thetaUp <- .getUpperLowerThetaMeansMultiArm( design = design, dataInput = dataInput, theta = 1, treatmentArm = treatmentArm, stage = k - 1, directionUpper = FALSE, normalApproximation = normalApproximation, varianceOption = varianceOption, conditionFunction = conditionFunction, intersectionTest = intersectionTest, firstParameterName = parameterName, secondValue = bounds[k - 1] ) } futilityCorr[k] <- .getRootThetaMeansMultiArm( design = design, dataInput = dataInput, treatmentArm = treatmentArm, stage = k - 1, directionUpper = directionUpper, normalApproximation = normalApproximation, varianceOption = varianceOption, thetaLow = thetaLow, thetaUp = thetaUp, intersectionTest = intersectionTest, firstParameterName = parameterName, secondValue = bounds[k - 1], tolerance = tolerance ) if (directionUpper) { repeatedConfidenceIntervals[treatmentArm, 1, k] <- min( min(futilityCorr[2:k]), repeatedConfidenceIntervals[treatmentArm, 1, k] ) } else { repeatedConfidenceIntervals[treatmentArm, 2, k] <- max( max(futilityCorr[2:k]), repeatedConfidenceIntervals[treatmentArm, 2, k] ) } } if (!is.na(repeatedConfidenceIntervals[treatmentArm, 1, k]) && !is.na(repeatedConfidenceIntervals[treatmentArm, 2, k]) && repeatedConfidenceIntervals[treatmentArm, 1, k] > repeatedConfidenceIntervals[treatmentArm, 2, k]) { repeatedConfidenceIntervals[treatmentArm, , k] <- rep(NA_real_, 2) } } } .logProgress("Repeated confidence intervals for stage %s calculated", startTime = startTime, k) } } return(repeatedConfidenceIntervals) } # # RCIs based on inverse normal combination test # .getRepeatedConfidenceIntervalsMeansMultiArmInverseNormal <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsMeansMultiArmInverseNormal", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) return(.getRepeatedConfidenceIntervalsMeansMultiArmAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, varianceOption = varianceOption, directionUpper = directionUpper, intersectionTest = intersectionTest, tolerance = tolerance, firstParameterName = "combInverseNormal", ... )) } # # RCIs based on Fisher's combination test # .getRepeatedConfidenceIntervalsMeansMultiArmFisher <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsMeansMultiArmFisher", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) return(.getRepeatedConfidenceIntervalsMeansMultiArmAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, varianceOption = varianceOption, directionUpper = directionUpper, intersectionTest = intersectionTest, tolerance = tolerance, firstParameterName = "combFisher", ... )) } # # CIs based on conditional Dunnett test # .getRepeatedConfidenceIntervalsMeansMultiArmConditionalDunnett <- function(..., design, dataInput, normalApproximation = C_NORMAL_APPROXIMATION_MEANS_DEFAULT, varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { .warnInCaseOfUnknownArguments( functionName = ".getRepeatedConfidenceIntervalsMeansMultiArmConditionalDunnett", ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck( design, powerCalculationEnabled = TRUE ), "stage"), ... ) return(.getRepeatedConfidenceIntervalsMeansMultiArmAll( design = design, dataInput = dataInput, normalApproximation = normalApproximation, varianceOption = varianceOption, directionUpper = directionUpper, intersectionTest = intersectionTest, tolerance = tolerance, firstParameterName = NA, ... )) } # # Calculation of lower and upper limits of repeated confidence intervals (RCIs) for Means # .getRepeatedConfidenceIntervalsMeansMultiArm <- function(..., design) { if (.isTrialDesignInverseNormal(design)) { return(.getRepeatedConfidenceIntervalsMeansMultiArmInverseNormal(design = design, ...)) } if (.isTrialDesignFisher(design)) { return(.getRepeatedConfidenceIntervalsMeansMultiArmFisher(design = design, ...)) } if (.isTrialDesignConditionalDunnett(design)) { return(.getRepeatedConfidenceIntervalsMeansMultiArmConditionalDunnett(design = design, ...)) } .stopWithWrongDesignMessage(design) } # # Calculation of conditional power for Means # .getConditionalPowerMeansMultiArm <- function(..., stageResults, stage = stageResults$stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaH1 = NA_real_, assumedStDevs = NA_real_, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { stDevsH1 <- .getOptionalArgument("stDevsH1", ...) if (!is.null(stDevsH1) && !is.na(stDevsH1)) { if (!is.na(assumedStDevs)) { warning(sQuote("assumedStDevs"), " will be ignored because ", sQuote("stDevsH1"), " is defined", call. = FALSE ) } assumedStDevs <- stDevsH1 } design <- stageResults$.design gMax <- stageResults$getGMax() kMax <- design$kMax results <- ConditionalPowerResultsMultiArmMeans( .design = design, .stageResults = stageResults, thetaH1 = thetaH1, assumedStDevs = assumedStDevs, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned ) if (any(is.na(nPlanned))) { return(results) } .assertIsValidStage(stage, kMax) if (stage == kMax) { .logDebug( "Conditional power will be calculated only for subsequent stages ", "(stage = ", stage, ", kMax = ", kMax, ")" ) return(results) } if (!.isValidNPlanned(nPlanned = nPlanned, kMax = kMax, stage = stage)) { return(results) } .assertIsValidNPlanned(nPlanned, kMax, stage) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) .setValueAndParameterType(results, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT) assumedStDevs <- .assertIsValidAssumedStDevForMultiHypotheses( assumedStDevs, stageResults, stage, results = results ) thetaH1 <- .assertIsValidThetaH1ForMultiArm(thetaH1, stageResults, stage, results = results) results$.setParameterType("nPlanned", C_PARAM_USER_DEFINED) if (length(thetaH1) != 1 && length(thetaH1) != gMax) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sprintf(paste0( "length of 'thetaH1' (%s) ", "must be equal to 'gMax' (%s) or 1" ), .arrayToString(thetaH1), gMax) ) } if (length(assumedStDevs) != 1 && length(assumedStDevs) != gMax) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sprintf(paste0( "length of 'assumedStDevs' (%s) ", "must be equal to 'gMax' (%s) or 1" ), .arrayToString(assumedStDevs), gMax) ) } if (length(assumedStDevs) == 1) { results$assumedStDevs <- rep(assumedStDevs, gMax) results$.setParameterType("assumedStDevs", C_PARAM_GENERATED) } if (.isTrialDesignInverseNormal(design)) { return(.getConditionalPowerMeansMultiArmInverseNormal( results = results, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, assumedStDevs = assumedStDevs, ... )) } else if (.isTrialDesignFisher(design)) { return(.getConditionalPowerMeansMultiArmFisher( results = results, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, assumedStDevs = assumedStDevs, iterations = iterations, seed = seed, ... )) } else if (.isTrialDesignConditionalDunnett(design)) { return(.getConditionalPowerMeansMultiArmConditionalDunnett( results = results, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, assumedStDevs = assumedStDevs, ... )) } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'design' must be an instance of TrialDesignInverseNormal, TrialDesignFisher, or ", "TrialDesignConditionalDunnett" ) } # # Calculation of conditional power based on inverse normal method # .getConditionalPowerMeansMultiArmInverseNormal <- function(..., results, stageResults, stage, allocationRatioPlanned, nPlanned, thetaH1, assumedStDevs) { design <- stageResults$.design .assertIsTrialDesignInverseNormal(design) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerMeansMultiArmInverseNormal", ignore = c("stage", "design", "stDevsH1"), ... ) kMax <- design$kMax gMax <- stageResults$getGMax() # results$conditionalPower <- matrix(NA_real_, nrow = gMax, ncol = kMax) weights <- .getWeightsInverseNormal(design) informationRates <- design$informationRates nPlanned <- c(rep(NA_real_, stage), nPlanned) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned if (length(thetaH1) == 1) { thetaH1 <- rep(thetaH1, gMax) results$.setParameterType("thetaH1", C_PARAM_GENERATED) } else { results$.setParameterType("thetaH1", C_PARAM_DEFAULT_VALUE) } results$.setParameterType("assumedStDevs", C_PARAM_DEFAULT_VALUE) if (stageResults$directionUpper) { standardizedEffect <- (thetaH1 - stageResults$thetaH0) / assumedStDevs } else { standardizedEffect <- -(thetaH1 - stageResults$thetaH0) / assumedStDevs } ctr <- .performClosedCombinationTest(stageResults = stageResults) criticalValues <- design$criticalValues for (treatmentArm in 1:gMax) { if (!is.na(ctr$separatePValues[treatmentArm, stage])) { # shifted decision region for use in getGroupSeqProbs # Inverse Normal Method shiftedDecisionRegionUpper <- criticalValues[(stage + 1):kMax] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):kMax]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, treatmentArm] == 1, stage], na.rm = TRUE) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) - standardizedEffect[treatmentArm] * cumsum(sqrt(nPlanned[(stage + 1):kMax]) * weights[(stage + 1):kMax]) / sqrt(cumsum(weights[(stage + 1):kMax]^2)) if (stage == kMax - 1) { shiftedFutilityBounds <- c() } else { shiftedFutilityBounds <- design$futilityBounds[(stage + 1):(kMax - 1)] * sqrt(sum(weights[1:stage]^2) + cumsum(weights[(stage + 1):(kMax - 1)]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - min(ctr$overallAdjustedTestStatistics[ctr$indices[, treatmentArm] == 1, stage], na.rm = TRUE) * sqrt(sum(weights[1:stage]^2)) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) - standardizedEffect[treatmentArm] * cumsum(sqrt(nPlanned[(stage + 1):(kMax - 1)]) * weights[(stage + 1):(kMax - 1)]) / sqrt(cumsum(weights[(stage + 1):(kMax - 1)]^2)) } # scaled information for use in getGroupSeqProbs scaledInformation <- (informationRates[(stage + 1):kMax] - informationRates[stage]) / (1 - informationRates[stage]) decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, shiftedDecisionRegionUpper ), nrow = 2, byrow = TRUE) probs <- .getGroupSequentialProbabilities( decisionMatrix = decisionMatrix, informationRates = scaledInformation ) results$conditionalPower[treatmentArm, (stage + 1):kMax] <- cumsum(probs[3, ] - probs[2, ]) } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned results$nPlanned <- nPlanned results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$thetaH1 <- thetaH1 results$assumedStDevs <- assumedStDevs return(results) } # # Calculation of conditional power based on Fisher's combination test # .getConditionalPowerMeansMultiArmFisher <- function(..., results, stageResults, stage, allocationRatioPlanned, nPlanned, thetaH1, assumedStDevs, iterations, seed) { design <- stageResults$.design .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerMeansMultiArmFisher", ignore = c("stage", "design", "stDevsH1"), ... ) kMax <- design$kMax gMax <- stageResults$getGMax() criticalValues <- design$criticalValues weightsFisher <- .getWeightsFisher(design) # results$conditionalPower <- matrix(NA_real_, nrow = gMax, ncol = kMax) results$iterations <- as.integer(iterations) results$.setParameterType("iterations", C_PARAM_USER_DEFINED) results$.setParameterType("seed", ifelse(is.na(seed), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) results$seed <- .setSeed(seed) results$simulated <- FALSE results$.setParameterType("simulated", C_PARAM_DEFAULT_VALUE) if (length(thetaH1) == 1) { thetaH1 <- rep(thetaH1, gMax) results$.setParameterType("thetaH1", C_PARAM_GENERATED) } else { results$.setParameterType("thetaH1", C_PARAM_DEFAULT_VALUE) } results$.setParameterType("assumedStDevs", C_PARAM_DEFAULT_VALUE) if (stageResults$directionUpper) { standardizedEffect <- (thetaH1 - stageResults$thetaH0) / assumedStDevs } else { standardizedEffect <- -(thetaH1 - stageResults$thetaH0) / assumedStDevs } nPlanned <- c(rep(NA_real_, stage), nPlanned) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned ctr <- .performClosedCombinationTest(stageResults = stageResults) for (treatmentArm in 1:gMax) { if (!is.na(ctr$separatePValues[treatmentArm, stage])) { if (gMax == 1) { pValues <- ctr$adjustedStageWisePValues[ctr$indices[, treatmentArm] == 1, ][1:stage] } else { pValues <- ctr$adjustedStageWisePValues[ctr$indices[, treatmentArm] == 1, ][which.max( ctr$overallAdjustedTestStatistics[ctr$indices[, treatmentArm] == 1, stage] ), 1:stage] } if (stage < kMax - 1) { for (k in (stage + 1):kMax) { reject <- 0 for (i in 1:iterations) { reject <- reject + .getRejectValueConditionalPowerFisher( kMax = kMax, alpha0Vec = design$alpha0Vec, criticalValues = criticalValues, weightsFisher = weightsFisher, pValues = pValues, currentKMax = k, thetaH1 = standardizedEffect[treatmentArm], stage = stage, nPlanned = nPlanned ) } results$conditionalPower[treatmentArm, k] <- reject / iterations } results$simulated <- TRUE results$.setParameterType("simulated", C_PARAM_GENERATED) } else if (stage == kMax - 1) { divisor <- prod(pValues[1:(kMax - 1)]^weightsFisher[1:(kMax - 1)]) result <- 1 - (criticalValues[kMax] / divisor)^(1 / weightsFisher[kMax]) if (result <= 0 || result >= 1) { warning("Calculation not possible: could not calculate ", "conditional power for stage ", kMax, call. = FALSE ) results$conditionalPower[treatmentArm, kMax] <- NA_real_ } else { results$conditionalPower[treatmentArm, kMax] <- 1 - stats::pnorm(.getQNorm(result) - standardizedEffect[treatmentArm] * sqrt(nPlanned[kMax])) } } } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned results$nPlanned <- nPlanned results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$thetaH1 <- thetaH1 results$assumedStDevs <- assumedStDevs if (!results$simulated) { results$iterations <- NA_integer_ results$seed <- NA_real_ results$.setParameterType("iterations", C_PARAM_NOT_APPLICABLE) results$.setParameterType("seed", C_PARAM_NOT_APPLICABLE) } return(results) } # # Calculation of conditional power based on conditional Dunnett test # .getConditionalPowerMeansMultiArmConditionalDunnett <- function(..., results, stageResults, stage, allocationRatioPlanned, nPlanned, thetaH1, assumedStDevs) { design <- stageResults$.design .assertIsTrialDesignConditionalDunnett(design) .warnInCaseOfUnknownArguments( functionName = ".getConditionalPowerMeansMultiArmConditionalDunnett", ignore = c("stage", "intersectionTest", "design", "stDevsH1"), ... ) if (stage > 1) { warning("Conditional power is only calculated for the first (interim) stage", call. = FALSE) } kMax <- 2 gMax <- stageResults$getGMax() nPlanned <- c(rep(NA_real_, stage), nPlanned) nPlanned <- allocationRatioPlanned / (1 + allocationRatioPlanned)^2 * nPlanned if (length(thetaH1) == 1) { thetaH1 <- rep(thetaH1, gMax) results$.setParameterType("thetaH1", C_PARAM_GENERATED) } else { results$.setParameterType("thetaH1", C_PARAM_DEFAULT_VALUE) } results$.setParameterType("assumedStDevs", C_PARAM_DEFAULT_VALUE) if (stageResults$directionUpper) { standardizedEffect <- (thetaH1 - stageResults$thetaH0) / assumedStDevs } else { standardizedEffect <- -(thetaH1 - stageResults$thetaH0) / assumedStDevs } ctr <- .getClosedConditionalDunnettTestResults(stageResults = stageResults, design = design, stage = stage) for (treatmentArm in 1:gMax) { if (!is.na(ctr$separatePValues[treatmentArm, stage])) { results$conditionalPower[treatmentArm, 2] <- 1 - stats::pnorm(.getOneMinusQNorm(min(ctr$conditionalErrorRate[ ctr$indices[, treatmentArm] == 1, stage ], na.rm = TRUE)) - standardizedEffect[treatmentArm] * sqrt(nPlanned[2])) } } nPlanned <- (1 + allocationRatioPlanned)^2 / allocationRatioPlanned * nPlanned results$nPlanned <- nPlanned results$.setParameterType("nPlanned", C_PARAM_GENERATED) results$.setParameterType("conditionalPower", C_PARAM_GENERATED) results$thetaH1 <- thetaH1 results$assumedStDevs <- assumedStDevs return(results) } # # Calculation of conditional power and likelihood values for plotting the graph # .getConditionalPowerLikelihoodMeansMultiArm <- function(..., stageResults, stage, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaRange, assumedStDevs = NA_real_, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .associatedArgumentsAreDefined(nPlanned = nPlanned, thetaRange = thetaRange) .assertIsSingleNumber(allocationRatioPlanned, "allocationRatioPlanned") .assertIsInOpenInterval(allocationRatioPlanned, "allocationRatioPlanned", 0, C_ALLOCATION_RATIO_MAXIMUM) design <- stageResults$.design kMax <- design$kMax gMax <- stageResults$getGMax() intersectionTest <- stageResults$intersectionTest assumedStDevs <- .assertIsValidAssumedStDevForMultiHypotheses(assumedStDevs, stageResults, stage) if (length(assumedStDevs) == 1) { assumedStDevs <- rep(assumedStDevs, gMax) } thetaRange <- .assertIsValidThetaRange(thetaRange = thetaRange) treatmentArms <- numeric(gMax * length(thetaRange)) effectValues <- numeric(gMax * length(thetaRange)) condPowerValues <- numeric(gMax * length(thetaRange)) likelihoodValues <- numeric(gMax * length(thetaRange)) stdErr <- stageResults$overallStDevs[, stage] * sqrt(1 / stageResults$.dataInput$getOverallSampleSizes(stage = stage, group = gMax + 1) + 1 / stageResults$.dataInput$getOverallSampleSizes(stage = stage, group = (1:gMax))) results <- ConditionalPowerResultsMultiArmMeans( .design = design, .stageResults = stageResults, assumedStDevs = assumedStDevs, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned ) j <- 1 for (i in seq(along = thetaRange)) { for (treatmentArm in 1:gMax) { treatmentArms[j] <- treatmentArm effectValues[j] <- thetaRange[i] if (.isTrialDesignInverseNormal(design)) { condPowerValues[j] <- .getConditionalPowerMeansMultiArmInverseNormal( results = results, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i], assumedStDevs = assumedStDevs )$conditionalPower[treatmentArm, kMax] } else if (.isTrialDesignFisher(design)) { condPowerValues[j] <- .getConditionalPowerMeansMultiArmFisher( results = results, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i], assumedStDevs = assumedStDevs, iterations = iterations, seed = seed )$conditionalPower[treatmentArm, kMax] } else if (.isTrialDesignConditionalDunnett(design)) { condPowerValues[j] <- .getConditionalPowerMeansMultiArmConditionalDunnett( results = results, stageResults = stageResults, stage = stage, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaRange[i], assumedStDevs = assumedStDevs )$conditionalPower[treatmentArm, 2] } likelihoodValues[j] <- stats::dnorm( thetaRange[i], stageResults$effectSizes[treatmentArm, stage], stdErr[treatmentArm] ) / stats::dnorm(0, 0, stdErr[treatmentArm]) j <- j + 1 } } subtitle <- paste0( "Intersection test = ", intersectionTest, ", stage = ", stage, ", # of remaining subjects = ", sum(nPlanned), ", sd = ", .formatSubTitleValue(assumedStDevs, "assumedStDevs"), ", allocation ratio = ", .formatSubTitleValue(allocationRatioPlanned, "allocationRatioPlanned") ) return(list( treatmentArms = treatmentArms, xValues = effectValues, condPowerValues = condPowerValues, likelihoodValues = likelihoodValues, main = C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, xlab = "Effect size", ylab = C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, sub = subtitle )) } rpact/inst/0000755000175000017500000000000014165536100012473 5ustar nileshnileshrpact/inst/extdata/0000755000175000017500000000000014070776016014134 5ustar nileshnileshrpact/inst/extdata/dataset_means_multi-arm.csv0000644000175000017500000000060514017174147021447 0ustar nileshnilesh"stages","groups","sampleSizes","means","stDevs","overallSampleSizes","overallMeans","overallStDevs" 1,1,13,242,244,13,242,244 1,2,15,188,212,15,188,212 1,3,14,267,256,14,267,256 1,4,12,92,215,12,92,215 2,1,25,222,221,38,228.842105263158,226.013456465663 2,2,NA,NA,NA,NA,NA,NA 2,3,27,277,232,41,273.585365853659,237.292749110646 2,4,29,122,227,41,113.219512195122,221.29878131105 rpact/inst/extdata/dataset_rates_multi-arm.csv0000644000175000017500000000024114017174147021456 0ustar nileshnilesh"stages","groups","sampleSizes","events" 1,1,11,10 1,2,8,3 1,3,7,2 2,1,13,10 2,2,10,5 2,3,10,4 3,1,12,12 3,2,9,5 3,3,8,3 4,1,13,12 4,2,11,6 4,3,9,5 rpact/inst/extdata/dataset_rates.csv0000644000175000017500000000031614017174147017472 0ustar nileshnilesh"stages","groups","sampleSizes","events","overallSampleSizes","overallEvents" 1,1,11,10,11,10 1,2,8,3,8,3 2,1,13,10,24,20 2,2,10,5,18,8 3,1,12,12,36,32 3,2,9,5,27,13 4,1,13,12,49,44 4,2,11,6,38,19 rpact/inst/extdata/datasets_rates.csv0000644000175000017500000000056714017174147017665 0ustar nileshnilesh"datasetId","stages","groups","sampleSizes","events","overallSampleSizes","overallEvents" 1,1,1,11,10,11,10 1,1,2,8,3,8,3 1,2,1,13,10,24,20 1,2,2,10,5,18,8 1,3,1,12,12,36,32 1,3,2,9,5,27,13 1,4,1,13,12,49,44 1,4,2,11,6,38,19 2,1,1,9,10,9,10 2,1,2,6,4,6,4 2,2,1,13,10,22,20 2,2,2,10,5,16,9 2,3,1,12,12,34,32 2,3,2,9,5,25,14 2,4,1,13,12,47,44 2,4,2,11,6,36,20 rpact/inst/extdata/dataset_survival_multi-arm.csv0000644000175000017500000000043714017174147022222 0ustar nileshnilesh"stages","groups","overallEvents","overallAllocationRatios","overallLogRanks","events","allocationRatios","logRanks" 1,1,25,1,2.2,25,1,2.2 1,2,18,1,1.99,18,1,1.99 1,3,22,1,2.32,22,1,2.32 2,1,57,1,2.80566916144919,32,1,1.8 2,2,NA,NA,NA,NA,NA,NA 2,3,58,1,3.09118512796343,36,1,2.11 rpact/inst/tests/0000755000175000017500000000000014070776016013644 5ustar nileshnileshrpact/inst/tests/testthat/0000755000175000017500000000000014165541122015475 5ustar nileshnileshrpact/inst/tests/testthat/test-rpact.R0000644000175000017500000002646114145656365017735 0ustar nileshnilesh## | ## | *Unit tests* ## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis ## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 ## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org ## | ## | Contact us for information about our services: info@rpact.com ## | ## | File name: test-rpact.R ## | Creation date: 21 April 2021, 15:04:49 ## | File version: $Revision: 5577 $ ## | Last changed: $Date: 2021-11-19 09:14:42 +0100 (Fr, 19 Nov 2021) $ ## | Last changed by: $Author: pahlke $ ## | context("Testing the rpact package") test_that("'getDesignInverseNormal' with default parameters: parameters and results are as expected", { designInverseNormal <- getDesignInverseNormal() expect_equal(designInverseNormal$alphaSpent, c(0.00025917372, 0.0071600594, 0.02499999), tolerance = 1e-07) expect_equal(designInverseNormal$criticalValues, c(3.4710914, 2.4544323, 2.0040356), tolerance = 1e-07) expect_equal(designInverseNormal$stageLevels, c(0.00025917372, 0.0070553616, 0.022533125), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(designInverseNormal), NA))) expect_output(print(designInverseNormal)$show()) invisible(capture.output(expect_error(summary(designInverseNormal), NA))) expect_output(summary(designInverseNormal)$show()) } }) test_that("'getDesignFisher' with default parameters: parameters and results are as expected", { designFisher <- getDesignFisher() expect_equal(designFisher$alphaSpent, c(0.012308547, 0.01962413, 0.025), tolerance = 1e-07) expect_equal(designFisher$criticalValues, c(0.012308547, 0.0016635923, 0.00029106687), tolerance = 1e-07) expect_equal(designFisher$stageLevels, c(0.012308547, 0.012308547, 0.012308547), tolerance = 1e-07) expect_equal(designFisher$scale, c(1, 1)) expect_equal(designFisher$nonStochasticCurtailment, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(designFisher), NA))) expect_output(print(designFisher)$show()) invisible(capture.output(expect_error(summary(designFisher), NA))) expect_output(summary(designFisher)$show()) } }) test_that("Testing 'getPiecewiseSurvivalTime': simple vector based definition", { pwSurvivalTime1 <- getPiecewiseSurvivalTime(lambda2 = 0.5, hazardRatio = 0.8) expect_equal(pwSurvivalTime1$piecewiseSurvivalTime, 0) expect_equal(pwSurvivalTime1$lambda1, 0.4, tolerance = 1e-07) expect_equal(pwSurvivalTime1$lambda2, 0.5, tolerance = 1e-07) expect_equal(pwSurvivalTime1$hazardRatio, 0.8, tolerance = 1e-07) expect_equal(pwSurvivalTime1$pi1, NA_real_) expect_equal(pwSurvivalTime1$pi2, NA_real_) expect_equal(pwSurvivalTime1$median1, 1.732868, tolerance = 1e-07) expect_equal(pwSurvivalTime1$median2, 1.3862944, tolerance = 1e-07) expect_equal(pwSurvivalTime1$eventTime, NA_real_) expect_equal(pwSurvivalTime1$kappa, 1) expect_equal(pwSurvivalTime1$piecewiseSurvivalEnabled, FALSE) expect_equal(pwSurvivalTime1$delayedResponseAllowed, FALSE) expect_equal(pwSurvivalTime1$delayedResponseEnabled, FALSE) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(pwSurvivalTime1), NA))) expect_output(print(pwSurvivalTime1)$show()) invisible(capture.output(expect_error(summary(pwSurvivalTime1), NA))) expect_output(summary(pwSurvivalTime1)$show()) } }) test_that("'getSampleSizeMeans': Sample size calculation of testing means for one sided group sequential design", { designGS1pretest <- getDesignGroupSequential(informationRates = c(0.2,0.5,1), sided = 1, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) expect_equal(designGS1pretest$alphaSpent, c(0.0020595603, 0.0098772988, 0.02499999), tolerance = 1e-07) expect_equal(designGS1pretest$criticalValues, c(2.8688923, 2.3885055, 2.0793148), tolerance = 1e-07) expect_equal(designGS1pretest$stageLevels, c(0.0020595603, 0.0084585282, 0.018794214), tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(designGS1pretest), NA))) expect_output(print(designGS1pretest)$show()) invisible(capture.output(expect_error(summary(designGS1pretest), NA))) expect_output(summary(designGS1pretest)$show()) } designGS1 <- getDesignGroupSequential(informationRates = c(0.2,0.5,1), sided = 1, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) sampleSizeResult <- getSampleSizeMeans(designGS1, groups = 1, thetaH0 = 0.5, stDev = 2, normalApproximation = FALSE, alternative = 0.8) expect_equal(sampleSizeResult$maxNumberOfSubjects, 494.6455, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[1, ], 98.929099, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[2, ], 247.32275, tolerance = 1e-07) expect_equal(sampleSizeResult$numberOfSubjects[3, ], 494.6455, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH0, 491.89699, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH01, 462.87248, tolerance = 1e-07) expect_equal(sampleSizeResult$expectedNumberOfSubjectsH1, 360.24062, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[1, ], 0.08379162, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[2, ], 0.40937259, tolerance = 1e-07) expect_equal(sampleSizeResult$rejectPerStage[3, ], 0.40683579, tolerance = 1e-07) expect_equal(sampleSizeResult$earlyStop, 0.49316421, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[1, ], 1.090771, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[2, ], 0.80583608, tolerance = 1e-07) expect_equal(sampleSizeResult$criticalValuesEffectScale[3, ], 0.68748891, tolerance = 1e-07) if (isTRUE(.isCompleteUnitTestSetEnabled())) { invisible(capture.output(expect_error(print(sampleSizeResult), NA))) expect_output(print(sampleSizeResult)$show()) invisible(capture.output(expect_error(summary(sampleSizeResult), NA))) expect_output(summary(sampleSizeResult)$show()) } }) test_that("Testing generic functions: no errors occur", { .skipTestIfDisabled() design <- getDesignGroupSequential(alpha = 0.05, kMax = 4, sided = 1, typeOfDesign = "WT", deltaWT = 0.1) designFisher <- getDesignFisher(kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.5, 0.8, 1), alpha0Vec = rep(0.4, 3)) designCharacteristics <- getDesignCharacteristics(design) powerAndASN <- getPowerAndAverageSampleNumber(design, theta = 1, nMax = 100) designSet <- getDesignSet(design = design, deltaWT = c(0.3, 0.4)) dataset <- getDataset( n1 = c(22, 11, 22, 11), n2 = c(22, 13, 22, 13), means1 = c(1, 1.1, 1, 1), means2 = c(1.4, 1.5, 3, 2.5), stDevs1 = c(1, 2, 2, 1.3), stDevs2 = c(1, 2, 2, 1.3) ) stageResults <- getStageResults(design, dataset) suppressWarnings(designPlan <- getSampleSizeMeans(design)) simulationResults <- getSimulationSurvival(design, maxNumberOfSubjects = 1200, plannedEvents = c(50, 100, 150, 200), seed = 12345) piecewiseSurvivalTime <- getPiecewiseSurvivalTime(list( "0 - <6" = 0.025, "6 - <9" = 0.04, "9 - <15" = 0.015, "15 - <21" = 0.01, ">=21" = 0.007), hazardRatio = 0.8) accrualTime <- getAccrualTime(list( "0 - <12" = 15, "12 - <13" = 21, "13 - <14" = 27, "14 - <15" = 33, "15 - <16" = 39, ">=16" = 45), maxNumberOfSubjects = 1400) expect_vector(names(design)) expect_vector(names(designFisher)) expect_vector(names(designCharacteristics)) expect_vector(names(powerAndASN)) expect_vector(names(designSet)) expect_vector(names(dataset)) expect_vector(names(stageResults)) expect_vector(names(designPlan)) expect_vector(names(simulationResults)) expect_vector(names(piecewiseSurvivalTime)) expect_vector(names(accrualTime)) expect_output(print(design)) expect_output(print(designFisher)) expect_output(print(designCharacteristics)) expect_output(print(powerAndASN)) expect_output(print(designSet)) expect_output(print(dataset)) expect_output(print(stageResults)) expect_output(print(designPlan)) expect_output(print(simulationResults)) expect_output(print(piecewiseSurvivalTime)) expect_output(print(accrualTime)) expect_output(summary(design)$show()) expect_output(summary(designFisher)$show()) expect_output(summary(designCharacteristics)$show()) expect_output(summary(powerAndASN)) expect_output(print(summary(designSet))) expect_output(summary(dataset)$show()) expect_output(summary(stageResults)) expect_output(summary(designPlan)$show()) expect_output(summary(simulationResults)$show()) expect_output(summary(piecewiseSurvivalTime)) expect_output(summary(accrualTime)) expect_named(as.data.frame(design)) expect_named(as.data.frame(designFisher)) expect_named(as.data.frame(designCharacteristics)) expect_named(as.data.frame(powerAndASN)) expect_named(as.data.frame(designSet)) expect_named(as.data.frame(dataset)) expect_named(as.data.frame(stageResults)) expect_named(as.data.frame(designPlan)) expect_named(as.data.frame(simulationResults)) expect_named(as.data.frame(piecewiseSurvivalTime)) expect_named(as.data.frame(accrualTime)) expect_is(as.data.frame(design, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(designFisher, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(designCharacteristics, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(powerAndASN, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(designSet, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(dataset, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(stageResults, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(designPlan, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(simulationResults, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(piecewiseSurvivalTime, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.data.frame(accrualTime, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.matrix(design), "matrix") expect_is(as.matrix(designFisher), "matrix") expect_is(as.matrix(designCharacteristics), "matrix") expect_is(as.matrix(powerAndASN), "matrix") expect_is(as.matrix(designSet), "matrix") expect_is(as.matrix(dataset), "matrix") expect_is(as.matrix(stageResults), "matrix") expect_is(as.matrix(designPlan), "matrix") expect_is(as.matrix(simulationResults), "matrix") expect_is(as.matrix(piecewiseSurvivalTime), "matrix") expect_is(as.matrix(accrualTime), "matrix") suppressWarnings(analysisResults <- getAnalysisResults(design, dataset)) expect_vector(names(analysisResults)) expect_output(print(analysisResults)) expect_output(summary(analysisResults)$show()) expect_named(as.data.frame(analysisResults)) expect_is(as.data.frame(analysisResults, niceColumnNamesEnabled = FALSE), "data.frame") expect_is(as.matrix(analysisResults), "matrix") })rpact/inst/tests/testthat.R0000644000175000017500000000007414017174147015626 0ustar nileshnilesh library(testthat) library(rpact) test_check("rpact") rpact/inst/doc/0000755000175000017500000000000014165536076013254 5ustar nileshnileshrpact/inst/doc/rpact_getting_started.html0000644000175000017500000003465314165536076020535 0ustar nileshnilesh Getting started with rpact

Getting started with rpact

Friedrich Pahlke and Gernot Wassmer

2022-01-06

Confirmatory Adaptive Clinical Trial Design, Simulation, and Analysis.

Functional Range

  • Sample size and power calculation for
    • means (continuous endpoint)
    • rates (binary endpoint)
    • survival trials with
      • piecewise accrual time and intensity
      • piecewise exponential survival time
      • survival times that follow a Weibull distribution
  • Fixed sample design and designs with interim analysis stages
  • Simulation tool for means, rates, and survival data
    • Assessment of adaptive sample size/event number recalculations based on conditional power
    • Assessment of treatment selection strategies in multi-arm trials
  • Adaptive analysis of means, rates, and survival data
  • Adaptive designs and analysis for multi-arm trials
  • Simulation and analysis for enrichment designs testing means, rates, and hazard ratios

Learn to use rpact

We recommend three ways to learn how to use rpact:

  1. Use the Shiny app: shiny.rpact.com
  2. Use the Vignettes: www.rpact.com/vignettes
  3. Book a training: www.rpact.com

Vignettes

The vignettes are hosted at www.rpact.com/vignettes and cover the following topics:

  1. Defining group-sequential boundaries
  2. Designing group-sequential trials with two groups and a continuous endpoint
  3. Designing group-sequential trials with a binary endpoint
  4. Designing group-sequential trials with two groups and a survival endpoint
  5. Simulation-based design of group-sequential trials with a survival endpoint
  6. An example to illustrate boundary re-calculations during the trial
  7. Analysis of a group-sequential trial with a survival endpoint
  8. Defining accrual time and accrual intensity
  9. How to use R generics with rpact
  10. How to create admirable plots with rpact
  11. Comparing sample size and power calculation results for a group-sequential trial with a survival endpoint: rpact vs. gsDesign
  12. Supplementing and enhancing rpact’s graphical capabilities with ggplot2
  13. Using the inverse normal combination test for analyzing a trial with continuous endpoint and potential sample size reassessment
  14. Planning a trial with binary endpoints
  15. Planning a survival trial
  16. Simulation of a trial with a binary endpoint and unblinded sample size re-calculation
  17. How to create summaries
  18. How to create analysis result (one- and multi-arm) plots
  19. How to create simulation result (one- and multi-arm) plots
  20. Simulating multi-arm designs with a continuous endpoint
  21. Analysis of a multi-arm design with a binary endpoint
  22. Step-by-Step rpact Tutorial
  23. Planning and Analyzing a Group-Sequential Multi-Arm-Multi-Stage Design with Binary Endpoint using rpact
  24. Two-arm analysis for continuous data with covariates from raw data (exclusive)
  25. How to install the latest developer version (exclusive)

User Concept

Workflow

  • Everything is starting with a design, e.g.: design <- getDesignGroupSequential()
  • Find the optimal design parameters with help of rpact comparison tools: getDesignSet
  • Calculate the required sample size, e.g.: getSampleSizeMeans(), getPowerMeans()
  • Simulate specific characteristics of an adaptive design, e.g.: getSimulationMeans()
  • Collect your data, import it into R and create a dataset: data <- getDataset()
  • Analyze your data: getAnalysisResults(design, data)

Focus on Usability

The most important rpact functions have intuitive names:

  • getDesign[GroupSequential/InverseNormal/Fisher]()
  • getDesignCharacteristics()
  • getSampleSize[Means/Rates/Survival]()
  • getPower[Means/Rates/Survival]()
  • getSimulation[MultiArm/Enrichment]`[Means/Rates/Survival]()`
  • getDataSet()
  • getAnalysisResults()
  • getStageResults()

RStudio/Eclipse: auto code completion makes it easy to use these functions.

R generics

In general, everything runs with the R standard functions which are always present in R: so-called R generics, e.g., print, summary, plot, as.data.frame, names, length

Utilities

Several utility functions are available, e.g.

  • getAccrualTime()
  • getPiecewiseSurvivalTime()
  • getNumberOfSubjects()
  • getEventProbabilities()
  • getPiecewiseExponentialDistribution()
  • survival helper functions for conversion of pi, lambda and median, e.g., getLambdaByMedian()
  • testPackage(): installation qualification on a client computer or company server (via unit tests)

Validation

Please contact us to learn how to use rpact on FDA/GxP-compliant validated corporate computer systems and how to get a copy of the formal validation documentation that is customized and licensed for exclusive use by your company, e.g., to fulfill regulatory requirements.

About

  • rpact is a comprehensive validated1 R package for clinical research which
    • enables the design and analysis of confirmatory adaptive group sequential designs
    • is a powerful sample size calculator
    • is a free of charge open-source software licensed under LGPL-3
    • particularly, implements the methods described in the recent monograph by Wassmer and Brannath (2016)

For more information please visit www.rpact.org

  • RPACT is a company which offers
    • enterprise software development services
    • technical support for the rpact package
    • consultancy and user training for clinical research using R
    • validated software solutions and R package development for clinical research

For more information please visit www.rpact.com

  1. The rpact validation documentation is available exclusively for our customers and supporting companies. For more information visit www.rpact.com/services/sla↩︎

rpact/inst/doc/rpact_getting_started.Rmd0000644000175000017500000001550614156312023020267 0ustar nileshnilesh--- title: "Getting started with rpact" author: "Friedrich Pahlke and Gernot Wassmer" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Getting started with rpact} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` Confirmatory Adaptive Clinical Trial Design, Simulation, and Analysis. ## Functional Range * Sample size and power calculation for + means (continuous endpoint) + rates (binary endpoint) + survival trials with - piecewise accrual time and intensity - piecewise exponential survival time - survival times that follow a Weibull distribution * Fixed sample design and designs with interim analysis stages * Simulation tool for means, rates, and survival data + Assessment of adaptive sample size/event number recalculations based on conditional power + Assessment of treatment selection strategies in multi-arm trials * Adaptive analysis of means, rates, and survival data * Adaptive designs and analysis for multi-arm trials * Simulation and analysis for enrichment designs testing means, rates, and hazard ratios ## Learn to use rpact We recommend three ways to learn how to use `rpact`: > 1. Use the Shiny app: [shiny.rpact.com](https://www.rpact.com/products#public-rpact-shiny-app) > 2. Use the Vignettes: > [www.rpact.com/vignettes](https://www.rpact.com/vignettes) > 3. Book a training: > [www.rpact.com](https://www.rpact.com/services#learning-and-training) ### Vignettes The vignettes are hosted at [www.rpact.com/vignettes](https://www.rpact.com/vignettes) and cover the following topics: 1. Defining group-sequential boundaries 2. Designing group-sequential trials with two groups and a continuous endpoint 3. Designing group-sequential trials with a binary endpoint 4. Designing group-sequential trials with two groups and a survival endpoint 5. Simulation-based design of group-sequential trials with a survival endpoint 6. An example to illustrate boundary re-calculations during the trial 7. Analysis of a group-sequential trial with a survival endpoint 8. Defining accrual time and accrual intensity 9. How to use R generics with `rpact` 10. How to create admirable plots with `rpact` 11. Comparing sample size and power calculation results for a group-sequential trial with a survival endpoint: [rpact](https://cran.r-project.org/package=rpact) vs. [gsDesign](https://cran.r-project.org/package=gsDesign) 12. Supplementing and enhancing rpact's graphical capabilities with [ggplot2](https://cran.r-project.org/package=ggplot2) 13. Using the inverse normal combination test for analyzing a trial with continuous endpoint and potential sample size reassessment 14. Planning a trial with binary endpoints 15. Planning a survival trial 16. Simulation of a trial with a binary endpoint and unblinded sample size re-calculation 17. How to create summaries 18. How to create analysis result (one- and multi-arm) plots 19. How to create simulation result (one- and multi-arm) plots 20. Simulating multi-arm designs with a continuous endpoint 21. Analysis of a multi-arm design with a binary endpoint 22. Step-by-Step rpact Tutorial 23. Planning and Analyzing a Group-Sequential Multi-Arm-Multi-Stage Design with Binary Endpoint using rpact 24. Two-arm analysis for continuous data with covariates from raw data (*exclusive*) 25. How to install the latest developer version (*exclusive*) ## User Concept ### Workflow * Everything is starting with a design, e.g.: `design <- getDesignGroupSequential()` * Find the optimal design parameters with help of `rpact` comparison tools: `getDesignSet` * Calculate the required sample size, e.g.: `getSampleSizeMeans()`, `getPowerMeans()` * Simulate specific characteristics of an adaptive design, e.g.: `getSimulationMeans()` * Collect your data, import it into R and create a dataset: `data <- getDataset()` * Analyze your data: `getAnalysisResults(design, data)` ### Focus on Usability The most important `rpact` functions have intuitive names: * `getDesign`[`GroupSequential`/`InverseNormal`/`Fisher`]`()` * `getDesignCharacteristics()` * `getSampleSize`[`Means`/`Rates`/`Survival`]`()` * `getPower`[`Means`/`Rates`/`Survival`]`()` * `getSimulation`[`MultiArm`/`Enrichment`]``[`Means`/`Rates`/`Survival`]`()` * `getDataSet()` * `getAnalysisResults()` * `getStageResults()` RStudio/Eclipse: auto code completion makes it easy to use these functions. ### R generics In general, everything runs with the R standard functions which are always present in R: so-called R generics, e.g., `print`, `summary`, `plot`, `as.data.frame`, `names`, `length` ### Utilities Several utility functions are available, e.g. * `getAccrualTime()` * `getPiecewiseSurvivalTime()` * `getNumberOfSubjects()` * `getEventProbabilities()` * `getPiecewiseExponentialDistribution()` * survival helper functions for conversion of `pi`, `lambda` and `median`, e.g., `getLambdaByMedian()` * `testPackage()`: installation qualification on a client computer or company server (via unit tests) ## Validation Please [contact](https://www.rpact.com/contact) us to learn how to use `rpact` on FDA/GxP-compliant validated corporate computer systems and how to get a copy of the formal validation documentation that is customized and licensed for exclusive use by your company, e.g., to fulfill regulatory requirements. ## About * **rpact** is a comprehensive validated^[The rpact validation documentation is available exclusively for our customers and supporting companies. For more information visit [www.rpact.com/services/sla](https://www.rpact.com/services/sla)] R package for clinical research which + enables the design and analysis of confirmatory adaptive group sequential designs + is a powerful sample size calculator + is a free of charge open-source software licensed under [LGPL-3](https://cran.r-project.org/web/licenses/LGPL-3) + particularly, implements the methods described in the recent monograph by [Wassmer and Brannath (2016)](https://doi.org/10.1007%2F978-3-319-32562-0) > For more information please visit [www.rpact.org](https://www.rpact.org) * **RPACT** is a company which offers + enterprise software development services + technical support for the `rpact` package + consultancy and user training for clinical research using R + validated software solutions and R package development for clinical research > For more information please visit [www.rpact.com](https://www.rpact.com) ## Contact * [info@rpact.com](mailto:info@rpact.com) * [www.rpact.com/contact](https://www.rpact.com/contact) rpact/inst/doc/rpact_getting_started.R0000644000175000017500000000022514165536075017755 0ustar nileshnilesh## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) rpact/data/0000755000175000017500000000000014165535755012446 5ustar nileshnileshrpact/data/dataMeans.RData0000644000175000017500000000043014074226041015235 0ustar nileshnilesh r0b```f`a`e`f2؜ LXCmy&[I/%'7#5rpact/data/dataEnrichmentRatesStratified.RData0000644000175000017500000000063214074226041021310 0ustar nileshnileshTMO@]Z>BĄc!%ƓmRt+&^KI IIm(ͰP(6}+;p2}?m# x o qN9675}<UwwMGWKYu?]݀ɺsfv6RUsɗC{8]c ܘ G@2/v+)+MK#O\ZS9}[je21/%UoHY<䱦R &-.e<{WNG}~IgַχBgև.5K1鉧A(" W[# 6z xo…p.lu2! r J*کZ书ToR f+:訷V^z?~[rpact/data/dataMultiArmMeans.RData0000644000175000017500000000072414074226041016716 0ustar nileshnilesh r0b```f`a`e`f2؜ LX8X2D\©"uk@m- Bō΀Y 6C[oFUa>TLr&̂B0r&X9{L 7C>8qi>1r0{=ﯟ*F蓼{&%N, O>gC[. E$k^bnj1$IAيKӁ{qiRqj S[YZlE11el`3BL*qI-krPƨ\^ԢĜ`L`2-e[ f/Tٛ(F YFXE ΢r=XKD,}'bX r 9"~ L$rpact/data/dataMultiArmSurvival.RData0000644000175000017500000000052514074226041017465 0ustar nileshnilesh r0b```f`a`e`f2؜ LX,RF`A\Q*jU-8`!NHX ^ (y@~D$rpact/data/dataEnrichmentSurvivalStratified.RData0000644000175000017500000000072314074226041022046 0ustar nileshnileshTMN1.Qc;&.h\Hܸ0u(:0at'W^k<,\B+#F}ɛ{}Mb0 0P-Q/  'lIR3-];iSit-Wwp,-6YYgK2bU 4Ӵ'P#/C(U ΁] v',[Ecxu}<)-]N 083@(HE (| 3D ӇG7o_'R}Ƃ׹l 0T%LqCf`|/<ՂP`EwKW~#]}0}_|*iJdKM-f) [qIb:Pc/.M*N-qyRsr\ˀ &(tON, 0i~O~zPb^6L- D9r`PY_s>(0b X #L #Ҋ ֢ rpact/data/dataSurvival.RData0000644000175000017500000000045614074226041016015 0ustar nileshnilesh r0b```f`a`e`f2؜ LX޽qN˽g3XcmjWX{9Keq5rRQQiFU:sk%{J$^o:b='@$>ɏRBT%?D\H~w&jɿDc"%"'$")4","-9HK."RO'TDorw"97QL%Rݓ)rʥr) R.K9RNS.K9RO\)rʥr)\)rʥh/TPcd$:4 ,Z?(2<& ڶ_F/TZGhu:ZGhu:3|kՄX݈ԫ+6&< ^)=7@%ef|Yw;G΃9n\-+ ʲm܇29[dQY3 ʳlմĮzˡ4LMpv?[xgVGT@>C}`pXhb$\g, kأ]ǎ͒w<jcq2|^5VN:ә*p߳'Vs7N=l{N?,'j0ӿzyV6'j/rCrhmxLY[Sz ԙuT+rJR): Ss2ؑI ڷWj\=klwXM2'qa&I2׀7ӹ%'gþ,|>WMY3\ʴ>̇8{sŸA5p[Ӵ7<ND_cܾ2th;~c ܥiCThD ڄ pOiOL\u U>#t:6$fD8}j &.}YJOf7`+88 e :']fhm˙\ _I@V`>sn whǔW ÿU<\ 2o?(cqpކ֤.J73]$'<(nlp:)̴dt>w >tz:$'6vso*^U'!BbhG OsfvpOx 'oo? {5K֔Ԃ{cn L^6"N) #KO 2{-θY}6qSB5rbXk{{kVMm)ٌ2YM ONe5Ċs_ᡢaVܛ_}eL.;~^I_,SovoHk\T8R.M}[(nᡙsP~,4arflDz4ݲ]k|x[¦n!L.,ԫ)"чvG9?3fӂŇfcI*__5vE.3M~Jk׹f|?ꁏ'${W3 ~\w؉$VfԶB&-fg㰳*vrGXy xހHeZo;g}x^vcJ3%DlֺnO߉rJ")20ܰ"*jpnM1/~ʌ܉jV{6vzQ1ZmRd'$EikL.h2XU^8,3pM !zwG`WYgH(ʮW.MOkpaNKl S9M4.b^o':ëc@2u߶7D9~->=Akc]F'A{H><L)Z%@vgUt;pM<\fF.8b!\$zAp5E *(w%^ vz*:ܯ7ޅ〹xslFLwqwl;Ayںk4!D3.2rvh8bSG\z?}g /zTo9"8m:.lŅL42=-j!&ߥ}7p;qbMpypM_qnyO,]wN3жd6w{ i<;;k\-\:L̓۔ۆAX̋}p-*}˩W-|n?~Fb7<_̘bl<Tl 򘍶f7x-d7ǚD>1݁=#V@t7^L?𮣐 {ZN`J5$Ӧ7~Ӣ x.Q'U!HnܑoѲij?K ;\ȂϹuJL_jtr7|La~<c׾*y#_L]q  o+]NfaߡL?rkEkICNK|Ke>Z&8yyf3Fv鹏J;S |MݾeHk{y^z̵m~U`NYz̊xp G m1k f5uy3wѯMT%o?{>c1pm~~dwR{hrx\ۖW_'?>dQp>)nǟޚwI1j< ic,`8?y_)0Tr#zCgå`zsZ x]rd6 tjeDMdKr}FS`*>|#c;S Wt0'wyp:9?@{.E,x! ;b_۳}V~_Vtݫiґ>xwbt|U=b!͐l\U {pQ< f'+vf]{n'  MS75Y˥|l&i`xܰXb> 9iv^48@s$! VS} RӮ&qq}f=ʂxh)L_c>34'/D_s%ӑi9R9^;~e-\2aqid86>56DwB(7p6?*ìPL͗/DmՋ_MtNԓ{zv)yϑNq?${} Qt;.4G@hlA7Y.Gz_-%2udPחO?t)>o\oN=O޹f#N?'OϭOWk &w*g?,M?YOПܒZ| hX6wnso?WZ|Ixɀx4r5\~Z<-xAk'~l`Zc-DK'Kf[jmq[ʴ-ܖ4U/W8Uf3x0gD*.6ܘ)L΀e<`9/3=-|f{pv rt|y *M+gdpxtxYն߄ŃsׯU;t9GxcVvZUc9g&/הGgug=sӺ_27t2pGl7p`>;ڤ qYм =#DNٽ6'߸ Xki5zo ud.Ϫ+|יL1Gg˯Oͨ"C9aۦ>.`uR:܁uC>z_b/^CuSǃ? b?~{,o Ϊ㛺qTWM9y:UN#!X4/퉀Y_pmG9=r4gKeFncŹװZ;r{b?.:fE] 4L[1U+>՝i! }@&g(q%#a9`{P]a63 3OA{=\`eUhzMT:t\k=' `)Ribhf{ 3A1/AV;mѣ' h۩hH&r@ ƥ\3YX^o-u!7OHgZәB+YeGOW0뿭gb9DLB4AlM|~KNDɼvK`eaն))`ձ>4:y4_6 g^wHK]ֻL.]ę'I.~3A޺fݒj?B;}©Y=ـ$ѣQ KwSGEƅ>!tސ0o>9R^c*fJ 3)oǬmk!twc5l }` ?rm38qx[[Ҋ6{O6o*p jxjȴyxj/y2&Ko?"j{׿^l_ ¤:,d 8MslSWߐN;OxO!x5c4gD6];QI<秶G]6xgr_h|S)#ꙺyx5X{wj N%,nF_;uߗLLWz'T3fӹr>&ztU|M(Qamv:[h*EG!:es 8 iAC}. 2V c9-~[,ۖYgqU+A;8&rZgݪ®@Z~SH7OqЯ !zxwa,XIqFENW8 wAuvJS fny2}چ['tX`znz]lL3ط:7M\t~̙:9o Sv{nԓMQ2DT!o8n>n^=D6`{sLpaLF@Vp?&l(.77urI.SvvV@jAhkַW^:puJ9΍;pv Si'uditu-ڥk vF:3?\bfwn Z;8v&MKk0XŗLhVL}"'bVEYr\>oX]Й3"- 0x,Mr'꫼Ta݃r ֪+lDe1 cxgejQF2ܢcc~!]*a: d4 PtcpJuܻV` n-G5gWpSgR[M5ѾH9X2}ڶlDy.I&rcnX&61zudX$(*rX>_oKL;g %9!QXϝ!L߬su]rgAj9FL/]fk"6N'@DY^}+V~jڄ=mi:81˥ = C5D ^]0kpDWOctS-:.(,xO2| ub?&[ӇI%H%*tF3hvrpact/data/dataEnrichmentMeansStratified.RData0000644000175000017500000000140314074226041021272 0ustar nileshnilesh r0b```f`a`e`f2؜ LX5FP/B0F&n&{z4?A! 8ZY8`4p 폌AGpD=lħAc:D.: bCD<6/MP8h C+AJC(p oK5~ĝ85hmCG"T0^?B/C7vWN~. z\CT=Z-?`ufKGD=WjjyJry*)nnrf;hx́&菘 11Aqyq-5=Bw.qRm\4AD nIc* '=+!i=q2/cv.0k^bnj1d+.ILBxťIũ%0.OqbnANjpfUj!1Xc-Ԙ6D,qI-KB0YԢĜ`LHtB|ETQgQ~,@ X P Va፦ rpact/NAMESPACE0000644000175000017500000000674014165530012012740 0ustar nileshnilesh# Generated by roxygen2: do not edit by hand S3method(as.data.frame,AnalysisResults) S3method(as.data.frame,ParameterSet) S3method(as.data.frame,PowerAndAverageSampleNumberResult) S3method(as.data.frame,StageResults) S3method(as.data.frame,TrialDesign) S3method(as.data.frame,TrialDesignCharacteristics) S3method(as.data.frame,TrialDesignPlan) S3method(as.data.frame,TrialDesignSet) S3method(as.matrix,FieldSet) S3method(length,TrialDesignSet) S3method(names,AnalysisResults) S3method(names,FieldSet) S3method(names,SimulationResults) S3method(names,StageResults) S3method(names,TrialDesignSet) S3method(plot,AnalysisResults) S3method(plot,Dataset) S3method(plot,EventProbabilities) S3method(plot,NumberOfSubjects) S3method(plot,ParameterSet) S3method(plot,SimulationResults) S3method(plot,StageResults) S3method(plot,SummaryFactory) S3method(plot,TrialDesign) S3method(plot,TrialDesignPlan) S3method(plot,TrialDesignSet) S3method(print,Dataset) S3method(print,FieldSet) S3method(print,ParameterSet) S3method(print,SimulationResults) S3method(summary,AnalysisResults) S3method(summary,Dataset) S3method(summary,ParameterSet) S3method(summary,TrialDesignSet) export(.getAnalysisResultsMeansParallelComputing) export(getAccrualTime) export(getAnalysisResults) export(getAvailablePlotTypes) export(getClosedCombinationTestResults) export(getClosedConditionalDunnettTestResults) export(getConditionalPower) export(getConditionalRejectionProbabilities) export(getData) export(getData.SimulationResults) export(getDataSet) export(getDataset) export(getDesignCharacteristics) export(getDesignConditionalDunnett) export(getDesignFisher) export(getDesignGroupSequential) export(getDesignInverseNormal) export(getDesignSet) export(getEventProbabilities) export(getFinalConfidenceInterval) export(getFinalPValue) export(getHazardRatioByPi) export(getLambdaByMedian) export(getLambdaByPi) export(getLambdaStepFunction) export(getLogLevel) export(getLongFormat) export(getMedianByLambda) export(getMedianByPi) export(getNumberOfSubjects) export(getObjectRCode) export(getObservedInformationRates) export(getOutputFormat) export(getParameterCaption) export(getParameterName) export(getPiByLambda) export(getPiByMedian) export(getPiecewiseExponentialDistribution) export(getPiecewiseExponentialQuantile) export(getPiecewiseExponentialRandomNumbers) export(getPiecewiseSurvivalTime) export(getPlotSettings) export(getPowerAndAverageSampleNumber) export(getPowerMeans) export(getPowerRates) export(getPowerSurvival) export(getRawData) export(getRepeatedConfidenceIntervals) export(getRepeatedPValues) export(getSampleSizeMeans) export(getSampleSizeRates) export(getSampleSizeSurvival) export(getSimulationEnrichmentMeans) export(getSimulationEnrichmentRates) export(getSimulationEnrichmentSurvival) export(getSimulationMeans) export(getSimulationMultiArmMeans) export(getSimulationMultiArmRates) export(getSimulationMultiArmSurvival) export(getSimulationRates) export(getSimulationSurvival) export(getStageResults) export(getTestActions) export(getWideFormat) export(kable) export(kable.ParameterSet) export(plotTypes) export(ppwexp) export(printCitation) export(qpwexp) export(rcmd) export(readDataset) export(readDatasets) export(resetLogLevel) export(rpwexp) export(setLogLevel) export(setOutputFormat) export(testPackage) export(writeDataset) export(writeDatasets) exportMethods("[") exportMethods(t) import(graphics) import(methods) import(stats) import(tools) import(utils) importFrom(Rcpp,evalCpp) importFrom(methods,new) useDynLib(rpact, .registration = TRUE)