Nothing
# This file was generated by Rcpp::compileAttributes
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
floyd <- function(data) {
.Call('KODAMA_floyd', PACKAGE = 'KODAMA', data)
}
knn.kodama <- function(Xtrain,
Ytrain,
Xtest,
Ytest=NULL,
k,
scaling=c("centering","autoscaling"),
perm.test=FALSE,
times=1000){
if(sum(is.na(Xtrain))>0) {
stop("Missing values are present in the traing set")
}
if(sum(is.na(Xtest))>0) {
stop("Missing values are present in the test set")
}
scal=pmatch(scaling,c("centering","autoscaling"))[1]
oo=list()
Xtrain=as.matrix(Xtrain)
Xtest=as.matrix(Xtest)
if(is.factor(Ytrain)){
lev=levels(Ytrain)
Ytrain=as.matrix(as.numeric(Ytrain))
o=.Call('KODAMA_knn_kodama_c', PACKAGE = 'KODAMA', Xtrain, Ytrain, Xtest, k,scal)
oo$Ypred=matrix(as.vector(factor(lev[o],levels=lev)),ncol=k)
if(!is.null(Ytest)){
Ytest_trans=as.numeric(transformy(as.matrix(as.numeric(Ytest))))
Ypred_trans=as.numeric(transformy(o[,k]))
oo$Q2Y=1-sum(((Ytest_trans-Ypred_trans))^2)/sum((Ytest_trans-mean(Ytest_trans))^2)
if(perm.test){
v=NULL
for(i in 1:times){
ss=sample(1:nrow(Xtrain))
Xtrain_permuted=Xtrain[ss,]
op=.Call('KODAMA_knn_kodama_r', PACKAGE = 'KODAMA', Xtrain_permuted, Ytrain, Xtest, k,scal)
Ypred_trans=as.numeric(transformy(op[,k]))
v[i]=1-sum(((Ytest_trans-Ypred_trans))^2)/sum((Ytest_trans-mean(Ytest_trans))^2)
}
oo$pval=sum(v>o$Q2Y)/times
}
}
}else{
Ytrain=as.matrix(Ytrain)
o=.Call('KODAMA_knn_kodama_r', PACKAGE = 'KODAMA', Xtrain, Ytrain, Xtest, k,scal)
oo$Ypred=o
if(!is.null(Ytest)){
oo$Q2Y=1-sum(((Ytest-oo$Ypred[,k]))^2)/sum((Ytest-mean(Ytest))^2)
if(perm.test){
v=NULL
for(i in 1:times){
ss=sample(1:nrow(Xtrain))
Xtrain_permuted=Xtrain[ss,]
op=.Call('KODAMA_knn_kodama_r', PACKAGE = 'KODAMA', Xtrain_permuted, Ytrain, Xtest, k,scal)
Ypred_permutated=op
v[i]=1-sum(((Ytest-Ypred_permutated))^2)/sum((Ytest-mean(Ytest))^2)
}
oo$pval=sum(v>o$Q2Y)/times
}
}
}
oo
}
KNNCV <- function(x, cl, constrain, k) {
.Call('KODAMA_KNNCV', PACKAGE = 'KODAMA', x, cl, constrain, k)
}
transformy <- function(y) {
.Call('KODAMA_transformy', PACKAGE = 'KODAMA', y)
}
PLSDACV <- function(x, cl, constrain, k) {
.Call('KODAMA_PLSDACV', PACKAGE = 'KODAMA', x, cl, constrain, k)
}
RQ <- function(yData, yPred) {
.Call('KODAMA_RQ', PACKAGE = 'KODAMA', yData, yPred)
}
pls.kodama =
function (Xtrain,
Ytrain,
Xtest,
Ytest = NULL,
ncomp, scaling = c("centering", "autoscaling"),
perm.test = FALSE, times = 1000)
{
scal = pmatch(scaling, c("centering", "autoscaling"))[1]
Xtrain = as.matrix(Xtrain)
Xtest = as.matrix(Xtest)
nr = nrow(Xtest)
if (is.factor(Ytrain)) {
lev = levels(Ytrain)
Ytrain = transformy(Ytrain)
o = .Call("KODAMA_pls_kodama", PACKAGE = "KODAMA", Xtrain,
Ytrain, Xtest, ncomp, scal)
Ypred = matrix(nrow = nr, ncol = ncomp)
for (i in 1:ncomp) {
t = apply(o$Ypred[, , i], 1, which.max)
Ypred[, i] = as.vector(factor(lev[t], levels = lev))
}
Ypredncomp=o$Ypred[, , ncomp]
o$Ypred = Ypred
if (!is.null(Ytest)) {
Ytest = transformy(Ytest)
tra=transformy(factor(Ypred[, ncomp], levels = lev))
o$Q2Y = 1 - sum(((Ytest - Ypredncomp))^2)/sum((Ytest - mean(Ytest))^2)
# o$scoreXtest=as.matrix(Xtest) %*% o$R[,1:ncomp]
if (perm.test) {
v = NULL
for (i in 1:times) {
ss = sample(1:nrow(Xtrain))
Xtrain_permuted = Xtrain[ss, ]
op = .Call("KODAMA_pls_kodama", PACKAGE = "KODAMA",
Xtrain_permuted, Ytrain, Xtest, ncomp, scal)
t = apply(op$Ypred[, , ncomp], 1, which.max)
Ypred_permutated = as.vector(factor(lev[t], levels = lev))
Ypredncomp=op$Ypred[, , ncomp]
tra=transformy(factor(Ypred_permutated, levels = lev))
v[i] = 1 - sum(((Ytest - Ypredncomp))^2)/sum((Ytest - mean(Ytest))^2)
}
o$pval = sum(v > o$Q2Y)/times
}
}
} else {
Ytrain = as.matrix(Ytrain)
o = .Call("KODAMA_pls_kodama", PACKAGE = "KODAMA", Xtrain,
Ytrain, Xtest, ncomp, scal)
Ypred = matrix(nrow = nr, ncol = ncomp)
for (i in 1:ncomp) {
Ypred[, i] = o$Ypred[, , i]
}
o$Ypred = Ypred
if (!is.null(Ytest)) {
o$Q2Y = 1 - sum(((Ytest - Ypred[, ncomp]))^2)/sum((Ytest -
mean(Ytest))^2)
# o$scoreXtest=as.matrix(Xtest) %*% o$R[,1:ncomp]
if (perm.test) {
v = NULL
for (i in 1:times) {
ss = sample(1:nrow(Xtrain))
Xtrain_permuted = Xtrain[ss, ]
op = .Call("KODAMA_pls_kodama", PACKAGE = "KODAMA",
Xtrain_permuted, Ytrain, Xtest, ncomp, scal)
Ypred_permutated = op$Ypred[, , ncomp]
v[i] = 1 - sum(((Ytest - Ypred_permutated))^2)/sum((Ytest -
mean(Ytest))^2)
}
o$pval = sum(v > o$Q2Y)/times
}
}
}
o
}
unic <- function(x) {
.Call('KODAMA_unic', PACKAGE = 'KODAMA', x)
}
optim_pls_cv <- function(x, clmatrix, constrain, ncomp) {
.Call('KODAMA_optim_pls_cv', PACKAGE = 'KODAMA', x, clmatrix, constrain, ncomp)
}
optim_knn_r_cv <- function(x, clmatrix, constrain, ncomp) {
.Call('KODAMA_optim_knn_r_cv', PACKAGE = 'KODAMA', x, clmatrix, constrain, ncomp)
}
optim_knn_C_cv <- function(x, clmatrix, constrain, ncomp) {
.Call('KODAMA_optim_knn_c_cv', PACKAGE = 'KODAMA', x, clmatrix, constrain, ncomp)
}
double_pls_cv <- function(x, y, constrain, type, verbose, compmax,optim,scaling) {
.Call('KODAMA_double_pls_cv', PACKAGE = 'KODAMA', x, y, constrain, type, verbose, compmax,optim,scaling)
}
double_knn_cv <- function(x, yy, constrain, type, verbose, compmax,optim,scaling) {
.Call('KODAMA_double_knn_cv', PACKAGE = 'KODAMA', x, yy, constrain, type, verbose, compmax,optim,scaling)
}
corecpp <- function(x, xTdata, clbest, Tcycle, FUN, fpar, constrain, fix, shake, proj) {
.Call('KODAMA_corecpp', PACKAGE = 'KODAMA', x, xTdata, clbest, Tcycle, FUN, fpar, constrain, fix, shake, proj)
}
knn_Armadillo <- function(Xtrain, Xtest, k) {
.Call('KODAMA_knn_Armadillo', PACKAGE = 'KODAMA', Xtrain, Xtest, k)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.