Clinical Trial Timeline

github.com/insilica/bawto...fig1-prisma.R

A timeline figure for prostate cancer biomarker trials ...

Get sysrev data

Extracted trial 'shortnames' can be accesessed with rsr from sysrev.com/p/81395.

answers <- rsr::get_answers(81395) |> rsr::tidy_answers() |>
  filter(user_id==139, short_label %in% c("NCT Trial ID","short_name")) |> 
  unnest(answer)

sysrev <- pivot_wider(answers, aid, names_from="short_label", values_from="answer") |>
  group_by(`NCT Trial ID`) |> slice_head(n=1) |>
  select(aid,nct=`NCT Trial ID`, short_name)

Get clinicaltrials.gov data

Below, trial events are read from aact-db.ctti-clinicaltrials.org. The results are loaded from cache for reproducibility.

ctgov <- if(FALSE){ # Load event data from open access ct.gov postgres database
  auth <- list(host="aact-db.ctti-clinicaltrials.org", usr=Sys.getenv("AACT_user"), pw=Sys.getenv("AACT_pw"))
  con  <- DBI::dbConnect(RPostgres::Postgres(),dbname="aact",host=auth$host, port=5432, user=auth$usr, password=auth$pw)
  nct  <- sysrev_tbl$nct
  res  <- tbl(con,"studies") |> filter(nct_id %in% nct) |> collect()
  DBI::dbDisconnect(con)
  res |> pivot_longer(cols=!nct,names_to = "event", values_to = "date")
}

# load event data from cache
ctgov <- readRDS(url("http://insilica.co.s3.amazonaws.com/bawto/resources/ctgov_dates.rds")) 
head(ctgov,2)
##           nct                 event       date
## 1 NCT01682772            recruiting 2012-09-10
## 2 NCT01682772 active_not_recruiting 2019-08-13

Build a figure

The ctgov event time data can be processed a bit to generate a figure with vistime:

colors   <- c("#73e2f3","#76c3fd","#479bfb","#0f1a8f")
plot.tbl <- ctgov %>%
  filter(event %in% c("start_date","recruiting","active_not_recruiting","completion_date")) |>
  mutate(event = forcats::fct_recode(event,start="start_date",recruit="recruiting",active="active_not_recruiting",end="completion_date")) |>
  group_by(nct) |> arrange(date) |> mutate(end = lead(date)) |> ungroup() |>
  inner_join(sysrev,by="nct") |> 
  mutate(color = colors[as.numeric(event)], fontcolor="#690505") |>
  select(trial=short_name,event,start=date,end,color,fontcolor)

gg_vistime(plot.tbl, col.group="trial", col.event="event", col.color="color", col.fontcolor = "fontcolor") +
  scale_x_datetime(breaks = scales::breaks_width("12 months"), labels = scales::date_format("%Y")) + 
  theme_minimal()

This is 90% of the way there, visit github.com/insilica/bawto to learn the rest.