← Back to branch summary

~ubuntu-branches/ubuntu/maverick/cdk/maverick

« back to all changes in this revision

Viewing changes to src/org/openscience/cdk/qsar/model/data/pls_5.R

  • Committer: Bazaar Package Importer
  • Author(s): Paul Cager
  • Date: 2008-04-09 21:17:53 UTC
  • Revision ID: james.westby@ubuntu.com-20080409211753-46lmjw5z8mx5pd8d
Tags: upstream-1.0.2
Import upstream version 1.0.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/org/openscience/cdk/qsar/model/data/pls_5.R
 
1
#############################################
 
2
# PLS fit/predict converter
 
3
#############################################
 
4
plsFitConverter <-
 
5
function(obj,...) {
 
6
    tmp <- .JNew('org.openscience.cdk.qsar.model.R.PLSRegressionModelFit',
 
7
     obj$nobj, obj$nvar, obj$npred, obj$ncomp, obj$method)
 
8
    tmp$setTrainingData(
 
9
     obj$training$B, obj$training$Ypred, obj$training$RMS,
 
10
     obj$training$Xscores, obj$training$Xload,
 
11
     obj$training$Yscores, obj$training$Yload)
 
12
    tmp$PLSRegressionModelSetTrain()
 
13
    if ('validat' %in% names(obj)) {
 
14
        # Add validation fields
 
15
        tmp$setValidationData(
 
16
         obj$valid$niter, obj$valid$nLV,
 
17
         obj$valid$Ypred, obj$valid$RMS, obj$valid$RMS.sd, obj$valid$R2)
 
18
    }
 
19
    tmp
 
20
}
 
21
plsPredictConverter <- 
 
22
function(obj,...) {
 
23
    class(obj) <- 'matrix'
 
24
    .JNew('org.openscience.cdk.qsar.model.R.PLSRegressionModelPredict',ncol(obj),obj)
 
25
}
 
26
buildPLS <- function(modelname, params) {
 
27
    library(pls.pcr)
 
28
    paramlist <- hasmap.to.list(params)
 
29
    attach(paramlist)
 
30
    
 
31
    x <- matrix(unlist(x), nrow=length(x), byrow=TRUE)
 
32
    y <- matrix(unlist(y), nrow=length(y), byrow=TRUE)
 
33
    if (nrow(x) != nrow(y)) { stop('The number of observations in x & y dont match') }
 
34
 
 
35
    if (!ncomp) {
 
36
        ncomp <- 1:ncol(x)
 
37
    } else {
 
38
        ncomp <- unlist(ncomp)
 
39
    }
 
40
 
 
41
    if (!(method %in% c('PCR','SIMPLS','kernelPLS'))) {
 
42
        stop('Invalid methopd specification')
 
43
    }
 
44
    if (!(validation %in% c('none','CV'))) {
 
45
        stop('Invalid validation sepcification')
 
46
    }
 
47
    
 
48
    if (niter == 0 && validation == 'CV') {
 
49
        niter = nrow(y)
 
50
    }
 
51
    
 
52
 
 
53
    # We should do this since when both grpsize and niter are specified niter
 
54
    # is used. So if grpsize comes in as 0 (which will be the default setting)
 
55
    # we specify only niter and if not zero we use grpsize and ignore niter
 
56
    if (grpsize != 0) {
 
57
        assign(modelname,
 
58
        pls(x=x,y=y,ncomp=ncomp,method=method,validation=validation,grpsize=grpsize),
 
59
        pos=1)
 
60
    } else {
 
61
        assign(modelname,
 
62
        pls(x=x,y=y,ncomp=ncomp,method=method,validation=validation,niter=niter),
 
63
        pos=1)
 
64
    }
 
65
    detach(paramlist)
 
66
    get(modelname)
 
67
}
 
68
predictPLS <- function(modelname, params) {
 
69
    paramlist <- hashmap.to.list(params)
 
70
    attach(paramlist)
 
71
    
 
72
    newX <- matrix(unlist(newX), nrow=length(x), byrow=TRUE)
 
73
    model <- get(modelname)
 
74
    if (ncol(newX) != model$nvar) {
 
75
        stop('The number of independent variables in the new data does not match that specified during building')
 
76
    }
 
77
    if (nlv == FALSE) {
 
78
        preds <- predict(model, newX)
 
79
    } else {
 
80
        preds <- predict(model, newX, nlv)
 
81
    }
 
82
    class(preds) <- 'plsregressionprediction'
 
83
    preds
 
84
}