Updates 2025 10 13

R/aiProcessFunct.R

@@ -0,0 +1,24 @@
+# aiProcessFunct
+# nice and small
+aiProcessFunct <- function(userInput, att, successFunct, instructions, ...){ #session, output,language, api
+	# loading bar
+  att$set(0)    # Start at 0%
+	att$auto()
+	future({
+		# OpenAI API connection ----
+		rs <- runChatCompletion(instructions=instructions, userInput=userInput)
+	}) %...>% (
+	  function(rs){
+	    # run the indicated success function 
+	    # (currently either explanationSuccessFunct, or translateSuccessFunct)
+		  successFunct(rs=rs, att=att, ...) 
+	  }
+	) %...!% (
+	  function(rs){
+		  errorFunct(rs=rs, att=att)
+	  }
+	)	
+
+}
+
+

R/aiProcessSuccessFunct.R

@@ -0,0 +1,58 @@
+
+aiProcessSuccessFunct <- function(rs, att, lang, updateFunction, ...){
+  # Hide progress bar after 30s
+
+  on.exit({
+    att$done()
+  })
+  Sys.sleep(1)
+
+  # Response content ----
+  if (!is.null(rs)) {
+    response <- rs$choices$message.content
+    lines <- strsplit(response, "\n")
+    lines2 = lines[[1]]
+
+    start_line <- min(match(c(paste0("This is not ",lang," code. "), 
+                              paste0("This is not ",lang," code."), 
+                              paste0("This is not ",lang," code ")), 
+                            lines2), 
+                      match("```R", lines2), 
+                      match(c("Here is the explanation of the SAS code provided:", 
+                              "\"Here is the explanation of the SAS code provided:",
+                              "Here is the explanation of the SAS code provided:\r",
+                              "\"Here is the explanation of the SAS code provided:\r",
+                              "Here is the explanation of the SAS code provided: ",
+                              "\"Here is the explanation of the SAS code provided: "),
+                            lines2),
+                      na.rm=TRUE)
+    start_sentence <- lines2[start_line]
+    end_line <- which(lines2 == "```")
+
+    # If is code, just give back the R code equivalent ----
+    if(start_sentence=="```R") { 
+      code_reconstructed <- paste(lines2[(start_line+1):(end_line-1)], collapse = "\n")
+    }
+    # If not code, give back message explaining issue ----
+    else{
+      code_reconstructed <- paste(lines2, collapse = "\n")
+    }
+
+    updateFunction(value = code_reconstructed, ...)
+
+
+    list(code_reconstructed = code_reconstructed)
+  }
+
+}
+
+updateUiOutput <- function(value, output){
+  output$response2 <- renderUI({
+    HTML(str_replace_all(str_replace_all(value, "\r", ""), "\n", "<br>"))
+  })
+}
+updateAceEditor_ <- function(session, editorId, value){
+  updateAceEditor(session=session, editorId=editorId,
+                 value = value,
+                 wordWrap = T)
+}

R/errorFunct.R

@@ -0,0 +1,10 @@
+
+
+errorFunct <- function(rs, att){
+  showNotification(paste("Error:", rs$message), type = "error")
+  # Hide progress bar
+  on.exit({
+    att$done()
+  })	
+  return(NULL)
+}

R/getAPIKey.R

@@ -0,0 +1,6 @@
+#' Gets the API Key, checks for OPEN_AI_KEY environment var, otherwise uses the value in params file.
+#'
+getAPIKey <- function(){
+  if (Sys.getenv("OPEN_AI_KEY") == "") return(site_params$open_ai_key)
+  return (Sys.getenv("OPEN_AI_KEY"))
+}

R/getMaxWorkers.R

@@ -0,0 +1,6 @@
+#' Gets the max workers, checks for MAX_WORKERS environment var, otherwise uses the value in params file.
+#'
+getMaxWorkers <- function(){
+  if (Sys.getenv("MAX_WORKERS") == "") return(site_params$max_workers)
+  return (strtoi(Sys.getenv("MAX_WORKERS")))
+}

