Clouded our vision, the dark side has. But wisdom and style, we will find.

1. Libraries

library(caret)

## Loading required package: ggplot2

## Loading required package: lattice

library(pROC)

## Type 'citation("pROC")' for a citation.

## 
## Attaching package: 'pROC'

## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

2. Load data

correct_answer: did the response answer the question

response_length: longer and nuanced vs short and direct

sentiment_score: humans tend to display stronger sentiments

response_time: instantaneous?

df_combined <- read.csv("df_combined.csv", header = TRUE)
head(df_combined)

##                                    question                 answer
## 1           Who is Luke Skywalker's father?           Darth Vader.
## 2      What is the name of Han Solo's ship? The Millennium Falcon.
## 3          What color is Yoda's lightsaber?                 Green.
## 4  Who is the leader of the Rebel Alliance?            Mon Mothma.
## 5                What species is Chewbacca?               Wookiee.
## 6 What planet does Princess Leia come from?              Alderaan.
##   response_type correct_answer response_length sentiment_score response_time
## 1       Machine             No              12           -0.01          1.41
## 2       Machine             No              21            0.00          0.77
## 3       Machine             No               9           -0.35          1.85
## 4         Human            Yes              22            0.22          2.29
## 5         Human             No              15            0.71          2.98
## 6       Machine            Yes              13            0.05          1.51

3. Training-Validation

set.seed(666)

train_index <- sample(1:nrow(df_combined), 0.7 * nrow(df_combined))
valid_index <- setdiff(1:nrow(df_combined), train_index)

Include only response_length, sentiment_score, and response_time in the training.

train_df <- df_combined[train_index, -c(1,2)]  
valid_df <- df_combined[valid_index, -c(1,2)]

4. Logistic regression

model <- train(response_type ~ ., data = train_df,
               method = "glm", family = "binomial",
               trControl = trainControl(method = "cv", number = 5))

5. Check Prediction

pred_train <- predict(model, newdata = train_df)
head(pred_train)

## [1] Human   Human   Machine Human   Human   Machine
## Levels: Human Machine

pred_prob_train <- predict(model, newdata = train_df, type = "prob")
head(pred_prob_train)

##         Human    Machine
## 62 0.71165774 0.28834226
## 11 0.97627693 0.02372307
## 28 0.02700434 0.97299566
## 14 0.97588489 0.02411511
## 5  0.63384398 0.36615602
## 12 0.03203892 0.96796108

pred_valid <- predict(model, newdata = valid_df)
head(pred_valid)

## [1] Machine Machine Human   Machine Machine Human  
## Levels: Human Machine

pred_prob_valid <- predict(model, newdata = valid_df, type = "prob")
head(pred_prob_valid)

##         Human    Machine
## 2  0.02310238 0.97689762
## 4  0.30120997 0.69879003
## 9  0.91713211 0.08286789
## 17 0.03463946 0.96536054
## 18 0.46585953 0.53414047
## 21 0.53765080 0.46234920

ensure consistency in factor levels

pred_train <- factor(pred_train, 
                     levels = c("Human", "Machine"))
train_df$response_type <- factor(train_df$response_type, 
                                 levels = c("Human", "Machine"))

pred_valid <- factor(pred_valid, 
                     levels = c("Human", "Machine"))
valid_df$response_type <- factor(valid_df$response_type, 
                                 levels = c("Human", "Machine"))

6. Model Evaluaton

cm_train <- confusionMatrix(pred_train,
                            train_df$response_type,
                            positive = "Human")
cm_train

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Human Machine
##    Human      16       6
##    Machine     5      35
##                                          
##                Accuracy : 0.8226         
##                  95% CI : (0.7047, 0.908)
##     No Information Rate : 0.6613         
##     P-Value [Acc > NIR] : 0.003865       
##                                          
##                   Kappa : 0.6085         
##                                          
##  Mcnemar's Test P-Value : 1.000000       
##                                          
##             Sensitivity : 0.7619         
##             Specificity : 0.8537         
##          Pos Pred Value : 0.7273         
##          Neg Pred Value : 0.8750         
##              Prevalence : 0.3387         
##          Detection Rate : 0.2581         
##    Detection Prevalence : 0.3548         
##       Balanced Accuracy : 0.8078         
##                                          
##        'Positive' Class : Human          
##

