Why is my model so accurate when using knn(), where k=1?

I am currently using genomic expression levels, age, and smoking intensity levels to predict the number of days Lung Cancer Patients have to live. I have a small amount of data; 173 patients and 20,438 variables, including gene expression levels (which make up for 20,436). I have split up my data into test and training, utilizing an 80:20 ratio. There are no missing values in the data.

I am using knn() to train the model. Here is what the code looks like:

prediction <- knn(train = trainData, test = testData, cl = trainAnswers, k=1)


Nothing seems out of the ordinary until you notice that k=1. "Why is k=1?" you may ask. The reason k=1 is because when k=1, the model is the most accurate. This makes no sense to me. There are quite a few concerns:

1. I am using knn() to predict a continuous variable. I should be using something along the lines of, cox maybe.
2. The model is waaaaaaay too accurate. Here are a few examples of the test answer and the model's predictions. For the first patient, the number of days to death is 274. The model predicts 268. For the second patient, test: 1147, prediction: 1135. 3rd, test: 354, prediction: 370. 4th, test: 995, prediction 995. How is this possible? Out of the entire test data, the model was only off by and average of 9.0625 days! The median difference was 7 days, and the mode was 6 days. Here is a graph of the results: Bar Graph.

So I guess my main question is what does knn() do, what does k represent, and how is the model so accurate when k=1? Here is my entire code (I am unable to attach the actual data):

# install.packages(c('caret', 'skimr', 'RANN', 'randomForest', 'fastAdaboost', 'gbm', 'xgboost', 'caretEnsemble', 'C50', 'earth'))
library(caret)

# Gather the data and store it in variables
geneData <- data.frame(geneData)
row.names(geneData) = geneData$X geneData <- geneData[2:514] colNamesGeneData <- gsub(".","-",colnames(geneData),fixed = TRUE) colnames(geneData) = colNamesGeneData # Organize the data # Important columns are 148 (smoking), 123 (OS Month, basically how many days old), and the gene data. And column 2 (barcode). LUAD = data.frame(LUAD$patient, LUAD$TOBACCO_SMOKING_HISTORY_INDICATOR, LUAD$OS_MONTHS, LUAD$days_to_death)[complete.cases(data.frame(LUAD$patient, LUAD$TOBACCO_SMOKING_HISTORY_INDICATOR, LUAD$OS_MONTHS, LUAD$days_to_death)), ] rownames(LUAD)=LUAD$LUAD.patient

# ind=which(colnames(geneData)=="TCGA-778-7167-01A-11R-2066-07")

# Merge the two datasets to use the geneomic expression levels in your model

set.seed(401)

# Number of Rows in the training data (createDataPartition(dataSet, percentForTraining, boolReturnAsList))
trainRowNum <- createDataPartition(LUAD$LUAD.days_to_death, p=0.8, list=FALSE) # Training/Test Dataset trainData <- LUAD[trainRowNum, ] testData <- LUAD[-trainRowNum, ] x = trainData[, c(2:20438)] y = trainData$LUAD.days_to_death
v = testData[, c(2:20438)]
w = testData$LUAD.days_to_death # Imputing missing values into the data preProcess_missingdata_model <- preProcess(trainData, method='knnImpute') library(RANN) if (anyNA(trainData)) { trainData <- predict(preProcess_missingdata_model, newdata = trainData) } anyNA(trainData) # Normalizing the data preProcess_range_model <- preProcess(trainData, method='range') trainData <- predict(preProcess_range_model, newdata = trainData) trainData$LUAD.days_to_death <- y
apply(trainData[,1:20438], 2, FUN=function(x){c('min'=min(x), 'max'=max(x))})

preProcess_range_model_Test <- preProcess(testData, method='range')
testData <- predict(preProcess_range_model_Test, newdata = testData)
apply(testData[,1:20438], 2, FUN=function(v){c('min'=min(v), 'max'=max(v))})

# To uncomment, select the text and press 'command' + 'shift' + 'c'
# set.seed(401)
# options(warn=-1)
# subsets <- c(1:10)
# ctrl <- rfeControl(functions = rfFuncs,
#                    method = "repeatedcv",
#                    repeats = 5,
#                    verbose = TRUE)
#                  sizes = subsets,
#                  rfeControl = ctrl)
# lmProfile

library(class)
prediction <- knn(train = trainData, test = testData, cl = trainAnswers, k=1)

#install.packages("plotly")
library(plotly)
Test_Question_Number <- c(1:32)
prediction2 <- data.frame(prediction[1:32])
prediction2 <- as.numeric(as.vector(prediction2[c(1:32),]))

p <- plot_ly(data, x = ~Test_Question_Number, y = ~prediction2, type = 'bar', name = 'Prediction') %>%
layout(yaxis = list(title = 'Days to Death'), barmode = 'group')
p

difference <- abs((merge[,1])-(merge[,2]))
difference <- sort(difference)
meanDifference <- mean(difference)
medianDifference <- median(difference)
modeDifference <- names(table(difference))[table(difference)==max(table(difference))]
cat("Mean difference:", meanDifference, "\n")
cat("Median difference:", medianDifference, "\n")
cat("Mode difference:", modeDifference,"\n")


Lastly, for clarification purposes, ClinicalData.csv is the age, days to death, and smoking intensity data. The other .csv is the genomic expression data. The data above line 29 doesn't really matter, so you can just skip to the part of the code where it says "set.seed(401)".

Some samples of the data (Days to death, A number representative of age, and the rest are genes and their expression levels. I only shared a few. There are over 20,000):

days_to_death    OS_MONTHS
121              3.98

NACC1   2001.5708   2363.8063   1419.879
NACC2   58.2948     61.8157     43.4386
NAE1    832.8825    793.3014    689.7123
NAF1    140.3264    165.4858    186.355
NAGA    1523.3441   1524.4619   1858.9074
NAGK    983.6809    899.869     1168.2003
NAGLU   621.3457    510.9453    1172.511
NAGPA   346.9762    257.5654    275.5533
NAGS    460.7732    107.2116    321.9763
NAIF1   217.1219    202.5108    132.3054
NAIP    101.2305    87.8942     77.261
NALCN   13.9628     36.7031     48.0809
NAMPT   3245.6584   1257.8849   5465.6387


Edit: I just realized OS_Months is actually the days to death. It means Overall Survival Months, basically how many months the patient has to live. I am reformatting my code accordingly. I will re-edit this when I figure out whether it is the problem or not.

• Do you have multiple clinical observations per patient? (eg. for the 1st patient, two observations that are 6 days apart?) – Matthew Gunn Jul 3 '18 at 18:28
• Nope, it's 1 observation per patient. – Octavius Jul 3 '18 at 18:45
• Possible causes of fantastical, impossible accuracy include (1) training on your test data or (2) using predictors that are essentially what you're trying to predict (eg. regress left shoe size on right shoe size). I'm concerned (like you are) that something like that is going on? – Matthew Gunn Jul 18 '18 at 15:30