# Definition of price.
price <- function(rating, age) {
peakAge <- rating- 50
price <- rating / 2
ret <- sapply(1:length(rating), function(i){
if (age[i] > peakAge[i]) {
p <- price[i] * (5 - (age[i] - peakAge[i]) / 2)
} else {
p <- price[i] * 5 * (age[i] + 1) / peakAge[i]
}
return(ifelse(p<0, 0, p))
})
return(ret)
}
# Create a price dataset.
wineSet1 <- 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 <- sqrt(sum(sweep(data[,1:2],2,v1,FUN="-")^2))
distances
<- apply
(data
[,c
(1,2)], 1, function(v2
) sqrt(sum
((v2
- v1
) ^ 2))) distanceFrame <- cbind(distances,c(1:row(data)))#data.frame(distance=distances, index=1:nrow(data))
ord=order(distanceFrame[,1])
return(distanceFrame[ord,])
}
# KNN estimate.
knnEstimate <- function(data, v1, k=3) {
v <- unlist(v1)
idx
<- order
(sqrt(colSums
((t
(data
[,1:2]) - v
) ^ 2)))[1:k
] return(mean(data[idx,3]))
}
# 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(row) {
#print(paste(row[3], algF(trainSet, row[1:2])))
return(row[3] - algF(trainSet, row[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)
v <- testAlgorithm(algF, dataSets[['train']], dataSets[['test']])
return(v)
})
return(sum(errorVector) / trials)
}
data <- wineSet1()
print(crossValidate(weightedKNN, data))
IyBEZWZpbml0aW9uIG9mIHByaWNlLgpwcmljZSA8LSBmdW5jdGlvbihyYXRpbmcsIGFnZSkgewoJcGVha0FnZSA8LSByYXRpbmctIDUwCglwcmljZSA8LSByYXRpbmcgLyAyCglyZXQgPC0gc2FwcGx5KDE6bGVuZ3RoKHJhdGluZyksIGZ1bmN0aW9uKGkpewoJCQkJaWYgKGFnZVtpXSA+IHBlYWtBZ2VbaV0pIHsKCQkJCQlwIDwtIHByaWNlW2ldICogKDUgLSAoYWdlW2ldIC0gcGVha0FnZVtpXSkgLyAyKQoJCQkJfSBlbHNlIHsKCQkJCQlwIDwtIHByaWNlW2ldICogNSAqIChhZ2VbaV0gKyAxKSAvIHBlYWtBZ2VbaV0KCQkJCX0KCQkJCXJldHVybihpZmVsc2UocDwwLCAwLCBwKSkKCQkJfSkKCXJldHVybihyZXQpCn0KCiMgQ3JlYXRlIGEgcHJpY2UgZGF0YXNldC4Kd2luZVNldDEgPC0gZnVuY3Rpb24obj0zMDApIHsKCXJhbmRWZWN0b3IgPC0gcnVuaWYobiAqIDIpCglyYXRpbmcgPC0gcmFuZFZlY3RvclsxOm5dICogNTAgKyA1MAoJYWdlIDwtIHJhbmRWZWN0b3JbKG4rMSk6KG4qMildICogNTAKCXByaWNlIDwtIHByaWNlKHJhdGluZywgYWdlKSAqIChydW5pZigxKSAqIDAuMiArIDAuOSkKCWRhdGEgPC0gY2JpbmQocmF0aW5nLCBhZ2UsIHByaWNlKQoJcmV0dXJuKGRhdGEpCn0KCmdldERpc3RhbmNlcyA8LSBmdW5jdGlvbihkYXRhLCB2MSkgewoJI2Rpc3RhbmNlcyA8LSBzcXJ0KHN1bShzd2VlcChkYXRhWywxOjJdLDIsdjEsRlVOPSItIileMikpCglkaXN0YW5jZXMgPC0gYXBwbHkoZGF0YVssYygxLDIpXSwgMSwgZnVuY3Rpb24odjIpIHNxcnQoc3VtKCh2MiAtIHYxKSBeIDIpKSkKCWRpc3RhbmNlRnJhbWUgPC0gY2JpbmQoZGlzdGFuY2VzLGMoMTpyb3coZGF0YSkpKSNkYXRhLmZyYW1lKGRpc3RhbmNlPWRpc3RhbmNlcywgaW5kZXg9MTpucm93KGRhdGEpKQoJb3JkPW9yZGVyKGRpc3RhbmNlRnJhbWVbLDFdKQoJcmV0dXJuKGRpc3RhbmNlRnJhbWVbb3JkLF0pCn0KCiMgS05OIGVzdGltYXRlLiAKa25uRXN0aW1hdGUgPC0gZnVuY3Rpb24oZGF0YSwgdjEsIGs9MykgewoJdiA8LSB1bmxpc3QodjEpCglpZHggPC0gb3JkZXIoc3FydChjb2xTdW1zKCh0KGRhdGFbLDE6Ml0pIC0gdikgXiAyKSkpWzE6a10KCXJldHVybihtZWFuKGRhdGFbaWR4LDNdKSkKfQojIERpdmlkZSBkYXRhIHNldCBpbnRvIHRyYWluaW5nIHNldCBhbmQgdGVzdCBzZXQuCmRpdmlkZURhdGEgPC0gZnVuY3Rpb24oZGF0YSwgdGVzdCA9IDAuMSkgewoJdGVzdEluZGljZXMgPC0gd2hpY2gocnVuaWYobnJvdyhkYXRhKSkgPCB0ZXN0KQoJcmV0dXJuKGxpc3QodGVzdD1kYXRhW3Rlc3RJbmRpY2VzLF0sIHRyYWluPWRhdGFbLXRlc3RJbmRpY2VzLF0pKQp9Cgp0ZXN0QWxnb3JpdGhtIDwtIGZ1bmN0aW9uKGFsZ0YsIHRyYWluU2V0LCB0ZXN0U2V0KSB7CgllcnJvclZlY3RvciA8LSBhcHBseSh0ZXN0U2V0LCAxLCBmdW5jdGlvbihyb3cpIHsKCQkJCSNwcmludChwYXN0ZShyb3dbM10sIGFsZ0YodHJhaW5TZXQsIHJvd1sxOjJdKSkpCgkJCQlyZXR1cm4ocm93WzNdIC0gYWxnRih0cmFpblNldCwgcm93WzE6Ml0pKQoJCQl9ICkKCXJldHVybihtZWFuKGVycm9yVmVjdG9yIF4gMikpCn0KCmNyb3NzVmFsaWRhdGUgPC0gZnVuY3Rpb24oYWxnRiwgZGF0YSwgdHJpYWxzPTEwMCwgdGVzdD0wLjEpIHsKCWVycm9yVmVjdG9yIDwtIHNhcHBseSgxOnRyaWFscywgZnVuY3Rpb24oaSkgewoJCQkJI3ByaW50KHBhc3RlKCdUcmFpbCcsIGkpKQoJCQkJZGF0YVNldHMgPC0gZGl2aWRlRGF0YShkYXRhLCB0ZXN0KQoJCQkJdiA8LSB0ZXN0QWxnb3JpdGhtKGFsZ0YsIGRhdGFTZXRzW1sndHJhaW4nXV0sIGRhdGFTZXRzW1sndGVzdCddXSkKCQkJCXJldHVybih2KQoJCQl9KQoJcmV0dXJuKHN1bShlcnJvclZlY3RvcikgLyB0cmlhbHMpCn0KCmRhdGEgPC0gd2luZVNldDEoKQpwcmludChjcm9zc1ZhbGlkYXRlKHdlaWdodGVkS05OLCBkYXRhKSkK