cm_train$byClass["F1"]

##       F1 
## 0.744186

cm_valid <- confusionMatrix(pred_valid, 
                            valid_df$response_type, positive = "Human")

cm_valid

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Human Machine
##    Human       9       4
##    Machine     3      12
##                                           
##                Accuracy : 0.75            
##                  95% CI : (0.5513, 0.8931)
##     No Information Rate : 0.5714          
##     P-Value [Acc > NIR] : 0.04018         
##                                           
##                   Kappa : 0.4948          
##                                           
##  Mcnemar's Test P-Value : 1.00000         
##                                           
##             Sensitivity : 0.7500          
##             Specificity : 0.7500          
##          Pos Pred Value : 0.6923          
##          Neg Pred Value : 0.8000          
##              Prevalence : 0.4286          
##          Detection Rate : 0.3214          
##    Detection Prevalence : 0.4643          
##       Balanced Accuracy : 0.7500          
##                                           
##        'Positive' Class : Human           
##

cm_valid$byClass["F1"]

##   F1 
## 0.72

roc_curve <- roc(response = valid_df$response_type, 
                 predictor = pred_prob_valid[, "Human"],
                 levels = c("Machine", "Human"))

## Setting direction: controls < cases

plot(roc_curve, main = "ROC Curve for Validation Set")

auc(roc_curve)

## Area under the curve: 0.8125

7. New Data

new_data <- read.csv("new_data.csv", header = TRUE)
new_data

##   correct_answer response_length sentiment_score response_time
## 1            Yes              40             0.8           4.5
## 2            Yes              25             0.1           3.0
## 3             No              10            -0.2           0.8

new_pred <- predict(model, newdata = new_data)
new_pred

## [1] Human   Machine Machine
## Levels: Human Machine

new_prob <- predict(model, newdata = new_data, type = "prob")
new_prob

##        Human    Machine
## 1 0.94496213 0.05503787
## 2 0.47860589 0.52139411
## 3 0.02132912 0.97867088

new_data$response_type <- new_pred
new_data$probability_of_human <- round(new_prob[, "Human"], 2)  

new_data

##   correct_answer response_length sentiment_score response_time response_type
## 1            Yes              40             0.8           4.5         Human
## 2            Yes              25             0.1           3.0       Machine
## 3             No              10            -0.2           0.8       Machine
##   probability_of_human
## 1                 0.94
## 2                 0.48
## 3                 0.02

Change the threshold

library(plotly)

thresholds <- c(0.05, 0.50, 0.95)

frame_data <- do.call(rbind, lapply(thresholds, function(threshold) {
  temp_df <- new_data
  temp_df$Prediction <- ifelse(temp_df$probability_of_human > threshold, "Human", "Machine")
  pred_summary <- as.data.frame(table(temp_df$Prediction))
  colnames(pred_summary) <- c("Prediction", "Number")
  pred_summary$Threshold <- paste("Threshold =", format(threshold, nsmall = 2))
  return(pred_summary)
}))

plot <- frame_data %>%
  plot_ly(
    x = ~Prediction,
    y = ~Number,
    color = ~Prediction,
    text = ~paste("Threshold:", Threshold, "<br>Prediction:", 
                  Prediction, "<br>Number:", Number),
    hoverinfo = "text",
    type = "bar",
    frame = ~Threshold,
    colors = c("Human" = "#90ee90", "Machine" = "#556b2f")) %>%
  layout(
    title = "Predictions Across Thresholds",
    xaxis = list(title = "Prediction (Human vs Machine)"),
    yaxis = list(
      title = "Number of Predictions",
      tickmode = "linear",
      dtick = 1,
      range = c(0, 3)
    ),
    updatemenus = list(
      list(
        type = "buttons",
        showactive = TRUE,
        buttons = list(
          list(
            label = "Play",
            method = "animate",
            args = list(NULL,
                        list(frame = list(duration = 500, redraw = TRUE),
                             transition = list(duration = 0))
            )
          ),
          list(
            label = "Pause",
            method = "animate",
            args = list(NULL, list(mode = "immediate", frame = list(duration = 0)))
          )
        )
      )
    )
  )

plot

Use the Turing force

master yeoda