R/head.R

@@ -0,0 +1,19 @@
+#' head function
+#' defines the css and js files to be included in the app
+#' @export
+#'
+head <- function(){
+  tags$head(
+    # favicon:
+    # TODO put the favicon code here
+
+    # Cookies to remember user on popup Terms ----
+    tags$script(src="https://cdn.jsdelivr.net/npm/js-cookie@rc/dist/js.cookie.min.js"),
+    # Load cookies script ----
+    tags$script(src="includes/cookies.js"),
+
+    # Load CSS & JS script ----
+    tags$link(rel = "stylesheet", type = "text/css", href = "includes/Transcompiler.css"),
+    tags$script(src="includes/Transcompiler.js")
+  )
+}

R/instructions.R

@@ -0,0 +1,15 @@
+#' defines the instructions tab
+#' @export
+instructions <- function(){
+  return (tabPanel("Instructions",
+                   fluidRow(
+                     column(2),
+                     column(8,
+                            div(id = "disclaimer", 
+                                readFile("html", "Disclaimer", "html" )
+                            )
+                     ),
+                     column(2)
+                   )
+  ))
+}

R/observer.R

@@ -0,0 +1,70 @@
+#' observer function
+#' Calls a generic function with runs the basic checks and processes 
+#' before calling the openAI related function
+#' 
+#' @param userInput the input box to read SAS/SPSS from
+#' @param instruction the specific instructions to send to openAI
+#' @param regexDetect the regextDetect specific to each input to check for i.p. addresses etc
+#' @param api_response id of the output box
+#' @param language language being sent to the AI
+#' @param att the attendant for the API call
+#' @param fn the function to call to send text to API
+#' @param output the output (same as in server_ function & server.R) - this is only needed for one of the 3 functions defined in fn
+#' 
+#' @export
+observer <- function(userInput, regexDetect, api_response, language, att,  ...){
+     # Error catching: no input detected ----
+    if( nchar(userInput) > 0 ) {
+
+      # Error catching: input SAS code too long ----
+      if( nchar(userInput) > 4000 ) {
+        # Hide progress bar on error ----
+        on.exit({
+          att$done()
+        })
+        Sys.sleep(1)
+
+        # Error output ----
+        updateAceEditor(session, api_response, value = paste0("You have entered too much ",language," code."))
+
+      } else {
+
+        # Regular Expression catching ----
+        if (regexDetect() == FALSE) {
+
+          # No regular expression found, send text to API
+          aiProcessFunct(userInput = userInput, att=att, ...)
+
+        } else { # Create a pop-up warning to inform user that regex has caught some patterns, 
+          # Ask user to confirm before sending text to API or do NULL
+
+          shinyalert(
+            title = "Information Check",
+            text = "Input appears to contain sensitive information\n (URLs/Filepaths/IP addresses/Passwords/etc.)\n
+                            Do you wish to proceed with translation?",
+            size = "s", 
+            closeOnEsc = TRUE, 
+            closeOnClickOutside = FALSE,
+            html = FALSE, type = "warning",
+            showConfirmButton = TRUE, 
+            showCancelButton = TRUE,
+            confirmButtonText = "Proceed with Translation",
+            confirmButtonCol = "#AEDEF4",
+            cancelButtonText = "Back",
+            timer = 0, 
+            animation = TRUE,
+
+            callbackR = function(x) {  if(x == FALSE) {return(NULL)} # NA not here
+              # this is now going to be aiProcessFunct everytime which itself takes a function as an argument
+                    #userInput, instructions, att, successFunct
+              else{ aiProcessFunct(userInput = userInput, att=att, ...) } 
+              #else{ fn(userInput = userInput, instructions = instructions, att=att, session=session, output=output) } 
+            }
+          )}
+
+      } 
+    }
+    else {
+      showNotification(paste("Error: No input detected."), type = "error")
+    }
+  }

R/page_.R

