## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----------------------------------------------------------------------------- library(gestate) library(survival) # Simulate a single data set based upon a Weibull curve with shape 0.8 and scale 100: # Distributions example_distribution <- Weibull(alpha=100,beta=0.8) example_recruitment <- LinearR(rlength=24,Nactive=600,Ncontrol=0) # Create the full trajectory maxtime <- 100 example_data_long <- simulate_trials(active_ecurve=example_distribution,control_ecurve=example_distribution,rcurve=example_recruitment,assess=maxtime,iterations=1,seed=1234567,detailed_output=TRUE) # Shrink the trajectory to an early time point at which event prediction will occur example_data_short <- set_assess_time(example_data_long,18) ###################### # Create life-table with 7-day 'sampling' # Note that this is to create an example lifetable and would not normally be done as it is typically better to use patient-level data if available temp1 <- summary(survfit(Surv(example_data_short[,"Time"],1-example_data_short[,"Censored"])~ 1,error="greenwood")) out1 <- cbind(temp1$time,temp1$n.risk,temp1$surv,temp1$std.err) out1 <- rbind(c(0,out1[1,2],1,0),out1) colnames(out1) <- c("Time","NAR","Survival","Std.Err") interval <- 1 x1 <- ceiling(max(out1[,"Time"]/interval))*interval times1 <- seq(from = 0, to = x1,by=interval) keys1 <- findInterval(times1,out1[,"Time"]) example_lifetable <- out1[keys1,] example_lifetable[,"Time"] <- times1 ## ----------------------------------------------------------------------------- # Curve-fit the example lifetable in automatic mode fit1 <- fit_KM(KMcurve=example_lifetable,Survival="Survival",Time="Time",Weights="NAR",type="automatic") fit1 ## ----------------------------------------------------------------------------- # Curve-fit the example lifetable in automatic mode fit2 <- fit_tte_data(data=example_data_short,Time="Time",Event="Censored",censoringOne=TRUE,type="automatic") fit2 ## ----------------------------------------------------------------------------- # Create an RCurve incorporating both observed and predicted recruitment with arbitrary randomisation ratio of 1 recruit <- PieceR(matrix(c(rep(1,12),10,15,25,30,45,60,55,50,65,60,55,30),ncol=2),1) ## ----------------------------------------------------------------------------- # Create the full length trial showing what 'actually' happens trial_long <- simulate_trials(active_ecurve=Weibull(50,0.8),control_ecurve=Weibull(50,0.8),rcurve=recruit,fix_events=200,iterations=1,seed=12345,detailed_output=TRUE) # Create a shortened version with data for use in the event prediction trial_short <- set_assess_time(data=trial_long,time=10,detailed_output = FALSE) # Create the trajectory of events maxtime <- max(ceiling(trial_long[,"Assess"])) events <- rep(NA,maxtime) for (i in 1:maxtime){ events[i] <- sum(1-set_assess_time(trial_long,i)[,"Censored"]) } ## ----------------------------------------------------------------------------- predictions <- event_prediction(data=trial_short, Event="Censored", censoringOne=TRUE, type="Weibull", rcurve=recruit,max_time=60, cond_Events=49, cond_NatRisk=451, cond_Time=10, units="Months") ## ---- fig.show='hold',fig.height = 5, fig.width = 7, fig.align = "center"----- # Plot observed events and conditional predictions plot_ep(predictions,trajectory="conditional",which_PI="conditional",max_time=40,observed=events,target=200,max_E=200) ## ----------------------------------------------------------------------------- trial_less_short <- set_assess_time(data=trial_long,time=14,detailed_output = FALSE) predictions2 <- event_prediction(data=trial_less_short, Event="Censored",censoringOne=TRUE, type="Weibull", rcurve=recruit,max_time=60, cond_Events=101,cond_NatRisk=399,cond_Time=14, units="Months") trial_mature <- set_assess_time(data=trial_long,time=18,detailed_output = FALSE) predictions3 <- event_prediction(data=trial_mature, Event="Censored",censoringOne=TRUE, type="Weibull", rcurve=recruit,max_time=60, cond_Events=148,cond_NatRisk=352,cond_Time=18, units="Months") ## ---- echo=FALSE, fig.show='hold',fig.height = 5, fig.width = 7, fig.align = "center"---- plot_ep(predictions2,trajectory="conditional",which_PI="conditional",max_time=40,observed=events,target=200,max_E=200) plot_ep(predictions3,trajectory="conditional",which_PI="conditional",max_time=40,observed=events,target=200,max_E=200) ## ---- echo=FALSE, fig.show='hold',fig.height = 5, fig.width = 7, fig.align = "center"---- plot_km_fit(fit=predictions,data=trial_short, Event="Censored",censoringOne=TRUE,main="Kaplan Meier Curve Fit Plot: 10 Months",maxT=45,xlim=c(0,40)) plot_km_fit(fit=predictions2,data=trial_less_short, Event="Censored",censoringOne=TRUE,main="Kaplan Meier Curve Fit Plot: 14 Months",maxT=45,xlim=c(0,40)) plot_km_fit(fit=predictions3,data=trial_mature, Event="Censored",censoringOne=TRUE,main="Kaplan Meier Curve Fit Plot: 18 Months",maxT=45,xlim=c(0,40)) ## ----------------------------------------------------------------------------- example_data_prior <- create_tte_prior(curve=example_distribution,duration=100,events=100) head(example_data_prior) tail(example_data_prior) fit3 <- fit_tte_data(data=example_data_prior,Time="Time",type="Weibull") fit3$Parameters ## ----------------------------------------------------------------------------- prior <- create_tte_prior(curve=Weibull(50,0.8),duration=36,events=200, Event="Censored", censoringOne=TRUE) ## ----------------------------------------------------------------------------- predictions_prior <- event_prediction_prior(data=trial_short, priordata=prior, priorweight=0.25, Event="Censored", censoringOne=TRUE, type="Weibull", rcurve=recruit, max_time=60, cond_Events=49, cond_NatRisk=451, cond_Time=10, units="Months") ## ---- fig.show='hold',fig.height = 5, fig.width = 7, fig.align = "center"----- # Plot observed events and conditional predictions plot_ep(predictions,trajectory="conditional",which_PI="conditional",max_time=40,observed=events,target=200,max_E=200,main="Kaplan Meier Curve Fit Plot: 10 Months, No Prior Information") plot_ep(predictions_prior,trajectory="conditional",which_PI="conditional",max_time=40,observed=events,target=200,max_E=200,main="Kaplan Meier Curve Fit Plot: 10 Months, Prior Information")