assignment 4 submission

StudentNotebooks/Assignment04/CTBench_LLM_promt.Rmd

@@ -0,0 +1,238 @@
+
+
+
+```{r}
+
+library(dplyr)
+library(openai) # devtools::install_github("irudnyts/openai", ref = "r6")
+library(rlist)
+library(stringr)
+library(purrr)
+library(progress)
+
+```
+
+```{r}
+#Load dataset
+CT_Pub.df<- readRDS("../../CTBench_source/corrected_data/ct_pub/CT_Pub_data_updated.Rds")
+head(CT_Pub.df, 2)
+
+#Model names
+model.choices <- c("gpt-4-0613",
+                           "gpt-4-turbo-preview",
+                           "gpt-4o-mini",
+                           "gpt-4o",
+                           "o1-preview",
+                           "o1-mini",
+                           "Meta-Llama-3.1-8B-Instruct")
+```
+
+###Single Generation Zero-shot
+```{r}
+
+build_zeroshot_prompt <- function(row) {
+  
+  # Prompt structure
+  system_message <- "You are a helpful assistant with experience in the clinical domain and clinical trial design. \
+You'll be asked queries related to clinical trials. These inquiries will be delineated by a '##Question' heading. \
+Inside these queries, expect to find comprehensive details about the clinical trial structured within specific subsections, \
+indicated by '<>' tags. These subsections include essential information such as the trial's title, brief summary, \
+condition under study, inclusion and exclusion criteria, intervention, and outcomes."
+  
+  # Baseline measure definition
+  system_message <- paste0(system_message, " In answer to this question, return a list of probable baseline features (each feature should be enclosed within a pair of backticks \
+and each feature should be separated by commas from other features) of the clinical trial. \
+Baseline features are the set of baseline or demographic characteristics that are assessed at baseline and used in the analysis of the \
+primary outcome measure(s) to characterize the study population and assess validity. Clinical trial-related publications typically \
+include a table of baseline features assessed by arm or comparison group and for the entire population of participants in the clinical trial.")
+  
+  # Additional instructions
+  system_message <- paste0(system_message, " Do not give any additional explanations or use any tags or headers, only return the list of baseline features. ")
+  
+  # Extract row information to generate the query
+  title <- row$BriefTitle
+  brief_summary <- row$BriefSummary
+  condition <- row$Conditions
+  eligibility_criteria <- row$EligibilityCriteria
+  intervention <- row$Interventions
+  outcome <- row$PrimaryOutcomes
+  
+  # Construct the question
+  question <- "##Question:\n"
+  question <- paste0(question, "<Title> \n", title, "\n")
+  question <- paste0(question, "<Brief Summary> \n", brief_summary, "\n")
+  question <- paste0(question, "<Condition> \n", condition, "\n")
+  question <- paste0(question, "<Eligibility Criteria> \n", eligibility_criteria, "\n")
+  question <- paste0(question, "<Intervention> \n", intervention, "\n")
+  question <- paste0(question, "<Outcome> \n", outcome, "\n")
+  question <- paste0(question, "##Answer:\n")
+  
+  return(c(system_message, question))
+}
+
+```
+
+
+### Single Generation Triple-Shot
+```{r}
+
+build_example_questions_from_row <- function(data, ref_col_name) {
+  ids = c('NCT00000620', 'NCT01483560', 'NCT04280783')
+  examples = data[data$NCTId %in% ids, ]
+  question = ""
+  
+  for (i in 1:nrow(examples)) {
+    row <- examples[i, ]
+    question <- paste0(question, "##Question:\n")
+    question <- paste0(question, "<Title> \n", row[['BriefTitle']], "\n")
+    question <- paste0(question, "<Brief Summary> \n", row[['BriefSummary']], "\n")
+    question <- paste0(question, "<Condition> \n", row[['Conditions']], "\n")
+    question <- paste0(question, "<Eligibility Criteria> \n", row[['EligibilityCriteria']], "\n")
+    question <- paste0(question, "<Intervention> \n", row[['Interventions']], "\n")
+    question <- paste0(question, "<Outcome> \n", row[['PrimaryOutcomes']], "\n")
+    question <- paste0(question, "##Answer:\n", row[[ref_col_name]], "\n\n")
+  }
+  
+  return(question)
+
+}
+
+
+build_three_shot_prompt <- function(data, row, ref_col_name) {
+  
+  # Prompt structure
+  system_message <- "You are a helpful assistant with experience in the clinical domain and clinical trial design. \
+  You'll be asked queries related to clinical trials. These inquiries will be delineated by a '##Question' heading. \
+  Inside these queries, expect to find comprehensive details about the clinical trial structured within specific subsections, \
+  indicated by '<>' tags. These subsections include essential information such as the trial's title, brief summary, \
+  condition under study, inclusion and exclusion criteria, intervention, and outcomes."
+
+  # Baseline measure definition
+  system_message <- paste0(system_message, "In answer to this question, return a list of probable baseline features (each feature should be enclosed within a pair of backticks \
+  and each feature should be separated by commas from other features) of the clinical trial. \
+  Baseline features are the set of baseline or demographic characteristics that are assessed at baseline and used in the analysis of the \
+  primary outcome measure(s) to characterize the study population and assess validity. Clinical trial-related publications typically \
+  include a table of baseline features assessed by arm or comparison group and for the entire population of participants in the clinical trial.")
+
+  # Additional instructions
+  system_message <- paste0(system_message, " You will be given three examples. In each example, the question is delineated by '##Question' heading and the corresponding answer is delineated by '##Answer' heading. \
+  Follow a similar pattern when you generate answers. Do not give any additional explanations or use any tags or headings, only return the list of baseline features.")
+
+  # Generate examples
+  example <- build_example_questions_from_row(data, ref_col_name)
+
+  # Divide row information to generate the query
+  title <- row[['BriefTitle']]
+  brief_summary <- row[['BriefSummary']]
+  condition <- row[['Conditions']]
+  eligibility_criteria <- row[['EligibilityCriteria']]
+  intervention <- row[['Interventions']]
+  outcome <- row[['PrimaryOutcomes']]
+  
+  question <- "##Question:\n"
+  question <- paste0(question, "<Title> \n", title, "\n")
+  question <- paste0(question, "<Brief Summary> \n", brief_summary, "\n")
+  question <- paste0(question, "<Condition> \n", condition, "\n")
+  question <- paste0(question, "<Eligibility Criteria> \n", eligibility_criteria, "\n")
+  question <- paste0(question, "<Intervention> \n", intervention, "\n")
+  question <- paste0(question, "<Outcome> \n", outcome, "\n")
+  question <- paste0(question, "##Answer:\n")
+  
+  return(c(system_message, paste0(example, question)))
+}
+
+
+```
+
+
+### API call function
+```{r}
+
+# Set OpenAI API key
+mykey <- "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" # olyerickson
+Sys.setenv(OPENAI_API_KEY = mykey )
+  
+# Using purrr's insistently() to retry
+rate <- rate_delay(5) # retry rate 
+
+# HERE'S THE MAGIC: This is how we hit the LLM endpoints
+# This is "risky" because it doesn't protect against rate limits  
+risky_create_completion <- function(prompts, model) {
+
+  # Choose the endpoint based on model name
+    if (startsWith(model, "gpt-") || startsWith(model, "o1-")) {
+      client <- OpenAI()
+    } else {
+      client <- OpenAI(
+        base_url = "http://idea-llm-01.idea.rpi.edu:5000/v1/"
+      )
+    }
+  
+   # This is where we specify the prompts! 
+   client$chat$completions$create(
+      model = model,
+      messages = list(
+        list(
+          "role" = "system",
+          "content" = prompts[1]
+        ),
+        list(
+          "role" = "user",
+          "content" = prompts[2]
+        )
+      )
+    )
+}
+
+# This wrapper is CRITICAL to avoid rate limit errors
+insistent_create_completion <- insistently(risky_create_completion, rate, quiet = FALSE)
+
+```
+
+### API Call Single Generation
+
+```{r}
+model_index = 7
+# Zero shot
+zs_prompts = build_zeroshot_prompt(CT_Pub.df[6, ])
+insistent_create_completion(zs_prompts, model.choices[model_index])$choices[[1]]$message$content
+# Triple Shot
+ts_prompts = build_three_shot_prompt(CT_Pub.df, CT_Pub.df[6, ], "Paper_BaselineMeasures_Corrected")
+insistent_create_completion(ts_prompts, model.choices[model_index])$choices[[1]]$message$content
+
+```
+### API Call Batch Generation
+```{r}
+
+n = nrow(CT_Pub.df)
+
+zspb = progress_bar$new(
+  format = "  Processing [:bar] :percent in :elapsed",
+  total = n, clear = FALSE, width = 60
+)
+
+tspb = progress_bar$new(
+  format = "  Processing [:bar] :percent in :elapsed",
+  total = n, clear = FALSE, width = 60
+)
+
+model_index = 3
+
+# Zero shot
+CT_Pub_response_zs = CT_Pub.df
+CT_Pub_response_zs$model_response_zs = NA
+for (i in 1:nrow(CT_Pub_response_zs)){
+  zs_prompts = build_zeroshot_prompt(CT_Pub.df[i, ])
+  CT_Pub_response_zs$model_response_zs[i] = insistent_create_completion(zs_prompts, model.choices[model_index])$choices[[1]]$message$content
+  zspb$tick()
+}
+
+# Triple Shot
+CT_Pub_response_ts = CT_Pub.df
+CT_Pub_response_ts$model_response_ts = NA
+for (i in 1:nrow(CT_Pub_response_ts)){
+  ts_prompts = build_three_shot_prompt(CT_Pub.df, CT_Pub.df[i, ], "Paper_BaselineMeasures_Corrected")
+  CT_Pub_response_ts$model_response_ts[i] = insistent_create_completion(ts_prompts, model.choices[model_index])$choices[[1]]$message$content
+  tspb$tick()
+}
+```