@@ -0,0 +1,59 @@
+page_ <- function(fromLanguage, #fromLanguage,
+                  tabIndex,
+                  tabName = "", 
+                  outputLabel = "",
+                  buttonLabel = "",
+                  inputElement, 
+                  outputElement
+
+){
+  # set defaults
+  tn <- tabName
+  bt <- buttonLabel
+  ol <- outputLabel
+  if (tabName == "") tn <- paste0(fromLanguage," to ", site_params$to_language," code Assistant")
+  if (buttonLabel == "") bt <- paste0("Translate to ", site_params$to_language)
+  if (outputLabel == "") ol <- paste0("Output ",site_params$to_language," Code")
+
+
+  return(tabPanel(title = tn,
+  # Main content ----
+  fluidRow(
+    column(1),
+    column(5,
+           # Progress bar ----
+           attendantBar(paste0("progress-bar", tabIndex),
+                        color = "success",
+                        max = 100,
+                        striped = TRUE,
+                        animated = TRUE,
+                        height = "40px",
+                        width = "75%"
+           ),
+
+           # Live syntax highlighting input SAS code box ----
+
+           inputElement(fromLanguage, tabIndex),
+
+
+
+
+           # Translate button ----
+           actionButton(paste0("process", tabIndex), bt)
+    ),
+    column(5,
+           div(id = paste0("output", tabIndex, "container"), style = "height: 100%;",
+               style = "width: 95%",
+               HTML(paste0("<label>", ol, ":</label>")),
+               div(id = paste0("output", tabIndex), 
+                   style = "border: 1px solid #CED4DA; height: 800px",
+                   outputElement(tabIndex)
+               )
+           )
+    ),
+    column(1)
+  )
+  ))
+
+
+}

functions/readFile.R → R/readFile.R

@@ -1,8 +1,13 @@
 library(readr)
 library(yaml)
 
-# reads files from various locations. this removes the awful nested functions 
-# which litter the code otherwise 
+
+#' reads files from various locations
+#' @param type the file type
+#' @param name the name of the file
+#' @param subfolder the subfolder the file is in
+#' 
+#' @export
 
 readFile <- function(type, name, subfolder = ""){
   ext <- extension(type)
@@ -16,6 +21,7 @@ readFile <- function(type, name, subfolder = ""){
   )
 }
 
+
 sourceFile <- function(name){
   source (paste0(getwd(), "/functions/", name))
 }

R/responses.R

@@ -0,0 +1,25 @@
+#' renders output boxes for API responses from the openAI.
+#' weirdly only for SAS to R and SPSS to R
+#' 
+#' questions: 
+#'  - can this be generalised since the two sets of 3 lines are the same
+#'  - why is this only used for 2 of the three API calls?
+#'   
+#' @param output the global output variable from server.R
+#' @export
+responses <- function(output){
+  # Render R code box ----
+
+  output$api_response1 <- renderUI({
+    aceEditor("api_response1", mode = "r", readOnly = TRUE, fontSize = 13)
+  })
+
+  output$api_response2 <- renderUI({
+    aceEditor("api_response2", mode = "r", readOnly = TRUE, fontSize = 13)
+  })
+
+  output$api_response3 <- renderUI({
+    aceEditor("api_response3", mode = "r", readOnly = TRUE, fontSize = 13)
+  })
+
+}

R/runChatCompletion.R

@@ -0,0 +1,25 @@
+runChatCompletion <- function(instructions, userInput){
+
+  return (openai::create_chat_completion(
+  # Model used from 10-Nov is the GPT-4 turbo preview. 
+  # This model will need to be updated when the preview ends and full release begins
+  model = site_params$open_ai_model, 
+
+  messages = list(
+    list(
+      "role" = "system",
+      "content" = instructions
+    ),
+    list(
+      "role" = "user",
+      "content" = userInput
+    )
+  ),
+
+  temperature = 0,
+
+  # max_tokens = 1024, # Controls response length for GPT-4
+  max_tokens = site_params$open_ai_max_tokens, # Increased response length for GPT-4 Turbo (context window is x4 times larger)
+
+  openai_api_key = getAPIKey())
+)}