# Definition of price.
price <- function(rating, age) {
peakAge <- rating- 50
price <- rating / 2
price <- sapply(1:length(rating), function(i){
if (age[i] > peakAge[i]) {
p <- price[i] * (5 - (age[i] - peakAge[i]))
} else {
p <- price[i] * 5 * (age[i] + 1) / peakAge[i]
}
return(ifelse(p<0, 0, p))
})
return(price)
}
# Create a price dataset.
createSet <- function(n=300) {
randVector <- runif(n * 2)
rating <- randVector[1:n] * 50 + 50
age <- randVector[(n+1):(n*2)] * 50
price <- price(rating, age) * (runif(1) * 0.2 + 0.9)
data <- cbind(rating, age, price)
return(data)
}
getDistances <- function(data, v1) {
distances
<- apply
(data
[,c
(1,2)], 1, function(v2
) sqrt(sum
((v2
- v1
) ^ 2))) distanceFrame <- data.frame(distance=distances, index=1:nrow(data))
ord=order(distanceFrame[,'distance'])
return(distanceFrame[ord,])
}
# KNN estimate.
knnEstimate <- function(data, v1, k=3) {
distances <- getDistances(data[,c(1,2)], v1)[1:k,]
ret <- mean(data[distances[,'index'], 'price'])
return(ret)
}
# Divide data set into training set and test set.
divideData <- function(data, test = 0.1) {
testIndices <- which(runif(nrow(data)) < test)
return(list(test=data[testIndices,], train=data[-testIndices,]))
}
testAlgorithm <- function(algF, trainSet, testSet) {
errorVector <- apply(testSet, 1, function(i) {
return(testSet[3] - algF(trainSet, testSet[c(1,2)]))
} )
return(mean(errorVector ^ 2))
}
crossValidate <- function(algF, data, trials=100, test=0.1) {
errorVector <- sapply(1:trials, function(i) {
print(paste('Trail', i))
dataSets <- divideData(data, test)
return(testAlgorithm(algF, dataSets[['train']], dataSets[['test']]))
})
return(sum(errorVector) / trials)
}
data <- createSet()
print(crossValidate(knnEstimate, data))
IyBEZWZpbml0aW9uIG9mIHByaWNlLgpwcmljZSA8LSBmdW5jdGlvbihyYXRpbmcsIGFnZSkgewoJcGVha0FnZSA8LSByYXRpbmctIDUwCglwcmljZSA8LSByYXRpbmcgLyAyCglwcmljZSA8LSBzYXBwbHkoMTpsZW5ndGgocmF0aW5nKSwgZnVuY3Rpb24oaSl7CgkJCQlpZiAoYWdlW2ldID4gcGVha0FnZVtpXSkgewoJCQkJCXAgPC0gcHJpY2VbaV0gKiAoNSAtIChhZ2VbaV0gLSBwZWFrQWdlW2ldKSkKCQkJCX0gZWxzZSB7CgkJCQkJcCA8LSBwcmljZVtpXSAqIDUgKiAoYWdlW2ldICsgMSkgLyBwZWFrQWdlW2ldCgkJCQl9CgkJCQlyZXR1cm4oaWZlbHNlKHA8MCwgMCwgcCkpCgkJCX0pCglyZXR1cm4ocHJpY2UpCn0KCiMgQ3JlYXRlIGEgcHJpY2UgZGF0YXNldC4KY3JlYXRlU2V0IDwtIGZ1bmN0aW9uKG49MzAwKSB7CglyYW5kVmVjdG9yIDwtIHJ1bmlmKG4gKiAyKQoJcmF0aW5nIDwtIHJhbmRWZWN0b3JbMTpuXSAqIDUwICsgNTAKCWFnZSA8LSByYW5kVmVjdG9yWyhuKzEpOihuKjIpXSAqIDUwCglwcmljZSA8LSBwcmljZShyYXRpbmcsIGFnZSkgKiAocnVuaWYoMSkgKiAwLjIgKyAwLjkpCglkYXRhIDwtIGNiaW5kKHJhdGluZywgYWdlLCBwcmljZSkKCXJldHVybihkYXRhKQp9CgpnZXREaXN0YW5jZXMgPC0gZnVuY3Rpb24oZGF0YSwgdjEpIHsKCWRpc3RhbmNlcyA8LSBhcHBseShkYXRhWyxjKDEsMildLCAxLCBmdW5jdGlvbih2Mikgc3FydChzdW0oKHYyIC0gdjEpIF4gMikpKQoJZGlzdGFuY2VGcmFtZSA8LSBkYXRhLmZyYW1lKGRpc3RhbmNlPWRpc3RhbmNlcywgaW5kZXg9MTpucm93KGRhdGEpKQoJb3JkPW9yZGVyKGRpc3RhbmNlRnJhbWVbLCdkaXN0YW5jZSddKQoJcmV0dXJuKGRpc3RhbmNlRnJhbWVbb3JkLF0pCn0KCiMgS05OIGVzdGltYXRlLiAKa25uRXN0aW1hdGUgPC0gZnVuY3Rpb24oZGF0YSwgdjEsIGs9MykgewoJZGlzdGFuY2VzIDwtIGdldERpc3RhbmNlcyhkYXRhWyxjKDEsMildLCB2MSlbMTprLF0KCXJldCA8LSBtZWFuKGRhdGFbZGlzdGFuY2VzWywnaW5kZXgnXSwgJ3ByaWNlJ10pCglyZXR1cm4ocmV0KQp9CgojIERpdmlkZSBkYXRhIHNldCBpbnRvIHRyYWluaW5nIHNldCBhbmQgdGVzdCBzZXQuCmRpdmlkZURhdGEgPC0gZnVuY3Rpb24oZGF0YSwgdGVzdCA9IDAuMSkgewoJdGVzdEluZGljZXMgPC0gd2hpY2gocnVuaWYobnJvdyhkYXRhKSkgPCB0ZXN0KQoJcmV0dXJuKGxpc3QodGVzdD1kYXRhW3Rlc3RJbmRpY2VzLF0sIHRyYWluPWRhdGFbLXRlc3RJbmRpY2VzLF0pKQp9Cgp0ZXN0QWxnb3JpdGhtIDwtIGZ1bmN0aW9uKGFsZ0YsIHRyYWluU2V0LCB0ZXN0U2V0KSB7CgllcnJvclZlY3RvciA8LSBhcHBseSh0ZXN0U2V0LCAxLCBmdW5jdGlvbihpKSB7CgkJCQlyZXR1cm4odGVzdFNldFszXSAtIGFsZ0YodHJhaW5TZXQsIHRlc3RTZXRbYygxLDIpXSkpCgkJCX0gKQoJcmV0dXJuKG1lYW4oZXJyb3JWZWN0b3IgXiAyKSkKfQoKY3Jvc3NWYWxpZGF0ZSA8LSBmdW5jdGlvbihhbGdGLCBkYXRhLCB0cmlhbHM9MTAwLCB0ZXN0PTAuMSkgewoJZXJyb3JWZWN0b3IgPC0gc2FwcGx5KDE6dHJpYWxzLCBmdW5jdGlvbihpKSB7CgkJCQlwcmludChwYXN0ZSgnVHJhaWwnLCBpKSkKCQkJCWRhdGFTZXRzIDwtIGRpdmlkZURhdGEoZGF0YSwgdGVzdCkKCQkJCXJldHVybih0ZXN0QWxnb3JpdGhtKGFsZ0YsIGRhdGFTZXRzW1sndHJhaW4nXV0sIGRhdGFTZXRzW1sndGVzdCddXSkpCgkJCX0pCglyZXR1cm4oc3VtKGVycm9yVmVjdG9yKSAvIHRyaWFscykKfQoKZGF0YSA8LSBjcmVhdGVTZXQoKQpwcmludChjcm9zc1ZhbGlkYXRlKGtubkVzdGltYXRlLCBkYXRhKSkK