├── .covrignore ├── .github ├── .gitignore └── workflows │ └── R-CMD-check.yaml ├── tests ├── testthat.R └── testthat │ ├── test_linearFilter_calculations.R │ ├── test_homogeneous_tune.R │ └── test_heterogeneous_tune.R ├── logo └── xnet_logo.png ├── data ├── drugtarget.rda └── proteinInteraction.rda ├── docs ├── _config.yml ├── static │ └── images │ │ └── xnet_logo.png └── index.md ├── inst ├── testdata │ ├── testdata.rda │ └── testdataH.rda └── CITATION ├── xnet_JSSPaper ├── jsslogo.jpg ├── permute.pdf ├── CVsettings.pdf ├── imputation.pdf ├── nulldistr.pdf ├── Fig_settings.png ├── ClassInheritance.pdf └── xnet_JSSPaper.R ├── .Rbuildignore ├── .travis.yml ├── .gitignore ├── codecov.yml ├── R ├── internal_helpers.R ├── xnet-package.R ├── dim.R ├── test_symmetry.R ├── valid_dimensions.R ├── data_proteinInteraction.R ├── is_symmetric.R ├── weights.R ├── getlooInternal.R ├── data_drugtarget.R ├── getters_permtest.R ├── hat.R ├── create_grid.R ├── fitted.R ├── Class_tskrrTuneHomogeneous.R ├── residuals.R ├── Class_tskrrImputeHeterogeneous.R ├── getters_linearFilter.R ├── Class_tskrrImputeHomogeneous.R ├── prepare_lambdas.R ├── Class_linearFilter.R ├── all_generics.R ├── Class_tskrrImpute.R ├── Class_tskrrTuneHeterogeneous.R ├── loss_functions.R ├── eigen2hat.R ├── test_input.R ├── getters_tskrrImpute.R ├── Class_tskrrHomogeneous.R ├── getters_tskrrTune.R ├── match_labels.R ├── tskrr.fit.R ├── Class_tskrrHeterogeneous.R ├── impute_tskrr.fit.R ├── as_tuned.R ├── linear_filter.R ├── update.R ├── looInternal.R ├── loss.R ├── valid_labels.R ├── Class_tskrr.R ├── Class_tskrrTune.R └── Class_permtest.R ├── xnet.Rproj ├── man ├── tskrrTuneHomogeneous-class.Rd ├── tskrrTuneHeterogeneous-class.Rd ├── xnet-package.Rd ├── dim-tskrr-method.Rd ├── tskrrImpute-class.Rd ├── is_symmetric.Rd ├── weights.Rd ├── hat.Rd ├── getters-permtest.Rd ├── test_symmetry.Rd ├── valid_dimensions.Rd ├── linearFilter-class.Rd ├── tskrr-class.Rd ├── linear_filter.Rd ├── create_grid.Rd ├── match_labels.Rd ├── tskrrHeterogeneous-class.Rd ├── fitted.Rd ├── tskrrHomogeneous-class.Rd ├── proteinInteraction.Rd ├── eigen2hat.Rd ├── permtest-class.Rd ├── getters-tskrrImpute.Rd ├── getters_linearFilter.Rd ├── loss_functions.Rd ├── drugTargetInteraction.Rd ├── valid_labels.Rd ├── tskrrTune-class.Rd ├── getters-tskrrTune.Rd ├── tskrrImputeHeterogeneous-class.Rd ├── looInternal.Rd ├── tskrrImputeHomogeneous-class.Rd ├── update.Rd ├── tskrr.fit.Rd ├── as_tuned.Rd ├── plot_grid.Rd ├── tskrr.Rd ├── labels.Rd ├── loss.Rd ├── impute_tskrr.fit.Rd ├── getters-tskrr.Rd ├── loo.Rd ├── residuals.tskrr.Rd ├── impute_tskrr.Rd ├── permtest.Rd └── get_loo_fun.Rd ├── README.md ├── DESCRIPTION ├── pre-commit ├── NAMESPACE └── vignettes └── Preparation_example_data.Rmd /.covrignore: -------------------------------------------------------------------------------- 1 | R/Class_* 2 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(xnet) 3 | 4 | test_check("xnet") 5 | -------------------------------------------------------------------------------- /logo/xnet_logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CenterForStatistics-UGent/xnet/HEAD/logo/xnet_logo.png -------------------------------------------------------------------------------- /data/drugtarget.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CenterForStatistics-UGent/xnet/HEAD/data/drugtarget.rda -------------------------------------------------------------------------------- /docs/_config.yml: -------------------------------------------------------------------------------- 1 | theme: jekyll-theme-slate 2 | title: "XNET" 3 | description: "An R package for cross-network analysis" -------------------------------------------------------------------------------- /inst/testdata/testdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CenterForStatistics-UGent/xnet/HEAD/inst/testdata/testdata.rda -------------------------------------------------------------------------------- /xnet_JSSPaper/jsslogo.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CenterForStatistics-UGent/xnet/HEAD/xnet_JSSPaper/jsslogo.jpg -------------------------------------------------------------------------------- /xnet_JSSPaper/permute.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CenterForStatistics-UGent/xnet/HEAD/xnet_JSSPaper/permute.pdf -------------------------------------------------------------------------------- /data/proteinInteraction.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CenterForStatistics-UGent/xnet/HEAD/data/proteinInteraction.rda -------------------------------------------------------------------------------- /inst/testdata/testdataH.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CenterForStatistics-UGent/xnet/HEAD/inst/testdata/testdataH.rda -------------------------------------------------------------------------------- /xnet_JSSPaper/CVsettings.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CenterForStatistics-UGent/xnet/HEAD/xnet_JSSPaper/CVsettings.pdf -------------------------------------------------------------------------------- /xnet_JSSPaper/imputation.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CenterForStatistics-UGent/xnet/HEAD/xnet_JSSPaper/imputation.pdf -------------------------------------------------------------------------------- /xnet_JSSPaper/nulldistr.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CenterForStatistics-UGent/xnet/HEAD/xnet_JSSPaper/nulldistr.pdf -------------------------------------------------------------------------------- /xnet_JSSPaper/Fig_settings.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CenterForStatistics-UGent/xnet/HEAD/xnet_JSSPaper/Fig_settings.png -------------------------------------------------------------------------------- /docs/static/images/xnet_logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CenterForStatistics-UGent/xnet/HEAD/docs/static/images/xnet_logo.png -------------------------------------------------------------------------------- /xnet_JSSPaper/ClassInheritance.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CenterForStatistics-UGent/xnet/HEAD/xnet_JSSPaper/ClassInheritance.pdf -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^codecov\.yml$ 2 | ^\.travis\.yml$ 3 | ^.*\.Rproj$ 4 | ^\.Rproj\.user$ 5 | pre.commit 6 | README.md 7 | logo/* 8 | docs/* 9 | .covrignore 10 | xnet_JSSPaper/* 11 | ^\.github$ 12 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: R 4 | r: bioc-release 5 | sudo: false 6 | cache: packages 7 | 8 | after_success: 9 | - Rscript -e 'covr::codecov()' 10 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | inst/doc 6 | *.html 7 | *.log 8 | xnet_JSSPaper/xnet_JSSPaper.pdf 9 | /xnet_JSSPaper/xnet_JSSPaper.tex 10 | /xnet_JSSPaper/xnet_JSSPaper_files 11 | /xnet_JSSPaper/xnet_JSSPaper.pdf 12 | /xnet_JSSPaper/xnet_JSSPaper.log 13 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | codecov: 2 | token: 75b88134-7456-4c8c-9cda-36c35fa35f87 3 | 4 | comment: false 5 | 6 | coverage: 7 | status: 8 | project: 9 | default: 10 | target: auto 11 | threshold: 1% 12 | patch: 13 | default: 14 | target: auto 15 | threshold: 1% 16 | -------------------------------------------------------------------------------- /R/internal_helpers.R: -------------------------------------------------------------------------------- 1 | # Internal functions 2 | 3 | ## Check whether something is a whole number 4 | 5 | is_whole_number <- function(x){ 6 | if(is.integer(x)){ 7 | TRUE 8 | } else if(is.numeric(x)){ 9 | if((x%%1) == 0 ){ 10 | TRUE 11 | } else { 12 | FALSE 13 | } 14 | } else { 15 | FALSE 16 | } 17 | } 18 | 19 | is_whole_positive <- function(x){ 20 | if(is_whole_number(x) && x >= 0) TRUE else FALSE 21 | } 22 | 23 | -------------------------------------------------------------------------------- /xnet.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | StripTrailingWhitespace: Yes 16 | 17 | BuildType: Package 18 | PackageUseDevtools: Yes 19 | PackageInstallArgs: --no-multiarch --with-keep.source 20 | PackageRoxygenize: rd,collate,namespace 21 | -------------------------------------------------------------------------------- /man/tskrrTuneHomogeneous-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Class_tskrrTuneHomogeneous.R 3 | \docType{class} 4 | \name{tskrrTuneHomogeneous-class} 5 | \alias{tskrrTuneHomogeneous-class} 6 | \alias{tskrrTuneHomogeneous} 7 | \title{Class tskrrTuneHomogeneous} 8 | \description{ 9 | The class tskrrTuneHomogeneous represents a tuned homogeneous 10 | \code{\link[xnet:tskrr-class]{tskrr}} model. It inherits from 11 | the classes \code{\link[xnet:tskrrHomogeneous-class]{tskrrHomogeneous}} 12 | and \code{\link[xnet:tskrrTune-class]{tskrrTune}}. 13 | } 14 | -------------------------------------------------------------------------------- /man/tskrrTuneHeterogeneous-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Class_tskrrTuneHeterogeneous.R 3 | \docType{class} 4 | \name{tskrrTuneHeterogeneous-class} 5 | \alias{tskrrTuneHeterogeneous-class} 6 | \alias{tskrrTuneHeterogeneous} 7 | \title{Class tskrrTuneHeterogeneous} 8 | \description{ 9 | The class tskrrTuneHeterogeneous represents a tuned Heterogeneous 10 | \code{\link[xnet:tskrr-class]{tskrr}} model. It inherits from 11 | the classes \code{\link[xnet:tskrrHeterogeneous-class]{tskrrHeterogeneous}} 12 | and \code{\link[xnet:tskrrTune-class]{tskrrTune}}. 13 | } 14 | -------------------------------------------------------------------------------- /R/xnet-package.R: -------------------------------------------------------------------------------- 1 | #' Two-step kernel ridge regression for network analysis 2 | #' 3 | #' This package implements the two-step kernel ridge regression model, a 4 | #' supervised network prediction method that can be used for all kinds of network 5 | #' analyses. Examples are protein-protein interaction, foodwebs, ... 6 | #' 7 | #' @seealso Send your bug reports to: 8 | #' 9 | #' \url{https://github.com/CenterForStatistics-UGent/xnet/issues} 10 | #' 11 | #' More background in the paper by Stock et al, 2018: 12 | #' 13 | #' \url{http://doi.org/10.1093/bib/bby095} 14 | #' 15 | #' @author Joris Meys and Michiel Stock 16 | #' 17 | #' @import methods 18 | "_PACKAGE" 19 | -------------------------------------------------------------------------------- /R/dim.R: -------------------------------------------------------------------------------- 1 | #' Get the dimensions of a tskrr object 2 | #' 3 | #' These functions allow you to extract the dimensions of a tskrr 4 | #' object. These dimensions are essentially the dimensions of the 5 | #' label matrix y. 6 | #' 7 | #' @param x a \code{\link[=tskrr-class]{tskrr}} object. 8 | #' 9 | #' @return a vector with two values indicating the number of rows 10 | #' and the number of columns. 11 | #' 12 | #' @examples 13 | #' data(drugtarget) 14 | #' mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 15 | #' dim(mod) 16 | #' nrow(mod) 17 | #' ncol(mod) 18 | #' 19 | #' @aliases dim.tskrr 20 | #' @export 21 | setMethod("dim", 22 | "tskrr", 23 | function(x){ 24 | dim(x@y) 25 | }) 26 | -------------------------------------------------------------------------------- /man/xnet-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/xnet-package.R 3 | \docType{package} 4 | \name{xnet-package} 5 | \alias{xnet} 6 | \alias{xnet-package} 7 | \title{Two-step kernel ridge regression for network analysis} 8 | \description{ 9 | This package implements the two-step kernel ridge regression model, a 10 | supervised network prediction method that can be used for all kinds of network 11 | analyses. Examples are protein-protein interaction, foodwebs, ... 12 | } 13 | \seealso{ 14 | Send your bug reports to: 15 | 16 | \url{https://github.com/CenterForStatistics-UGent/xnet/issues} 17 | 18 | More background in the paper by Stock et al, 2018: 19 | 20 | \url{http://doi.org/10.1093/bib/bby095} 21 | } 22 | \author{ 23 | Joris Meys and Michiel Stock 24 | } 25 | -------------------------------------------------------------------------------- /man/dim-tskrr-method.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dim.R 3 | \name{dim,tskrr-method} 4 | \alias{dim,tskrr-method} 5 | \alias{dim.tskrr} 6 | \title{Get the dimensions of a tskrr object} 7 | \usage{ 8 | \S4method{dim}{tskrr}(x) 9 | } 10 | \arguments{ 11 | \item{x}{a \code{\link[=tskrr-class]{tskrr}} object.} 12 | } 13 | \value{ 14 | a vector with two values indicating the number of rows 15 | and the number of columns. 16 | } 17 | \description{ 18 | These functions allow you to extract the dimensions of a tskrr 19 | object. These dimensions are essentially the dimensions of the 20 | label matrix y. 21 | } 22 | \examples{ 23 | data(drugtarget) 24 | mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 25 | dim(mod) 26 | nrow(mod) 27 | ncol(mod) 28 | 29 | } 30 | -------------------------------------------------------------------------------- /man/tskrrImpute-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Class_tskrrImpute.R 3 | \docType{class} 4 | \name{tskrrImpute-class} 5 | \alias{tskrrImpute-class} 6 | \alias{tskrrImpute} 7 | \title{Class tskrrImpute} 8 | \description{ 9 | The class \code{tskrrImpute} is a virtual class that represents a 10 | \code{\link[xnet:tskrr-class]{tskrr}} model with imputed values in 11 | the label matrix Y. Apart from the model, it contains the 12 | following extra information on the imputed values. 13 | } 14 | \section{Slots}{ 15 | 16 | \describe{ 17 | \item{\code{imputeid}}{a vector with integer values indicating which of 18 | the values in \code{y} are imputed} 19 | 20 | \item{\code{niter}}{an integer value gving the number of iterations used} 21 | 22 | \item{\code{tol}}{a numeric value with the tolerance used} 23 | }} 24 | 25 | -------------------------------------------------------------------------------- /man/is_symmetric.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/is_symmetric.R 3 | \name{is_symmetric} 4 | \alias{is_symmetric} 5 | \title{Test symmetry of a matrix} 6 | \usage{ 7 | is_symmetric(x, tol = 100 * .Machine$double.eps) 8 | } 9 | \arguments{ 10 | \item{x}{a matrix to be tested.} 11 | 12 | \item{tol}{the tolerance for comparing the numbers.} 13 | } 14 | \value{ 15 | a logical value indicating whether or not the matrix is 16 | symmetric 17 | } 18 | \description{ 19 | The function \code{\link[base]{isSymmetric}} tests for symmetry of a matrix but also 20 | takes row and column names into account. This function is a toned-down 21 | (and slightly faster) version that ignores row and column names. 22 | Currently, the function only works for real matrices, not complex ones. 23 | } 24 | \examples{ 25 | x <- matrix(1:16,ncol = 4) 26 | is_symmetric(x) 27 | 28 | x <- x \%*\% t(x) 29 | is_symmetric(x) 30 | 31 | } 32 | -------------------------------------------------------------------------------- /man/weights.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/weights.R 3 | \name{weights,tskrrHeterogeneous-method} 4 | \alias{weights,tskrrHeterogeneous-method} 5 | \alias{weights} 6 | \alias{weights,tskrrHomogeneous-method} 7 | \title{Extract weights from a tskrr model} 8 | \usage{ 9 | \S4method{weights}{tskrrHeterogeneous}(object) 10 | 11 | \S4method{weights}{tskrrHomogeneous}(object) 12 | } 13 | \arguments{ 14 | \item{object}{a \code{\link{tskrr}} object for which the weights 15 | have to be calculated.} 16 | } 17 | \value{ 18 | a matrix with the weights for the tskrr model. 19 | } 20 | \description{ 21 | This function calculates the weight matrix for 22 | calculating the predictions of a tskrr model. 23 | } 24 | \details{ 25 | The weight matrix is calculated from the map matrices through the 26 | function \code{\link{eigen2map}}. 27 | } 28 | \note{ 29 | The package \code{xnet} adds a S4 generic function 30 | for \code{\link[stats]{weights}}. 31 | } 32 | -------------------------------------------------------------------------------- /man/hat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/all_generics.R, R/hat.R 3 | \name{hat} 4 | \alias{hat} 5 | \alias{hat,tskrrHeterogeneous-method} 6 | \alias{hat,tskrrHomogeneous-method} 7 | \title{Return the hat matrix of a tskrr model} 8 | \usage{ 9 | hat(x, ...) 10 | 11 | \S4method{hat}{tskrrHeterogeneous}(x, which = c("row", "column")) 12 | 13 | \S4method{hat}{tskrrHomogeneous}(x, ...) 14 | } 15 | \arguments{ 16 | \item{x}{a tskrr model} 17 | 18 | \item{...}{arguments passed to other methods.} 19 | 20 | \item{which}{a character value with possible values "row" or 21 | "column" to indicate which should be returned. For homogeneous 22 | models, this parameter is ignored.} 23 | } 24 | \value{ 25 | the requested hat matrix of the model. 26 | } 27 | \description{ 28 | This function returns the hat matrix or hat matrices of 29 | a tskrr model. \code{xnet} creates an S4 generic for \code{hat} 30 | and links the default method to the \code{\link[=influence.measures]{hat}} function 31 | of \code{stats} 32 | } 33 | -------------------------------------------------------------------------------- /man/getters-permtest.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getters_permtest.R 3 | \name{permutations} 4 | \alias{permutations} 5 | \alias{Extract-permtest} 6 | \alias{[,permtest-method} 7 | \title{Getters for permtest objects} 8 | \usage{ 9 | permutations(x) 10 | 11 | \S4method{[}{permtest}(x, i) 12 | } 13 | \arguments{ 14 | \item{x}{a \code{\link[xnet:permtest-class]{permtest}} object} 15 | 16 | \item{i}{either a numeric vector, a logical vector or a character 17 | vector with the elements that need extraction.} 18 | } 19 | \value{ 20 | the requested values 21 | } 22 | \description{ 23 | The functions described here are convenience functions to get 24 | information out of a \code{\link[xnet:permtest-class]{permtest}} 25 | object. 26 | } 27 | \examples{ 28 | 29 | data(drugtarget) 30 | 31 | mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 32 | ptest <- permtest(mod, fun = loss_auc) 33 | 34 | loss(ptest) 35 | ptest[c(2,3)] 36 | permutations(ptest) 37 | 38 | } 39 | \seealso{ 40 | \code{\link{loss}} to extract the original loss value. 41 | } 42 | -------------------------------------------------------------------------------- /man/test_symmetry.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/test_symmetry.R 3 | \name{test_symmetry} 4 | \alias{test_symmetry} 5 | \title{test the symmetry of a matrix} 6 | \usage{ 7 | test_symmetry(x, tol = .Machine$double.eps) 8 | } 9 | \arguments{ 10 | \item{x}{a matrix} 11 | 12 | \item{tol}{a single numeric value with the tolerance for comparison} 13 | } 14 | \value{ 15 | a character value with the possible values "symmetric", 16 | "skewed" or "none". 17 | } 18 | \description{ 19 | This function tells you whether a matrix is symmetric, 20 | skewed symmetric, or not symmetric. It's used by \code{\link{tskrr}} 21 | to determine which kind of homologous network is represented by 22 | the label matrix. 23 | } 24 | \examples{ 25 | mat1 <- matrix(c(1,0,0,1),ncol = 2) 26 | test_symmetry(mat1) 27 | mat2 <- matrix(c(1,0,0,-1), ncol = 2) 28 | test_symmetry(mat2) 29 | mat3 <- matrix(1:4, ncol = 2) 30 | test_symmetry(mat3) 31 | 32 | } 33 | \seealso{ 34 | \code{\link{tskrrHomogeneous}} for 35 | more information on the values for the slot \code{symmetry} 36 | } 37 | -------------------------------------------------------------------------------- /man/valid_dimensions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/valid_dimensions.R 3 | \name{valid_dimensions} 4 | \alias{valid_dimensions} 5 | \alias{is_square} 6 | \title{Functions to check matrices} 7 | \usage{ 8 | valid_dimensions(y, k, g = NULL) 9 | 10 | is_square(x) 11 | } 12 | \arguments{ 13 | \item{y}{a label matrix} 14 | 15 | \item{k}{a kernel matrix} 16 | 17 | \item{g}{an optional second kernel matrix or \code{NULL} otherwise.} 18 | 19 | \item{x}{any matrix} 20 | } 21 | \value{ 22 | a logical value indicating whether the dimensions of the 23 | matrices are compatible for a two step kernel ridge regression. 24 | } 25 | \description{ 26 | These functions allow you to check whether the dimensions of the 27 | label matrix and the kernel matrix (matrices) are compatible. 28 | \code{valid_dimensions} checks whether both k and g are square matrices, 29 | whether y has as many rows as k and whether y has as many columns as g. 30 | \code{is_square} checks whether both dimensions are the same. 31 | } 32 | \note{ 33 | The function \code{is_square} is not exported 34 | } 35 | -------------------------------------------------------------------------------- /man/linearFilter-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Class_linearFilter.R 3 | \docType{class} 4 | \name{linearFilter-class} 5 | \alias{linearFilter-class} 6 | \alias{linearFilter} 7 | \title{Class linearFilter} 8 | \description{ 9 | The class represents the outcome of a linear filter, and is normally 10 | generated by the function \code{\link{linear_filter}} 11 | } 12 | \section{Slots}{ 13 | 14 | \describe{ 15 | \item{\code{y}}{the original label matrix with responses.} 16 | 17 | \item{\code{alpha}}{a numeric vector with the 4 alpha values of the model.} 18 | 19 | \item{\code{pred}}{a matrix with the predictions} 20 | 21 | \item{\code{mean}}{a numeric vector containing the global mean of \code{y}} 22 | 23 | \item{\code{colmeans}}{a numeric vector containing the column means of \code{y}} 24 | 25 | \item{\code{rowmeans}}{a numeric vector containing the row means of \code{y}.} 26 | 27 | \item{\code{na.rm}}{a logical value indicating whether missing values were 28 | removed prior to the calculation of the means.} 29 | }} 30 | 31 | \seealso{ 32 | \code{\link{linear_filter}} for creating a linear filter model, 33 | and \code{\link[=getters_linearFilter]{getter fuctions for linearFilter}}. 34 | } 35 | -------------------------------------------------------------------------------- /R/test_symmetry.R: -------------------------------------------------------------------------------- 1 | #' test the symmetry of a matrix 2 | #' 3 | #' This function tells you whether a matrix is symmetric, 4 | #' skewed symmetric, or not symmetric. It's used by \code{\link{tskrr}} 5 | #' to determine which kind of homologous network is represented by 6 | #' the label matrix. 7 | #' 8 | #' @param x a matrix 9 | #' @param tol a single numeric value with the tolerance for comparison 10 | #' 11 | #' @return a character value with the possible values "symmetric", 12 | #' "skewed" or "none". 13 | #' 14 | #' @seealso \code{\link{tskrrHomogeneous}} for 15 | #' more information on the values for the slot \code{symmetry} 16 | #' 17 | #' @examples 18 | #' mat1 <- matrix(c(1,0,0,1),ncol = 2) 19 | #' test_symmetry(mat1) 20 | #' mat2 <- matrix(c(1,0,0,-1), ncol = 2) 21 | #' test_symmetry(mat2) 22 | #' mat3 <- matrix(1:4, ncol = 2) 23 | #' test_symmetry(mat3) 24 | #' 25 | #' @export 26 | test_symmetry <- function(x, tol = .Machine$double.eps){ 27 | if(!is.matrix(x)) 28 | stop("x should be a matrix") 29 | idl <- lower.tri(x) 30 | tx <- t(x) 31 | 32 | if(all(abs(x[idl] - tx[idl]) < tol )){ 33 | out <- "symmetric" 34 | } else if(all( abs(x[idl] + tx[idl]) < tol )){ 35 | out <- "skewed" 36 | } else { 37 | out <- "none" 38 | } 39 | return(out) 40 | } 41 | -------------------------------------------------------------------------------- /man/tskrr-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Class_tskrr.R 3 | \name{tskrr-class} 4 | \alias{tskrr-class} 5 | \title{Class tskrr} 6 | \description{ 7 | The class tskrr represents a two step kernel ridge regression fitting 8 | object, and is normally generated by the function \code{\link{tskrr}}. 9 | This is a superclass so it should not be instantiated directly. 10 | } 11 | \section{Slots}{ 12 | 13 | \describe{ 14 | \item{\code{y}}{the matrix with responses} 15 | 16 | \item{\code{k}}{the eigen decomposition of the kernel matrix for the rows} 17 | 18 | \item{\code{lambda.k}}{the lambda value used for k} 19 | 20 | \item{\code{pred}}{the matrix with the predictions} 21 | 22 | \item{\code{has.hat}}{a logical value indicating whether the kernel hat matrices 23 | are stored in the object.} 24 | 25 | \item{\code{Hk}}{the kernel hat matrix for the rows.} 26 | 27 | \item{\code{labels}}{a list with two character vectors, \code{k} and 28 | \code{g}, containing the labels for the rows resp. columns. See 29 | \code{\link{tskrrHomogeneous}} and 30 | \code{\link{tskrrHeterogeneous}} for more details.} 31 | }} 32 | 33 | \seealso{ 34 | the classes \code{\link{tskrrHomogeneous}} and 35 | \code{\link{tskrrHeterogeneous}} for the actual classes. 36 | } 37 | -------------------------------------------------------------------------------- /man/linear_filter.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/linear_filter.R 3 | \name{linear_filter} 4 | \alias{linear_filter} 5 | \title{Fit a linear filter over a label matrix} 6 | \usage{ 7 | linear_filter(y, alpha = 0.25, na.rm = FALSE) 8 | } 9 | \arguments{ 10 | \item{y}{a label matrix} 11 | 12 | \item{alpha}{a vector with 4 alpha values, or a single alpha value 13 | which then is used for all 4 alphas.} 14 | 15 | \item{na.rm}{a logical value indicating whether missing values should 16 | be removed before calculating the row-, column- and total means.} 17 | } 18 | \value{ 19 | an object of class \code{\link[=linearFilter-class]{linearFilter}} 20 | } 21 | \description{ 22 | This function fits a linear filter over a label matrix. It calculates 23 | the row, column and total means, and uses those to construct the linear 24 | filter. 25 | } 26 | \details{ 27 | If there are missing values and they are removed before calculating the 28 | means, a warning is issued. If \code{na.rm = FALSE} and there are 29 | missing values present, the outcome is, by definition, a matrix filled 30 | with NA values. 31 | } 32 | \examples{ 33 | data(drugtarget) 34 | linear_filter(drugTargetInteraction, alpha = 0.25) 35 | linear_filter(drugTargetInteraction, alpha = c(0.1,0.1,0.4,0.4)) 36 | 37 | } 38 | -------------------------------------------------------------------------------- /R/valid_dimensions.R: -------------------------------------------------------------------------------- 1 | #' Functions to check matrices 2 | #' 3 | #' These functions allow you to check whether the dimensions of the 4 | #' label matrix and the kernel matrix (matrices) are compatible. 5 | #' \code{valid_dimensions} checks whether both k and g are square matrices, 6 | #' whether y has as many rows as k and whether y has as many columns as g. 7 | #' \code{is_square} checks whether both dimensions are the same. 8 | #' 9 | #' @param y a label matrix 10 | #' @param k a kernel matrix 11 | #' @param g an optional second kernel matrix or \code{NULL} otherwise. 12 | #' 13 | #' @return a logical value indicating whether the dimensions of the 14 | #' matrices are compatible for a two step kernel ridge regression. 15 | #' 16 | #' @note The function \code{is_square} is not exported 17 | #' 18 | #' @rdname valid_dimensions 19 | #' @export 20 | valid_dimensions <- function(y, k, g = NULL){ 21 | 22 | ydim <- dim(y) 23 | out <- is_square(k) && ydim[1L] == dim(k)[2L] 24 | 25 | if(!is.null(g)){ 26 | out <- out && is_square(g) && ydim[2L] == dim(g)[1L] 27 | } else { 28 | out <- out && is_square(y) 29 | } 30 | 31 | return(out) 32 | } 33 | 34 | #' @param x any matrix 35 | #' @rdname valid_dimensions 36 | #' @aliases is_square 37 | is_square <- function(x){ 38 | dims <- dim(x) 39 | dims[2L] == dims[1L] 40 | } 41 | -------------------------------------------------------------------------------- /man/create_grid.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/create_grid.R 3 | \name{create_grid} 4 | \alias{create_grid} 5 | \title{Create a grid of values for tuning tskrr} 6 | \usage{ 7 | create_grid(lim = c(1e-04, 10000), ngrid = 10) 8 | } 9 | \arguments{ 10 | \item{lim}{a numeric vector with 2 values giving the lower and upper limit 11 | for the grid.} 12 | 13 | \item{ngrid}{the number of values that have to be produced. If this 14 | number is not integer, it is truncated. The value should be 2 or 15 | larger.} 16 | } 17 | \value{ 18 | a numeric vector with values evenly spaced on a 19 | logarithmic scale. 20 | } 21 | \description{ 22 | This function creates a grid of values for 23 | tuning a \code{\link{tskrr}} model. The grid is equally spaced on 24 | a logarithmic scale. Normally it's not needed to call this method 25 | directly, it's usually called from \code{\link{tune}}. 26 | } 27 | \details{ 28 | The \code{lim} argument sets the boundaries of the domain in which 29 | the lambdas are sought. The lambda values at which the function is 30 | evaluated, are calculated as: 31 | 32 | \code{exp(seq(log(1e-4), log(1e4), length.out = ngrid))} 33 | } 34 | \examples{ 35 | create_grid(lim = c(1e-4, 1), ngrid = 5) 36 | 37 | } 38 | \seealso{ 39 | \code{\link{tune}} for tuning a tskrr model. 40 | } 41 | -------------------------------------------------------------------------------- /R/data_proteinInteraction.R: -------------------------------------------------------------------------------- 1 | #' Protein interaction for yeast 2 | #' 3 | #' A dataset for examining the interaction between proteins of 4 | #' yeast. The dataset consists of the following objects: 5 | #' 6 | #' \itemize{ 7 | #' \item proteinInteraction: the label matrix based on the protein 8 | #' network taken from the KEGG/PATHWAY database 9 | #' \item Kmat_y2h_sc: a kernel matrix indicating similarity of proteins. 10 | #' } 11 | #' 12 | #' The proteins in the dataset are a subset of the 769 proteins 13 | #' used in Yamanishi et al (2004). The kernel matrix used is the 14 | #' combination of 4 kernels: one based on expression data, one 15 | #' on protein interaction data, one on localization data and one 16 | #' on phylogenetic profile. These kernels and their combination are 17 | #' also explained in Yamanishi et al (2004). 18 | #' 19 | #' @format 20 | #' \itemize{ 21 | #' \item proteinInteraction: a numeric square matrix with 150 rows/columns 22 | #' \item Kmat_y2h_sc: a numeric square matrix with 150 rows/columns 23 | #' } 24 | #' 25 | #' @references \href{https://doi.org/10.1093/bioinformatics/bth910}{Yamanishi et al, 2004}: Protein network inference from multiple genomic data: a supervised approach. 26 | #' 27 | #' @source \url{https://doi.org/10.1093/bioinformatics/bth910} 28 | #' @aliases Kmat_y2h_sc 29 | "proteinInteraction" 30 | -------------------------------------------------------------------------------- /man/match_labels.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/match_labels.R 3 | \name{match_labels} 4 | \alias{match_labels} 5 | \title{Reorder the label matrix} 6 | \usage{ 7 | match_labels(y, rows, cols = NULL) 8 | } 9 | \arguments{ 10 | \item{y}{a matrix representing the label matrix.} 11 | 12 | \item{rows}{a character vector with the labels for the rows or a matrix 13 | with rownames that will be used as labels.} 14 | 15 | \item{cols}{a character vector with the labels for the cols or a matrix 16 | with colnames that will be used as labels. If \code{NULL}, \code{rows} will be 17 | used for both row and column labels.} 18 | } 19 | \value{ 20 | a matrix with the rows and columns reordered. 21 | } 22 | \description{ 23 | Reorders the label matrix based on the labels of the kernel matrices. 24 | In case there are no labels, the original label matrix is returned, 25 | but with the labels in \code{rows} and \code{cols} as rownames and 26 | column names respectively. 27 | } 28 | \examples{ 29 | mat <- matrix(1:6, ncol = 2, 30 | dimnames = list(c("b", "a", "d"), 31 | c("ca", "cb")) 32 | ) 33 | 34 | match_labels(mat, c("a","b", "d"), c("ca","cb")) 35 | 36 | #Using matrices 37 | data(drugtarget) 38 | out <- match_labels(drugTargetInteraction, targetSim, drugSim) 39 | 40 | } 41 | -------------------------------------------------------------------------------- /R/is_symmetric.R: -------------------------------------------------------------------------------- 1 | #' Test symmetry of a matrix 2 | #' 3 | #' The function \code{\link[base]{isSymmetric}} tests for symmetry of a matrix but also 4 | #' takes row and column names into account. This function is a toned-down 5 | #' (and slightly faster) version that ignores row and column names. 6 | #' Currently, the function only works for real matrices, not complex ones. 7 | #' 8 | #' @param x a matrix to be tested. 9 | #' @param tol the tolerance for comparing the numbers. 10 | #' 11 | #' @return a logical value indicating whether or not the matrix is 12 | #' symmetric 13 | #' 14 | #' @examples 15 | #' x <- matrix(1:16,ncol = 4) 16 | #' is_symmetric(x) 17 | #' 18 | #' x <- x %*% t(x) 19 | #' is_symmetric(x) 20 | #' 21 | #' @export 22 | is_symmetric <- function(x, tol = 100 * .Machine$double.eps){ 23 | 24 | if(!is.numeric(x) || !is.matrix(x)) 25 | stop("x should be a numeric matrix") 26 | 27 | dims <- dim(x) 28 | 29 | if((n <- dims[1L]) != dims[2L]) 30 | return(FALSE) 31 | else if(n == 1L) 32 | return(TRUE) 33 | 34 | # fast first testing to check if the first column and row match 35 | if(any(abs(x[1,] - x[,1]) > tol)) 36 | return(FALSE) 37 | 38 | rd <- .row(dims - 1L) + 1 39 | cd <- .col(dims - 1L) + 1 40 | tohave <- rd > cd 41 | 42 | idr <- rd[tohave] 43 | idc <- cd[tohave] 44 | 45 | all(abs(x[cbind(idr,idc)] - x[cbind(idc,idr)]) < tol) 46 | 47 | } 48 | -------------------------------------------------------------------------------- /man/tskrrHeterogeneous-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Class_tskrrHeterogeneous.R 3 | \docType{class} 4 | \name{tskrrHeterogeneous-class} 5 | \alias{tskrrHeterogeneous-class} 6 | \alias{tskrrHeterogeneous} 7 | \title{Class tskrrHeterogeneous} 8 | \description{ 9 | The class tskrrHeterogeneous is a subclass of the superclass 10 | \code{\link[xnet:tskrr-class]{tskrr}} specifically for 11 | heterogeneous networks. 12 | } 13 | \section{Slots}{ 14 | 15 | \describe{ 16 | \item{\code{y}}{the matrix with responses} 17 | 18 | \item{\code{k}}{the eigen decomposition of the kernel matrix for the rows} 19 | 20 | \item{\code{lambda.k}}{the lambda value used for k} 21 | 22 | \item{\code{pred}}{the matrix with the predictions} 23 | 24 | \item{\code{g}}{the eigen decomposition of the kernel matrix for the columns} 25 | 26 | \item{\code{lambda.g}}{the lambda value used for g} 27 | 28 | \item{\code{has.hat}}{a logical value indicating whether the kernel hat matrices 29 | are stored in the object.} 30 | 31 | \item{\code{Hk}}{the kernel hat matrix for the rows.} 32 | 33 | \item{\code{Hg}}{the kernel hat matrix for the columns.} 34 | 35 | \item{\code{labels}}{a list with elements \code{k} and \code{g} (see 36 | \code{\link{tskrr-class}}). 37 | If any element is \code{NA}, the labels used 38 | are integers indicating the row resp column number.} 39 | }} 40 | 41 | -------------------------------------------------------------------------------- /man/fitted.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fitted.R 3 | \name{fitted.tskrr} 4 | \alias{fitted.tskrr} 5 | \alias{fitted.linearFilter} 6 | \alias{fitted,tskrr-method} 7 | \alias{fitted,linearFilter-method} 8 | \title{extract the predictions} 9 | \usage{ 10 | \method{fitted}{tskrr}(object, labels = TRUE, ...) 11 | 12 | \method{fitted}{linearFilter}(object, ...) 13 | 14 | \S4method{fitted}{tskrr}(object, labels = TRUE, ...) 15 | 16 | \S4method{fitted}{linearFilter}(object, ...) 17 | } 18 | \arguments{ 19 | \item{object}{an object for which the extraction of model fitted values 20 | is meaningful.} 21 | 22 | \item{labels}{a logical value indicating whether the labels should 23 | be shown. Defaults to TRUE} 24 | 25 | \item{...}{arguments passed to or from other methods.} 26 | } 27 | \value{ 28 | a numeric matrix with the predictions 29 | } 30 | \description{ 31 | This functions extracts the fitted predictions from a 32 | \code{\link[xnet:tskrr-class]{tskrr}} object or an object 33 | inheriting from that class. The \code{xnet} 34 | package provides an S4 generic for the function 35 | \code{\link[=fitted]{fitted}} from the package \code{stats}, 36 | and a method for \code{\link[xnet:tskrr-class]{tskrr}} objects. 37 | } 38 | \examples{ 39 | 40 | data(drugtarget) 41 | 42 | mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 43 | pred <- fitted(mod) 44 | 45 | } 46 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citation(auto = meta) 2 | 3 | # After the paper of Michiel is published, this should be 4 | # filled in. 5 | 6 | bibentry("Article", 7 | title = "Algebraic shortcuts for leave-one-out crossvalidation 8 | in supervised network inference.", 9 | author = c( 10 | person("Michiel","Stock"), 11 | person("Tapio", "Pahikkala"), 12 | person("Antti","Airola"), 13 | person("Willem", "Waegeman"), 14 | person("Bernard", "de Baets") 15 | ), 16 | journal = "Briefings in Bioinformatic", 17 | year = "2018", 18 | pages = "bby095", 19 | doi = "10.1093/bib/bby095", 20 | header = paste( 21 | "For reference to the methods from this package, use: " 22 | ) 23 | ) 24 | 25 | 26 | bibentry("Article", 27 | title = "A comparative study of pairwise learning methods based on Kernel Ridge Regression", 28 | author = c( 29 | person("Michiel","Stock"), 30 | person("Tapio", "Pahikkala"), 31 | person("Antti","Airola"), 32 | person("Bernard", "de Baets"), 33 | person("Willem", "Waegeman") 34 | ), 35 | journal = "Neural Computation", 36 | year = "2018", 37 | volume = "30", 38 | number = "8", 39 | pages = "2245-2283", 40 | doi = "10.1162/neco_a_01096" 41 | ) 42 | 43 | 44 | -------------------------------------------------------------------------------- /R/weights.R: -------------------------------------------------------------------------------- 1 | #' Extract weights from a tskrr model 2 | #' 3 | #' This function calculates the weight matrix for 4 | #' calculating the predictions of a tskrr model. 5 | #' 6 | #' The weight matrix is calculated from the map matrices through the 7 | #' function \code{\link{eigen2map}}. 8 | #' 9 | #' @note The package \code{xnet} adds a S4 generic function 10 | #' for \code{\link[stats]{weights}}. 11 | #' 12 | #' @param object a \code{\link{tskrr}} object for which the weights 13 | #' have to be calculated. 14 | #' 15 | #' 16 | #' @return a matrix with the weights for the tskrr model. 17 | #' 18 | #' @rdname weights 19 | #' @aliases weights 20 | #' @export 21 | setMethod("weights", 22 | "tskrrHeterogeneous", 23 | function(object){ 24 | eigK <- get_eigen(object, 'row') 25 | eigG <- get_eigen(object, 'column') 26 | l <- lambda(object) 27 | 28 | Mk <- eigen2map(eigK$vectors, eigK$values, l[1]) 29 | Mg <- eigen2map(eigG$vectors, eigG$values, l[2]) 30 | 31 | Mk %*% response(object) %*% Mg 32 | }) 33 | 34 | #' @rdname weights 35 | #' @export 36 | setMethod("weights", 37 | "tskrrHomogeneous", 38 | function(object){ 39 | eigK <- get_eigen(object) 40 | l <- lambda(object) 41 | 42 | Mk <- eigen2map(eigK$vectors, eigK$values, l) 43 | 44 | Mk %*% response(object) %*% Mk 45 | }) 46 | -------------------------------------------------------------------------------- /man/tskrrHomogeneous-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Class_tskrrHomogeneous.R 3 | \docType{class} 4 | \name{tskrrHomogeneous-class} 5 | \alias{tskrrHomogeneous-class} 6 | \alias{tskrrHomogeneous} 7 | \title{Class tskrrHomogeneous} 8 | \description{ 9 | The class tskrrHomogeneous is a subclass of the superclass 10 | \code{\link[xnet:tskrr-class]{tskrr}} specifically for 11 | homogeneous networks. 12 | } 13 | \section{Slots}{ 14 | 15 | \describe{ 16 | \item{\code{y}}{the matrix with responses} 17 | 18 | \item{\code{k}}{the eigen decomposition of the kernel matrix for the rows} 19 | 20 | \item{\code{lambda.k}}{the lambda value used for k} 21 | 22 | \item{\code{pred}}{the matrix with the predictions} 23 | 24 | \item{\code{symmetry}}{a character value that can have the possible values 25 | \code{"symmetric"}, \code{"skewed"} or \code{"not"}. It indicates 26 | whether the \code{y} matrix is symmetric, skewed-symmetric or not 27 | symmetric.} 28 | 29 | \item{\code{has.hat}}{a logical value indicating whether the kernel hat matrices 30 | are stored in the object.} 31 | 32 | \item{\code{Hk}}{the kernel hat matrix for the rows.} 33 | 34 | \item{\code{labels}}{a list with elements \code{k} and \code{g} (see 35 | \code{\link{tskrr-class}}). For homogeneous networks, \code{g} 36 | is always \code{NA}. If \code{k} is \code{NA}, the labels used 37 | are integers indicating the row resp column number.} 38 | }} 39 | 40 | -------------------------------------------------------------------------------- /R/getlooInternal.R: -------------------------------------------------------------------------------- 1 | # Internal functions for get_loo_fun 2 | 3 | .getloo_heterogeneous <- function(exclusion, replaceby0){ 4 | if(exclusion == "interaction"){ 5 | if(replaceby0) loo.i0 else loo.i 6 | } else if(exclusion == "row"){ 7 | loo.r 8 | } else if(exclusion == "column"){ 9 | loo.c 10 | } else if(exclusion == "both"){ 11 | loo.b 12 | } else { 13 | stop("Exclusion should be one of interaction, row, column or both.") 14 | } 15 | } 16 | 17 | .getloo_homogeneous <- function(exclusion, replaceby0, symmetry){ 18 | # Translate edges and vertices 19 | if(exclusion %in% c("interaction","both")) 20 | exclusion <- switch(exclusion, 21 | interaction = "edges", 22 | both = "vertices") 23 | 24 | if(exclusion == "edges"){ 25 | if(symmetry == "symmetric"){ 26 | if(replaceby0) loo.e0.sym else loo.e.sym 27 | } else if(symmetry == "skewed"){ 28 | if(replaceby0) loo.e0.skew else loo.e.skew 29 | } else { 30 | stop("No loo optimization for homogeneous networks that aren't symmetric or skewed.") 31 | } 32 | } else if(exclusion == c("vertices")) { # exclusion is not interaction 33 | loo.v 34 | } else { 35 | stop("Exclusion should be one of edges or vertices") 36 | } 37 | } 38 | 39 | # dots catch other arguments to avoid errors when exclusion is passed 40 | .getloo_linearfilter <- function(replaceby0, ...){ 41 | if(replaceby0) loo.i0.lf else loo.i.lf 42 | } 43 | -------------------------------------------------------------------------------- /R/data_drugtarget.R: -------------------------------------------------------------------------------- 1 | #' drug target interactions for neural receptors 2 | #' 3 | #' A dataset for examining the interaction between 54 drugs and 26 4 | #' neural receptors. It consists of three different matrices. 5 | #' 6 | #' The dataset consists of the following objects : 7 | #' 8 | #' \itemize{ 9 | #' \item drugTargetInteraction: a matrix indicating whether or not a 10 | #' certain drug compound interacts with a certain neural receptor. 11 | #' \item targetSim: a similarity matrix for the neural receptors. 12 | #' \item drugSim: a similarity matrix for the drugs 13 | #' } 14 | #' 15 | #' The data originates from Yamanishi et al (2008) but was partly reworked 16 | #' to be suitable for two-step kernel ridge regression. This is explained 17 | #' in detail in the \href{../doc/Preparation_example_data.html}{Preparation of 18 | #' the example data} vignette. 19 | #' 20 | #' @format 21 | #' \itemize{ 22 | #' \item for drugTargetInteraction: a numeric matrix of 26 rows by 23 | #' 54 columns. 24 | #' \item For drugSim: a numeric square matrix with 54 rows/columns. 25 | #' \item For targetSim: a numeric square matrix with 26 rows/columns. 26 | #' } 27 | #' 28 | #' @references \href{https://doi.org/10.1093/bioinformatics/btn162}{Yamanishi et al, 2008} : Prediction of drug-target interaction networks from the 29 | #' integration of chemical and genomic spaces. 30 | #' 31 | #' @source \url{https://doi.org/10.1093/bioinformatics/btn162} 32 | #' @aliases drugtarget drugSim targetSim 33 | "drugTargetInteraction" 34 | -------------------------------------------------------------------------------- /man/proteinInteraction.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data_proteinInteraction.R 3 | \docType{data} 4 | \name{proteinInteraction} 5 | \alias{proteinInteraction} 6 | \alias{Kmat_y2h_sc} 7 | \title{Protein interaction for yeast} 8 | \format{\itemize{ 9 | \item proteinInteraction: a numeric square matrix with 150 rows/columns 10 | \item Kmat_y2h_sc: a numeric square matrix with 150 rows/columns 11 | }} 12 | \source{ 13 | \url{https://doi.org/10.1093/bioinformatics/bth910} 14 | } 15 | \usage{ 16 | proteinInteraction 17 | } 18 | \description{ 19 | A dataset for examining the interaction between proteins of 20 | yeast. The dataset consists of the following objects: 21 | } 22 | \details{ 23 | \itemize{ 24 | \item proteinInteraction: the label matrix based on the protein 25 | network taken from the KEGG/PATHWAY database 26 | \item Kmat_y2h_sc: a kernel matrix indicating similarity of proteins. 27 | } 28 | 29 | The proteins in the dataset are a subset of the 769 proteins 30 | used in Yamanishi et al (2004). The kernel matrix used is the 31 | combination of 4 kernels: one based on expression data, one 32 | on protein interaction data, one on localization data and one 33 | on phylogenetic profile. These kernels and their combination are 34 | also explained in Yamanishi et al (2004). 35 | } 36 | \references{ 37 | \href{https://doi.org/10.1093/bioinformatics/bth910}{Yamanishi et al, 2004}: Protein network inference from multiple genomic data: a supervised approach. 38 | } 39 | \keyword{datasets} 40 | -------------------------------------------------------------------------------- /R/getters_permtest.R: -------------------------------------------------------------------------------- 1 | #' Getters for permtest objects 2 | #' 3 | #' The functions described here are convenience functions to get 4 | #' information out of a \code{\link[xnet:permtest-class]{permtest}} 5 | #' object. 6 | #' 7 | #' @param x a \code{\link[xnet:permtest-class]{permtest}} object 8 | #' @param i either a numeric vector, a logical vector or a character 9 | #' vector with the elements that need extraction. 10 | #' 11 | #' @return the requested values 12 | #' 13 | #' @seealso \code{\link{loss}} to extract the original loss value. 14 | #' 15 | #' @examples 16 | #' 17 | #' data(drugtarget) 18 | #' 19 | #' mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 20 | #' ptest <- permtest(mod, fun = loss_auc) 21 | #' 22 | #' loss(ptest) 23 | #' ptest[c(2,3)] 24 | #' permutations(ptest) 25 | #' 26 | #' @rdname getters-permtest 27 | #' @aliases Extract-permtest permutations 28 | #' @export 29 | permutations <- function(x){ 30 | if(!inherits(x, "permtest")) 31 | stop("x has to be of class permtest") 32 | x@perm_losses 33 | } 34 | 35 | #' @rdname getters-permtest 36 | #' @export 37 | setMethod("[", 38 | c("permtest","ANY"), 39 | function(x,i){ 40 | 41 | res <- .make_res_table(x@perm_losses, 42 | x@orig_loss, 43 | x@pval) 44 | tryCatch(res[,i], 45 | error = function(e){ 46 | stop("Could not find requested element(s).", 47 | call. = FALSE) 48 | }) 49 | }) 50 | -------------------------------------------------------------------------------- /R/hat.R: -------------------------------------------------------------------------------- 1 | #' Return the hat matrix of a tskrr model 2 | #' 3 | #' This function returns the hat matrix or hat matrices of 4 | #' a tskrr model. \code{xnet} creates an S4 generic for \code{hat} 5 | #' and links the default method to the \code{\link[=influence.measures]{hat}} function 6 | #' of \code{stats} 7 | #' 8 | #' @param x a tskrr model 9 | #' @param which a character value with possible values "row" or 10 | #' "column" to indicate which should be returned. For homogeneous 11 | #' models, this parameter is ignored. 12 | #' @param ... arguments passed to other methods. 13 | #' 14 | #' @return the requested hat matrix of the model. 15 | #' @rdname hat 16 | #' @export 17 | setMethod("hat", 18 | "tskrrHeterogeneous", 19 | function(x, which = c('row','column')){ 20 | 21 | which <- match.arg(which) 22 | 23 | if(has_hat(x)){ 24 | if(which == "row") 25 | return(x@Hk) 26 | else 27 | return(x@Hg) 28 | } 29 | 30 | 31 | eig <- if(which == 'row') x@k else x@g 32 | l <- if(which == 'row') x@lambda.k else x@lambda.g 33 | 34 | eigen2hat(eig$vectors, eig$values, l) 35 | }) 36 | 37 | #' @rdname hat 38 | #' @export 39 | setMethod("hat", 40 | "tskrrHomogeneous", 41 | function(x, ...){ 42 | 43 | if(has_hat(x)){ 44 | return(x@Hk) 45 | } 46 | 47 | eig <- x@k 48 | l <- x@lambda.k 49 | 50 | eigen2hat(eig$vectors, eig$values, l) 51 | }) 52 | -------------------------------------------------------------------------------- /man/eigen2hat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/eigen2hat.R 3 | \name{eigen2hat} 4 | \alias{eigen2hat} 5 | \alias{eigen2map} 6 | \alias{eigen2matrix} 7 | \title{Calculate the hat matrix from an eigen decomposition} 8 | \usage{ 9 | eigen2hat(eigen, val, lambda) 10 | 11 | eigen2map(eigen, val, lambda) 12 | 13 | eigen2matrix(eigen, val) 14 | } 15 | \arguments{ 16 | \item{eigen}{a matrix with the eigenvectors.} 17 | 18 | \item{val}{an numeric vector with the eigenvalues.} 19 | 20 | \item{lambda}{a single numeric value for the hyperparameter lambda} 21 | } 22 | \value{ 23 | a numeric matrix representing either the hat matrix 24 | (\code{eigen2hat}), the map matrix (\code{eigen2map}) or 25 | the original matrix (\code{eigen2matrix}) 26 | } 27 | \description{ 28 | These functions calculate either the hat matrix, the mapping matrix or 29 | the original (kernel) matrix for a two-step kernel ridge regression, 30 | based on the eigendecomposition of the kernel matrix. 31 | } 32 | \details{ 33 | For the hat matrix, this boils down to: 34 | 35 | \deqn{U\Sigma(\Sigma + \lambda I)^{-1} U^{T}} 36 | 37 | For the map matrix, this is : 38 | 39 | \deqn{U(\Sigma + \lambda I)^{-1} U^{T}} 40 | 41 | with \eqn{U} the matrix with eigenvectors, \eqn{\Sigma} a diagonal matrix 42 | with the eigenvalues on the diagonal, \eqn{I} the identity matrix and 43 | \eqn{\lambda} the hyperparameter linked to this kernel. 44 | The internal calculation is optimized to avoid having to invert 45 | a matrix. This is done using the fact that \eqn{\Sigma} is a 46 | diagonal matrix. 47 | } 48 | -------------------------------------------------------------------------------- /R/create_grid.R: -------------------------------------------------------------------------------- 1 | #' Create a grid of values for tuning tskrr 2 | #' 3 | #' This function creates a grid of values for 4 | #' tuning a \code{\link{tskrr}} model. The grid is equally spaced on 5 | #' a logarithmic scale. Normally it's not needed to call this method 6 | #' directly, it's usually called from \code{\link{tune}}. 7 | #' 8 | #' The \code{lim} argument sets the boundaries of the domain in which 9 | #' the lambdas are sought. The lambda values at which the function is 10 | #' evaluated, are calculated as: 11 | #' 12 | #' \code{exp(seq(log(1e-4), log(1e4), length.out = ngrid))} 13 | 14 | #' 15 | #' @param lim a numeric vector with 2 values giving the lower and upper limit 16 | #' for the grid. 17 | #' @param ngrid the number of values that have to be produced. If this 18 | #' number is not integer, it is truncated. The value should be 2 or 19 | #' larger. 20 | #' 21 | #' @return a numeric vector with values evenly spaced on a 22 | #' logarithmic scale. 23 | #' 24 | #' @seealso \code{\link{tune}} for tuning a tskrr model. 25 | #' 26 | #' @examples 27 | #' create_grid(lim = c(1e-4, 1), ngrid = 5) 28 | #' 29 | #' @export 30 | create_grid <- function(lim = c(1e-4, 1e4), 31 | ngrid = 10){ 32 | 33 | if(!length(lim) == 2 || !is.numeric(lim)) 34 | stop("The argument lim needs 2 numeric values.") 35 | if(!length(ngrid) == 1 || !is.numeric(ngrid)) 36 | stop("The argument ngrid should be a single numeric value.") 37 | 38 | #Optimized for speed 39 | llim <- log(lim) 40 | by <- (llim[2] - llim[1])/(ngrid - 1L) 41 | exp(c(llim[1], llim[1] + seq_len(ngrid - 2L) * by, llim[2])) 42 | } 43 | -------------------------------------------------------------------------------- /R/fitted.R: -------------------------------------------------------------------------------- 1 | #' extract the predictions 2 | #' 3 | #' This functions extracts the fitted predictions from a 4 | #' \code{\link[xnet:tskrr-class]{tskrr}} object or an object 5 | #' inheriting from that class. The \code{xnet} 6 | #' package provides an S4 generic for the function 7 | #' \code{\link[=fitted]{fitted}} from the package \code{stats}, 8 | #' and a method for \code{\link[xnet:tskrr-class]{tskrr}} objects. 9 | #' 10 | #' @param object an object for which the extraction of model fitted values 11 | #' is meaningful. 12 | #' @param ... arguments passed to or from other methods. 13 | #' @param labels a logical value indicating whether the labels should 14 | #' be shown. Defaults to TRUE 15 | #' 16 | #' @return a numeric matrix with the predictions 17 | #' 18 | #' @examples 19 | #' 20 | #' data(drugtarget) 21 | #' 22 | #' mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 23 | #' pred <- fitted(mod) 24 | #' 25 | #' @include all_generics.R 26 | #' 27 | #' 28 | #' @rdname fitted 29 | #' @method fitted tskrr 30 | #' @export 31 | fitted.tskrr <- function(object, labels = TRUE, ...){ 32 | out <- object@pred 33 | if(labels){ 34 | l <- labels(object) 35 | rownames(out) <- l$k 36 | colnames(out) <- l$g 37 | } 38 | out 39 | } 40 | 41 | #' @rdname fitted 42 | #' @method fitted linearFilter 43 | #' @export 44 | fitted.linearFilter <- function(object, ...){ 45 | object@pred 46 | } 47 | 48 | 49 | #' @rdname fitted 50 | #' @export 51 | setMethod("fitted", 52 | "tskrr", 53 | fitted.tskrr) 54 | 55 | #' @rdname fitted 56 | #' @export 57 | setMethod("fitted", 58 | "linearFilter", 59 | fitted.linearFilter) 60 | -------------------------------------------------------------------------------- /man/permtest-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Class_permtest.R 3 | \docType{class} 4 | \name{permtest-class} 5 | \alias{permtest-class} 6 | \title{Class permtest} 7 | \description{ 8 | This class represents the permutation test outcomes. See also 9 | the function \code{\link{permtest}}. 10 | } 11 | \section{Slots}{ 12 | 13 | \describe{ 14 | \item{\code{orig_loss}}{a numeric value with the original loss of 15 | the model.} 16 | 17 | \item{\code{perm_losses}}{a numeric vector with the losses of the 18 | different permutations.} 19 | 20 | \item{\code{n}}{the number of permutations} 21 | 22 | \item{\code{loss_function}}{the function used to calculate the losses.} 23 | 24 | \item{\code{exclusion}}{a character value indicating the exclusion 25 | setting used for the test} 26 | 27 | \item{\code{replaceby0}}{a locigal value that indicates whether the 28 | exclusion was done by replacing with zero. See also 29 | \code{\link{loo}}.} 30 | 31 | \item{\code{permutation}}{a character value that indicats in which 32 | kernel matrices were permuted.} 33 | 34 | \item{\code{pval}}{a p value indicating how likely it is to find a 35 | smaller loss than the one of the model based on a normal 36 | approximation.} 37 | 38 | \item{\code{exact}}{a logical value indicating whether the P value was 39 | calculated exactly or approximated by the normal distribution.} 40 | }} 41 | 42 | \seealso{ 43 | \itemize{ 44 | \item the function \code{\link{permtest}} for the actual test. 45 | \item the function \code{\link{loo}} for the leave one out 46 | procedures 47 | \item the function \code{\link{t.test}} for the actual test 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /R/Class_tskrrTuneHomogeneous.R: -------------------------------------------------------------------------------- 1 | #' Class tskrrTuneHomogeneous 2 | #' 3 | #' The class tskrrTuneHomogeneous represents a tuned homogeneous 4 | #' \code{\link[xnet:tskrr-class]{tskrr}} model. It inherits from 5 | #' the classes \code{\link[xnet:tskrrHomogeneous-class]{tskrrHomogeneous}} 6 | #' and \code{\link[xnet:tskrrTune-class]{tskrrTune}}. 7 | #' 8 | #' @rdname tskrrTuneHomogeneous-class 9 | #' @name tskrrTuneHomogeneous-class 10 | #' @aliases tskrrTuneHomogeneous 11 | #' @exportClass tskrrTuneHomogeneous 12 | setClass("tskrrTuneHomogeneous", 13 | contains = c("tskrrTune", "tskrrHomogeneous")) 14 | 15 | validTskrrTuneHomogeneous <- function(object){ 16 | 17 | lossval <- object@loss_values 18 | lgrid <- object@lambda_grid 19 | excl <- object@exclusion 20 | 21 | if(names(lgrid) != "k") 22 | return("lambda_grid should be a list with one element named k for homogeneous networks.") 23 | 24 | if(ncol(lossval) != 1 || 25 | nrow(lossval) != length(lgrid$k)) 26 | return(paste("Loss values should have 1 row and",length(lgrid$k),"columns to match the lambda grid.")) 27 | 28 | exclmatch <- match(excl, c("edges","vertices"), 29 | nomatch = 0L) 30 | if(exclmatch == 0) 31 | return("exclusion should be either 'interaction' or 'both' for homogeneous networks.") 32 | 33 | else if(!object@onedim) 34 | return("grid search can only be done in one dimension for a homogeneous network.") 35 | 36 | if(object@replaceby0 && excl != "edges") 37 | return("replaceby0 can only be used with edges exclusion") 38 | else 39 | return(TRUE) 40 | 41 | 42 | } 43 | 44 | setValidity("tskrrTuneHomogeneous", validTskrrTuneHomogeneous) 45 | -------------------------------------------------------------------------------- /man/getters-tskrrImpute.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getters_tskrrImpute.R 3 | \name{has_imputed_values} 4 | \alias{has_imputed_values} 5 | \alias{which_imputed} 6 | \alias{is_imputed} 7 | \title{Getters for tskrrImpute objects} 8 | \usage{ 9 | has_imputed_values(x) 10 | 11 | which_imputed(x) 12 | 13 | is_imputed(x) 14 | } 15 | \arguments{ 16 | \item{x}{a \code{\link[xnet:tskrrImpute-class]{tskrrImpute}} object or 17 | an object inheriting from \code{tskrrImpute}.} 18 | } 19 | \value{ 20 | For \code{has_imputed_values}: a logical value indicating whether 21 | the model has imputed values. If \code{x} is not some form of a 22 | \code{\link{tskrr}} model, the function will return an error. 23 | 24 | For \code{which_imputed}: a integer vector with the positions 25 | for which the values are imputed. 26 | 27 | for \code{is_imputed}: a matrix of the same dimensions as the 28 | label matrix. It contains the value \code{FALSE} at positions that 29 | were not imputed, and \code{TRUE} at positions that were. 30 | } 31 | \description{ 32 | The functions described here are convenience functions to get 33 | information out of a \code{\link[xnet:tskrrImpute-class]{tskrrImpute}} 34 | object. 35 | } 36 | \examples{ 37 | 38 | data(drugtarget) 39 | 40 | mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 41 | 42 | naid <- sample(length(drugTargetInteraction), 30) 43 | drugTargetInteraction[naid] <- NA 44 | 45 | impmod <- impute_tskrr(drugTargetInteraction, targetSim, drugSim) 46 | 47 | has_imputed_values(mod) 48 | has_imputed_values(impmod) 49 | 50 | # For illustration: extract imputed values 51 | id <- is_imputed(impmod) 52 | fitted(impmod)[id] 53 | 54 | } 55 | -------------------------------------------------------------------------------- /R/residuals.R: -------------------------------------------------------------------------------- 1 | #' calculate residuals from a tskrr model 2 | #' 3 | #' This function returns the residuals for 4 | #' an object inheriting from class \code{\link[xnet:tskrr-class]{tskrr}} 5 | #' 6 | #' @param object a tskrr model 7 | #' @param method a character value indicating whether the 8 | #' residuals should be based on the predictions or on a 9 | #' leave-one-out crossvalidation. 10 | #' @inheritParams loo 11 | #' @param ... arguments passed from/to other methods. 12 | #' 13 | #' @inherit loo details 14 | #' 15 | #' @return a matrix(!) with the requested residuals 16 | #' 17 | #' @examples 18 | #' 19 | #' data(drugtarget) 20 | #' mod <- tskrr(drugTargetInteraction, targetSim, drugSim, 21 | #' lambda = c(0.01,0.01)) 22 | #' delta <- response(mod) - loo(mod, exclusion = "both") 23 | #' resid <- residuals(mod, method = "loo", exclusion = "both") 24 | #' all.equal(delta, resid) 25 | #' 26 | #' @rdname residuals.tskrr 27 | #' @method residuals tskrr 28 | #' @export 29 | residuals.tskrr <- function(object, 30 | method = c("predictions","loo"), 31 | exclusion = c("interaction","row", 32 | "column", "both"), 33 | replaceby0 = FALSE, 34 | ...){ 35 | 36 | method <- match.arg(method) 37 | exclusion <- match.arg(exclusion) 38 | 39 | obs <- response(object) 40 | preds <- if(method == "predictions"){ 41 | fitted(object) 42 | } else { 43 | loo(object, exclusion, replaceby0) 44 | } 45 | obs - preds 46 | } 47 | 48 | #' @rdname residuals.tskrr 49 | #' @export 50 | setMethod("residuals", 51 | "tskrr", 52 | residuals.tskrr) 53 | -------------------------------------------------------------------------------- /man/getters_linearFilter.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/all_generics.R, R/getters_linearFilter.R 3 | \name{alpha} 4 | \alias{alpha} 5 | \alias{na_removed} 6 | \alias{getters_linearFilter} 7 | \alias{mean.linearFilter} 8 | \alias{mean,linearFilter-method} 9 | \alias{colMeans,linearFilter-method} 10 | \alias{rowMeans,linearFilter-method} 11 | \alias{alpha,linearFilter-method} 12 | \alias{na_removed,linearFilter-method} 13 | \title{Getters for linearFilter objects} 14 | \usage{ 15 | alpha(x) 16 | 17 | na_removed(x) 18 | 19 | \method{mean}{linearFilter}(x, ...) 20 | 21 | \S4method{mean}{linearFilter}(x, ...) 22 | 23 | \S4method{colMeans}{linearFilter}(x) 24 | 25 | \S4method{rowMeans}{linearFilter}(x) 26 | 27 | \S4method{alpha}{linearFilter}(x) 28 | 29 | \S4method{na_removed}{linearFilter}(x) 30 | } 31 | \arguments{ 32 | \item{x}{a \code{linearFilter} object} 33 | 34 | \item{...}{arguments passed to or from other methods.} 35 | } 36 | \value{ 37 | for \code{mean}: the mean of the original matrix 38 | 39 | for \code{colMeans}: a numeric vector with the column means 40 | 41 | for \code{rowMeans}: a numeric vector with the row means 42 | 43 | for \code{alpha}: a numeric vector of length 4 with the alpha 44 | values. 45 | 46 | for \code{na_removed}: a logical value indicating whether 47 | missing values were removed prior to the fitting of the filter. 48 | } 49 | \description{ 50 | These functions allow you to extract slots from objects of the 51 | class \code{\link{linearFilter}}. 52 | } 53 | \examples{ 54 | data(drugtarget) 55 | lf <- linear_filter(drugTargetInteraction, alpha = 0.25) 56 | alpha(lf) 57 | mean(lf) 58 | colMeans(lf) 59 | na_removed(lf) 60 | 61 | } 62 | -------------------------------------------------------------------------------- /man/loss_functions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/loss_functions.R 3 | \name{loss_functions} 4 | \alias{loss_functions} 5 | \alias{loss_mse} 6 | \alias{loss_auc} 7 | \title{loss functions} 8 | \usage{ 9 | loss_mse(Y, LOO, na.rm = FALSE) 10 | 11 | loss_auc(Y, LOO) 12 | } 13 | \arguments{ 14 | \item{Y}{the label matrix with observed responses} 15 | 16 | \item{LOO}{the leave-one-out crossvalidation (or predictions if you 17 | must). This one can be calculated by the function \code{loo}.} 18 | 19 | \item{na.rm}{a logical value} 20 | } 21 | \description{ 22 | These functions can be used as loss functions in \code{\link{tune}}. 23 | Currently, two functions are provided: a function calculating the 24 | classic mean squared error (\code{loss_mse}) and a function 25 | calculating 1 - AUC (\code{loss_auc}). 26 | } 27 | \details{ 28 | The AUC is calculated by sorting the \code{Y} matrix based on 29 | the order of the values in the \code{LOO} matrix. The false and true 30 | positive rates are calculated solely based on that ordering, which 31 | allows for values in \code{LOO} outside the range [0,1]. It's 32 | a naive implementation which is good enough for tuning, but 33 | shouldn't be used as a correct value for 1 - auc in case the 34 | values in \code{LOO} are outside the range [0,1]. 35 | } 36 | \section{Note}{ 37 | 38 | The function \code{loss_auc} should only be used for a \code{Y} 39 | matrix that contains solely the values 0 and 1. 40 | } 41 | 42 | \examples{ 43 | 44 | x <- c(1,0,0,1,0,0,1,0,1) 45 | y <- c(0.8,-0.1,0.2,0.2,0.4,0.01,1.12,0.9,0.9) 46 | loss_mse(x,y) 47 | loss_auc(x,y) 48 | 49 | } 50 | \seealso{ 51 | \code{\link{tune}} for application of the loss function 52 | } 53 | -------------------------------------------------------------------------------- /man/drugTargetInteraction.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data_drugtarget.R 3 | \docType{data} 4 | \name{drugTargetInteraction} 5 | \alias{drugTargetInteraction} 6 | \alias{drugtarget} 7 | \alias{drugSim} 8 | \alias{targetSim} 9 | \title{drug target interactions for neural receptors} 10 | \format{\itemize{ 11 | \item for drugTargetInteraction: a numeric matrix of 26 rows by 12 | 54 columns. 13 | \item For drugSim: a numeric square matrix with 54 rows/columns. 14 | \item For targetSim: a numeric square matrix with 26 rows/columns. 15 | }} 16 | \source{ 17 | \url{https://doi.org/10.1093/bioinformatics/btn162} 18 | } 19 | \usage{ 20 | drugTargetInteraction 21 | } 22 | \description{ 23 | A dataset for examining the interaction between 54 drugs and 26 24 | neural receptors. It consists of three different matrices. 25 | } 26 | \details{ 27 | The dataset consists of the following objects : 28 | 29 | \itemize{ 30 | \item drugTargetInteraction: a matrix indicating whether or not a 31 | certain drug compound interacts with a certain neural receptor. 32 | \item targetSim: a similarity matrix for the neural receptors. 33 | \item drugSim: a similarity matrix for the drugs 34 | } 35 | 36 | The data originates from Yamanishi et al (2008) but was partly reworked 37 | to be suitable for two-step kernel ridge regression. This is explained 38 | in detail in the \href{../doc/Preparation_example_data.html}{Preparation of 39 | the example data} vignette. 40 | } 41 | \references{ 42 | \href{https://doi.org/10.1093/bioinformatics/btn162}{Yamanishi et al, 2008} : Prediction of drug-target interaction networks from the 43 | integration of chemical and genomic spaces. 44 | } 45 | \keyword{datasets} 46 | -------------------------------------------------------------------------------- /R/Class_tskrrImputeHeterogeneous.R: -------------------------------------------------------------------------------- 1 | #' Class tskrrImputeHeterogeneous 2 | #' 3 | #' The class \code{tskrrImputeHeterogeneous} is a subclass of the 4 | #' class \code{\link[xnet:tskrrHeterogeneous-class]{tskrrHeterogeneous}} and 5 | #' \code{\link[xnet:tskrrImpute-class]{tskrrImpute}} 6 | #' specifically for heterogeneous networks with imputed values. It is 7 | #' the result of the function \code{\link{impute_tskrr}}. 8 | #' 9 | #' @slot y the matrix with responses 10 | #' @slot k the eigen decomposition of the kernel matrix for the rows 11 | #' @slot lambda.k the lambda value used for k 12 | #' @slot pred the matrix with the predictions 13 | #' @slot g the eigen decomposition of the kernel matrix for the columns 14 | #' @slot lambda.g the lambda value used for g 15 | #' @slot has.hat a logical value indicating whether the kernel hat matrices 16 | #' are stored in the object. 17 | #' @slot Hk the kernel hat matrix for the rows. 18 | #' @slot Hg the kernel hat matrix for the columns. 19 | #' @slot labels a list with elements \code{k} and \code{g} (see 20 | #' \code{\link{tskrr-class}}). 21 | #' If any element is \code{NA}, the labels used 22 | #' are integers indicating the row resp column number. 23 | #' @slot imputeid a vector with integer values indicating which of 24 | #' the values in \code{y} are imputed 25 | #' @slot niter an integer value gving the number of iterations used 26 | #' @slot tol a numeric value with the tolerance used 27 | #' 28 | #' @include Class_tskrrHeterogeneous.R Class_tskrrImpute.R 29 | #' @rdname tskrrImputeHeterogeneous-class 30 | #' @aliases tskrrImputeHeterogeneous 31 | #' @exportClass tskrrImputeHeterogeneous 32 | setClass("tskrrImputeHeterogeneous", 33 | contains = c("tskrrImpute", "tskrrHeterogeneous") 34 | ) 35 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # xnet R package 2 | 3 | [![CRAN status](https://www.r-pkg.org/badges/version-last-release/xnet)](https://cran.r-project.org/package=xnet) 4 | [![CRAN downloads](https://cranlogs.r-pkg.org/badges/grand-total/xnet)](https://cran.r-project.org/package=xnet) 5 | 6 | [![R-CMD-check](https://github.com/CenterForStatistics-UGent/xnet/workflows/R-CMD-check/badge.svg)](https://github.com/CenterForStatistics-UGent/xnet/actions) 7 | 8 | | Main | Devel | 9 | | :----: | :---: | 10 | | [![Travis build status](https://travis-ci.com/CenterForStatistics-UGent/xnet.svg?branch=main)](https://travis-ci.com/CenterForStatistics-UGent/xnet) | [![Travis devel-build status](https://travis-ci.com/CenterForStatistics-UGent/xnet.svg?branch=devel)](https://travis-ci.com/CenterForStatistics-UGent/xnet) | 11 | | [![Coverage status](https://codecov.io/gh/CenterForStatistics-UGent/xnet/branch/main/graph/badge.svg)](https://codecov.io/github/CenterForStatistics-UGent/xnet?branch=main) | [![Coverage status](https://codecov.io/gh/CenterForStatistics-UGent/xnet/branch/devel/graph/badge.svg)](https://codecov.io/github/CenterForStatistics-UGent/xnet/branch/devel) | 12 | 13 | 14 | 15 | This is the github repo for the xnet package in R. The package implements 16 | two-step kernel ridge regression, and a set of crossvalidation methods 17 | described by Michiel Stock et al. ( https://doi.org/10.1093/bib/bby095 ) 18 | 19 | Please note this is work in progress. All suggestions/issues/feature requests are welcomed. 20 | 21 | ## Installation 22 | 23 | The package can be installed in R using the following code: 24 | 25 | remotes::install_github("CenterForStatistics-UGent/xnet") 26 | 27 | To install the dev version, use: 28 | 29 | remotes::install_github("CenterForStatistics-UGent/xnet", ref = "devel") 30 | -------------------------------------------------------------------------------- /R/getters_linearFilter.R: -------------------------------------------------------------------------------- 1 | #' Getters for linearFilter objects 2 | #' 3 | #' These functions allow you to extract slots from objects of the 4 | #' class \code{\link{linearFilter}}. 5 | #' 6 | #' @param x a \code{linearFilter} object 7 | #' @param ... arguments passed to or from other methods. 8 | #' 9 | #' @return for \code{mean}: the mean of the original matrix 10 | #' 11 | #' @examples 12 | #' data(drugtarget) 13 | #' lf <- linear_filter(drugTargetInteraction, alpha = 0.25) 14 | #' alpha(lf) 15 | #' mean(lf) 16 | #' colMeans(lf) 17 | #' na_removed(lf) 18 | #' 19 | #' @rdname getters_linearFilter 20 | #' @name getters_linearFilter 21 | #' 22 | #' @method mean linearFilter 23 | #' @export 24 | mean.linearFilter <- function(x,...){ 25 | x@mean 26 | } 27 | 28 | #' @rdname getters_linearFilter 29 | #' @export 30 | setMethod("mean", "linearFilter", mean.linearFilter) 31 | 32 | #' @rdname getters_linearFilter 33 | #' @return for \code{colMeans}: a numeric vector with the column means 34 | #' @export 35 | setMethod("colMeans", "linearFilter", 36 | function(x) x@colmeans) 37 | 38 | #' @rdname getters_linearFilter 39 | #' @return for \code{rowMeans}: a numeric vector with the row means 40 | #' @export 41 | setMethod("rowMeans", "linearFilter", 42 | function(x) x@rowmeans) 43 | 44 | #' @rdname getters_linearFilter 45 | #' @return for \code{alpha}: a numeric vector of length 4 with the alpha 46 | #' values. 47 | #' @export 48 | setMethod("alpha", "linearFilter", 49 | function(x) x@alpha) 50 | 51 | #' @rdname getters_linearFilter 52 | #' @return for \code{na_removed}: a logical value indicating whether 53 | #' missing values were removed prior to the fitting of the filter. 54 | #' @export 55 | setMethod("na_removed", "linearFilter", 56 | function(x) x@na.rm) 57 | -------------------------------------------------------------------------------- /man/valid_labels.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/valid_labels.R 3 | \name{valid_labels} 4 | \alias{valid_labels} 5 | \title{Test the correctness of the labels.} 6 | \usage{ 7 | valid_labels(y, k, g = NULL) 8 | } 9 | \arguments{ 10 | \item{y}{the label matrix} 11 | 12 | \item{k}{the kernel matrix for the rows} 13 | 14 | \item{g}{the kernel matrix for the columns (optional). If not available, 15 | it takes the value \code{NULL}} 16 | } 17 | \value{ 18 | \code{TRUE} if all labels are compatible, an error otherwise. 19 | } 20 | \description{ 21 | This function checks whether the labels between the Y, K, and G 22 | matrices make sense. This means that all the labels found as 23 | rownames for \code{y} can be found as rownames \emph{and} column 24 | names of \code{k}, and all the colnames for \code{y} can be found 25 | as rownames \emph{and} colnames of \code{g} (if provided). 26 | } 27 | \details{ 28 | Compatible labels mean that it is unequivocally clear which 29 | rows and columns can be linked throughout the model. In case none 30 | of the matrices have row- or colnames, the labels are considered 31 | compatible. In all other cases, all matrices should have both row 32 | and column names. They should fulfill the following conditions: 33 | 34 | \itemize{ 35 | \item the row- and column names of a kernel matrix must contain 36 | the same values in the same order. Otherwise, the matrix can't 37 | be symmetric. 38 | \item the rownames of \code{y} should correspond to the rownames 39 | of \code{k} 40 | \item the colnames of \code{y} should correspond to the colnames 41 | of \code{g} if it is supplied, or the colnames of \code{k} in 42 | case \code{g} is \code{NULL} 43 | } 44 | } 45 | \note{ 46 | This is a non-exported convenience function. 47 | } 48 | -------------------------------------------------------------------------------- /man/tskrrTune-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Class_tskrrTune.R 3 | \docType{class} 4 | \name{tskrrTune-class} 5 | \alias{tskrrTune-class} 6 | \alias{tskrrTune} 7 | \title{Class tskrrTune} 8 | \description{ 9 | The class tskrrTune represents a tuned \code{\link[xnet:tskrr-class]{tskrr}} 10 | model, and is the output of the function \code{\link{tune}}. Apart from 11 | the model, it contains extra information on the tuning procedure. This is 12 | a virtual class only. 13 | } 14 | \section{Slots}{ 15 | 16 | \describe{ 17 | \item{\code{lambda_grid}}{a list object with the elements \code{k} and possibly 18 | \code{g} indicating the tested lambda values for the row kernel \code{K} 19 | and - if applicable - the column kernel \code{G}. Both elements have 20 | to be numeric.} 21 | 22 | \item{\code{best_loss}}{a numeric value with the loss associated with the 23 | best lambdas} 24 | 25 | \item{\code{loss_values}}{a matrix with the loss results from the searched grid. 26 | The rows form the X dimension (related to the first lambda), the columns 27 | form the Y dimension (related to the second lambda if applicable)} 28 | 29 | \item{\code{loss_function}}{the used loss function} 30 | 31 | \item{\code{exclusion}}{a character value describing the exclusion used} 32 | 33 | \item{\code{replaceby0}}{a logical value indicating whether or not the cross 34 | validation replaced the excluded values by zero} 35 | 36 | \item{\code{onedim}}{a logical value indicating whether the grid search 37 | was done in one dimension. For homogeneous networks, this is 38 | true by default.} 39 | }} 40 | 41 | \seealso{ 42 | \itemize{ 43 | \item the function \code{tune} for the tuning itself 44 | \item the class \code{\link{tskrrTuneHomogeneous}} and 45 | \code{tskrrTuneHeterogeneous} for the actual classes. 46 | } 47 | } 48 | -------------------------------------------------------------------------------- /R/Class_tskrrImputeHomogeneous.R: -------------------------------------------------------------------------------- 1 | #' Class tskrrImputeHomogeneous 2 | #' 3 | #' The class \code{tskrrImputeHomogeneous} is a subclass of the 4 | #' class \code{\link[xnet:tskrrHomogeneous-class]{tskrrHomogeneous}} and 5 | #' \code{\link[xnet:tskrrImpute-class]{tskrrImpute}} 6 | #' specifically for homogeneous networks with imputed values. It is 7 | #' the result of the function \code{\link{impute_tskrr}} on a 8 | #' homogeneous network model. 9 | #' 10 | #' @slot y the matrix with responses 11 | #' @slot k the eigen decomposition of the kernel matrix for the rows 12 | #' @slot lambda.k the lambda value used for k 13 | #' @slot pred the matrix with the predictions 14 | #' @slot symmetry a character value that can have the possible values 15 | #' \code{"symmetric"}, \code{"skewed"} or \code{"not"}. It indicates 16 | #' whether the \code{y} matrix is symmetric, skewed-symmetric or not 17 | #' symmetric. 18 | #' @slot has.hat a logical value indicating whether the kernel hat matrices 19 | #' are stored in the object. 20 | #' @slot Hk the kernel hat matrix for the rows. 21 | #' @slot labels a list with elements \code{k} and \code{g} (see 22 | #' \code{\link{tskrr-class}}). For homogeneous networks, \code{g} 23 | #' is always \code{NA}. If \code{k} is \code{NA}, the labels used 24 | #' are integers indicating the row resp column number. 25 | #' @slot imputeid a vector with integer values indicating which of 26 | #' the values in \code{y} are imputed 27 | #' @slot niter an integer value gving the number of iterations used 28 | #' @slot tol a numeric value with the tolerance used 29 | #' 30 | #' @include Class_tskrrHomogeneous.R Class_tskrrImpute.R 31 | #' @rdname tskrrImputeHomogeneous-class 32 | #' @aliases tskrrImputeHomogeneous 33 | #' @exportClass tskrrImputeHomogeneous 34 | setClass("tskrrImputeHomogeneous", 35 | contains = c("tskrrImpute", "tskrrHomogeneous") 36 | ) 37 | -------------------------------------------------------------------------------- /man/getters-tskrrTune.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getters_tskrrTune.R 3 | \name{is_tuned} 4 | \alias{is_tuned} 5 | \alias{get_grid} 6 | \alias{get_loss_values} 7 | \alias{has_onedim} 8 | \title{Getters for tskrrTune objects} 9 | \usage{ 10 | is_tuned(x) 11 | 12 | get_grid(x) 13 | 14 | get_loss_values(x) 15 | 16 | has_onedim(x) 17 | } 18 | \arguments{ 19 | \item{x}{a \code{\link[xnet:tskrrTune-class]{tskrrTune}} object or an 20 | object inheriting from \code{tskrrTune}.} 21 | } 22 | \value{ 23 | For \code{is_tuned}: a logical value indicating whether the 24 | model is tuned. 25 | 26 | For \code{get_grid} a list with the elements \code{k} and 27 | possibly \code{g}, each containing the different lambdas tried in 28 | the tuning for the row and column kernel matrices respectively. 29 | 30 | For \code{get_loss_values} a matrix with the calculated 31 | loss values. Note that each row represents the result for one 32 | lambda value related to the row kernel matrix K. For heterogeneous 33 | models, every column represents the result for one lambda related 34 | to the column kernel matrix G. 35 | 36 | for \code{is_onedim} a single logical value telling whether the 37 | grid search in the object was onedimensional. 38 | } 39 | \description{ 40 | The functions described here are convenience functions to get 41 | information out of a \code{\link[xnet:tskrrTune-class]{tskrrTune}} 42 | object. 43 | } 44 | \examples{ 45 | 46 | data(drugtarget) 47 | 48 | mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 49 | tuned <- tune(mod, ngrid = 10) 50 | 51 | is_tuned(mod) 52 | is_tuned(tuned) 53 | 54 | # Basic visualization of the grid. 55 | 56 | gridvals <- get_grid(tuned) 57 | z <- get_loss_values(tuned) 58 | 59 | \dontrun{ 60 | image(gridvals$k,gridvals$g,log(z), log = 'xy', 61 | xlab = "lambda k", ylab = "lambda g") 62 | } 63 | 64 | } 65 | -------------------------------------------------------------------------------- /man/tskrrImputeHeterogeneous-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Class_tskrrImputeHeterogeneous.R 3 | \docType{class} 4 | \name{tskrrImputeHeterogeneous-class} 5 | \alias{tskrrImputeHeterogeneous-class} 6 | \alias{tskrrImputeHeterogeneous} 7 | \title{Class tskrrImputeHeterogeneous} 8 | \description{ 9 | The class \code{tskrrImputeHeterogeneous} is a subclass of the 10 | class \code{\link[xnet:tskrrHeterogeneous-class]{tskrrHeterogeneous}} and 11 | \code{\link[xnet:tskrrImpute-class]{tskrrImpute}} 12 | specifically for heterogeneous networks with imputed values. It is 13 | the result of the function \code{\link{impute_tskrr}}. 14 | } 15 | \section{Slots}{ 16 | 17 | \describe{ 18 | \item{\code{y}}{the matrix with responses} 19 | 20 | \item{\code{k}}{the eigen decomposition of the kernel matrix for the rows} 21 | 22 | \item{\code{lambda.k}}{the lambda value used for k} 23 | 24 | \item{\code{pred}}{the matrix with the predictions} 25 | 26 | \item{\code{g}}{the eigen decomposition of the kernel matrix for the columns} 27 | 28 | \item{\code{lambda.g}}{the lambda value used for g} 29 | 30 | \item{\code{has.hat}}{a logical value indicating whether the kernel hat matrices 31 | are stored in the object.} 32 | 33 | \item{\code{Hk}}{the kernel hat matrix for the rows.} 34 | 35 | \item{\code{Hg}}{the kernel hat matrix for the columns.} 36 | 37 | \item{\code{labels}}{a list with elements \code{k} and \code{g} (see 38 | \code{\link{tskrr-class}}). 39 | If any element is \code{NA}, the labels used 40 | are integers indicating the row resp column number.} 41 | 42 | \item{\code{imputeid}}{a vector with integer values indicating which of 43 | the values in \code{y} are imputed} 44 | 45 | \item{\code{niter}}{an integer value gving the number of iterations used} 46 | 47 | \item{\code{tol}}{a numeric value with the tolerance used} 48 | }} 49 | 50 | -------------------------------------------------------------------------------- /man/looInternal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/looInternal.R 3 | \name{loo_internal} 4 | \alias{loo_internal} 5 | \alias{loo.i} 6 | \alias{loo.i0} 7 | \alias{loo.r} 8 | \alias{loo.c} 9 | \alias{loo.b} 10 | \alias{loo.e.sym} 11 | \alias{loo.e.skew} 12 | \alias{loo.e0.sym} 13 | \alias{loo.e0.skew} 14 | \alias{loo.v} 15 | \alias{loo.i.lf} 16 | \alias{loo.i0.lf} 17 | \title{Leave-one-out cross-validation for two-step kernel ridge regression} 18 | \usage{ 19 | loo.i(Y, Hk, Hg, pred) 20 | 21 | loo.i0(Y, Hk, Hg, pred) 22 | 23 | loo.r(Y, Hk, Hg, ...) 24 | 25 | loo.c(Y, Hk, Hg, ...) 26 | 27 | loo.b(Y, Hk, Hg, ...) 28 | 29 | loo.e.sym(Y, Hk, pred) 30 | 31 | loo.e.skew(Y, Hk, pred) 32 | 33 | loo.e0.sym(Y, Hk, pred) 34 | 35 | loo.e0.skew(Y, Hk, pred) 36 | 37 | loo.v(Y, Hk, ...) 38 | 39 | loo.i.lf(Y, alpha, pred) 40 | 41 | loo.i0.lf(Y, alpha, pred) 42 | } 43 | \arguments{ 44 | \item{Y}{the matrix with responses} 45 | 46 | \item{Hk}{the hat matrix for the first kernel (rows of Y)} 47 | 48 | \item{Hg}{the hat matrix for the second kernel (columns of Y)} 49 | 50 | \item{pred}{the predictions} 51 | 52 | \item{...}{added to allow for specifying pred even when not needed.} 53 | 54 | \item{alpha}{a vector of length 4 with the alpha values from a 55 | \code{\link{linearFilter}} model} 56 | } 57 | \value{ 58 | a matrix with the leave-one-out predictions 59 | } 60 | \description{ 61 | These functions implement different cross-validation scenarios for 62 | two-step kernel ridge regression. It uses the shortcuts for 63 | leave-one-out cross-validation. 64 | } 65 | \details{ 66 | These functions are primarily for internal use and hence not exported. 67 | Be careful when using them, as they do not perform any sanity check 68 | on the input. It is up to the user to make sure the input makes sense. 69 | } 70 | \seealso{ 71 | \code{\link{loo}} for the user-level function. 72 | } 73 | -------------------------------------------------------------------------------- /R/prepare_lambdas.R: -------------------------------------------------------------------------------- 1 | # Function to construct lambdas for the tuning 2 | 3 | # This functions prepare the lambdas for the function tune and 4 | # does some basic checks. Out comes a list with the lambdas 5 | # to be used in the tuning 6 | 7 | # Returns a list with lambdas that fits the tskrrTune slot 8 | 9 | .prepare_lambdas <- function(lim, ngrid, lambda = NULL, homogeneous, 10 | onedim = FALSE){ 11 | 12 | if(homogeneous || onedim){ 13 | # Processing for homogeneous networks 14 | if(is.null(lambda)){ 15 | 16 | lim <- .check_for_one(lim, "lim") 17 | ngrid <- .check_for_one(ngrid, "ngrid") 18 | lambda <- create_grid(lim, ngrid) 19 | 20 | } else { 21 | lambda <- .check_for_one(lambda, "lambda") 22 | } 23 | return(list(k = lambda)) 24 | } else { 25 | # Processing for heterogeneous networks 26 | if(is.null(lambda)){ 27 | lim <- .check_for_two(lim, "lim") 28 | ngrid <- .check_for_two(ngrid, "ngrid") 29 | lambdas <- mapply(create_grid, lim, ngrid, SIMPLIFY = FALSE) 30 | return(lambdas) 31 | } else { 32 | lambdas <- .check_for_two(lambda, "lambda") 33 | } 34 | } 35 | } 36 | 37 | .check_for_one <- function(x, arg = "argument"){ 38 | if(is.atomic(x) && is.numeric(x)){ 39 | return(x) 40 | } else { 41 | if(length(x) == 1 && is.numeric(x[[1]])) 42 | return(x[[1]]) 43 | else 44 | stop(paste(arg, "can have only a single series of numeric values for this model.")) 45 | } 46 | } 47 | 48 | .check_for_two <- function(x, arg = "argument"){ 49 | if(is.atomic(x) && is.numeric(x)){ 50 | return(list(k = x,g = x)) 51 | } else { 52 | if(length(x) == 2 && is.numeric(x[[1]]) && is.numeric(x[[2]]) ){ 53 | names(x) <- c("k","g") 54 | return(x) 55 | } else{ 56 | stop(paste(arg,"should either be a numeric vector or a list with two numeric elements for this model.")) 57 | } 58 | } 59 | } 60 | -------------------------------------------------------------------------------- /R/Class_linearFilter.R: -------------------------------------------------------------------------------- 1 | #' Class linearFilter 2 | #' 3 | #' The class represents the outcome of a linear filter, and is normally 4 | #' generated by the function \code{\link{linear_filter}} 5 | #' 6 | #' @slot y the original label matrix with responses. 7 | #' @slot alpha a numeric vector with the 4 alpha values of the model. 8 | #' @slot pred a matrix with the predictions 9 | #' @slot mean a numeric vector containing the global mean of \code{y} 10 | #' @slot colmeans a numeric vector containing the column means of \code{y} 11 | #' @slot rowmeans a numeric vector containing the row means of \code{y}. 12 | #' @slot na.rm a logical value indicating whether missing values were 13 | #' removed prior to the calculation of the means. 14 | #' @seealso \code{\link{linear_filter}} for creating a linear filter model, 15 | #' and \code{\link[=getters_linearFilter]{getter fuctions for linearFilter}}. 16 | #' 17 | #' @aliases linearFilter 18 | setClass("linearFilter", 19 | slots = c( 20 | y = "matrix", 21 | alpha = "numeric", 22 | pred = "matrix", 23 | mean = "numeric", 24 | colmeans = "numeric", 25 | rowmeans = "numeric", 26 | na.rm = "logical" 27 | )) 28 | 29 | validLinearFilter <- function(object){ 30 | 31 | if(length(object@mean) != 1) 32 | return("The mean should be exactly of length 1.") 33 | 34 | if(length(object@colmeans) != ncol(object@y)) 35 | return("The length of colmeans is incompatible with the number of columns in y.") 36 | if(length(object@rowmeans) != nrow(object@y)) 37 | return("The length of rowmeans is incompatible with the number of rows in y.") 38 | 39 | if(length(object@na.rm) != 1) 40 | return("na.rm needs to be a single logical value.") 41 | 42 | if(length(object@alpha) != 4) 43 | return("Alpha should contain exactly 4 numeric values.") 44 | else 45 | return(TRUE) 46 | } 47 | 48 | setValidity("linearFilter", validLinearFilter) 49 | -------------------------------------------------------------------------------- /man/tskrrImputeHomogeneous-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Class_tskrrImputeHomogeneous.R 3 | \docType{class} 4 | \name{tskrrImputeHomogeneous-class} 5 | \alias{tskrrImputeHomogeneous-class} 6 | \alias{tskrrImputeHomogeneous} 7 | \title{Class tskrrImputeHomogeneous} 8 | \description{ 9 | The class \code{tskrrImputeHomogeneous} is a subclass of the 10 | class \code{\link[xnet:tskrrHomogeneous-class]{tskrrHomogeneous}} and 11 | \code{\link[xnet:tskrrImpute-class]{tskrrImpute}} 12 | specifically for homogeneous networks with imputed values. It is 13 | the result of the function \code{\link{impute_tskrr}} on a 14 | homogeneous network model. 15 | } 16 | \section{Slots}{ 17 | 18 | \describe{ 19 | \item{\code{y}}{the matrix with responses} 20 | 21 | \item{\code{k}}{the eigen decomposition of the kernel matrix for the rows} 22 | 23 | \item{\code{lambda.k}}{the lambda value used for k} 24 | 25 | \item{\code{pred}}{the matrix with the predictions} 26 | 27 | \item{\code{symmetry}}{a character value that can have the possible values 28 | \code{"symmetric"}, \code{"skewed"} or \code{"not"}. It indicates 29 | whether the \code{y} matrix is symmetric, skewed-symmetric or not 30 | symmetric.} 31 | 32 | \item{\code{has.hat}}{a logical value indicating whether the kernel hat matrices 33 | are stored in the object.} 34 | 35 | \item{\code{Hk}}{the kernel hat matrix for the rows.} 36 | 37 | \item{\code{labels}}{a list with elements \code{k} and \code{g} (see 38 | \code{\link{tskrr-class}}). For homogeneous networks, \code{g} 39 | is always \code{NA}. If \code{k} is \code{NA}, the labels used 40 | are integers indicating the row resp column number.} 41 | 42 | \item{\code{imputeid}}{a vector with integer values indicating which of 43 | the values in \code{y} are imputed} 44 | 45 | \item{\code{niter}}{an integer value gving the number of iterations used} 46 | 47 | \item{\code{tol}}{a numeric value with the tolerance used} 48 | }} 49 | 50 | -------------------------------------------------------------------------------- /man/update.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/all_generics.R, R/update.R 3 | \name{update} 4 | \alias{update} 5 | \alias{update,tskrrHomogeneous-method} 6 | \alias{update,tskrrHeterogeneous-method} 7 | \title{Update a tskrr object with a new lambda} 8 | \usage{ 9 | update(object, ...) 10 | 11 | \S4method{update}{tskrrHomogeneous}(object, lambda) 12 | 13 | \S4method{update}{tskrrHeterogeneous}(object, lambda) 14 | } 15 | \arguments{ 16 | \item{object}{a \code{\link[xnet:tskrr-class]{tskrr}} object} 17 | 18 | \item{...}{arguments passed to methods} 19 | 20 | \item{lambda}{a numeric vector with one or two values for the 21 | hyperparameter lambda. If two values are given, the first one is 22 | used for the k matrix and the second for the g matrix.} 23 | } 24 | \value{ 25 | an updated \code{\link[xnet:tskrr-class]{tskrr}} object 26 | fitted with the new lambdas. 27 | } 28 | \description{ 29 | This function allows you to refit a \code{\link{tskrr}} with a 30 | new lambda. It can be used to do manual tuning/cross-validation. 31 | If the object has the hat matrices stored, these are updated 32 | as well. 33 | } 34 | \examples{ 35 | data(drugtarget) 36 | 37 | mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 38 | 39 | # Update with the same lambda 40 | mod2 <- update(mod, lambda = 1e-3) 41 | 42 | # Use different lambda for rows and columns 43 | mod3 <- update(mod, lambda = c(0.01,0.001)) 44 | 45 | # A model with the hat matrices stored 46 | lambda <- c(0.001,0.01) 47 | modkeep <- tskrr(drugTargetInteraction, targetSim, drugSim, keep = TRUE) 48 | Hk_1 <- hat(modkeep, which = "row") 49 | modkeep2 <- update(modkeep, lambda = lambda) 50 | Hk_2 <- hat(modkeep2, which = "row") 51 | 52 | # Calculate new hat matrix by hand: 53 | decomp <- get_eigen(modkeep, which = "row") 54 | Hk_byhand <- eigen2hat(decomp$vectors, 55 | decomp$values, 56 | lambda = lambda[1]) 57 | identical(Hk_2, Hk_byhand) 58 | 59 | } 60 | -------------------------------------------------------------------------------- /R/all_generics.R: -------------------------------------------------------------------------------- 1 | # Classes needed for generics 2 | setOldClass("htest") 3 | 4 | # All Generics 5 | 6 | #' @rdname get_loo_fun 7 | #' @export 8 | setGeneric("get_loo_fun", 9 | function(x, ...) standardGeneric("get_loo_fun")) 10 | 11 | #' @rdname loo 12 | #' @export 13 | setGeneric("loo", 14 | function(x, ...) standardGeneric("loo")) 15 | 16 | ## For tskrr 17 | setGeneric("response", 18 | function(x, ...) standardGeneric("response")) 19 | setGeneric("lambda", 20 | function(x, ...) standardGeneric("lambda")) 21 | setGeneric("tune", 22 | function(x, ...) standardGeneric("tune")) 23 | 24 | #' @rdname permtest 25 | #' @export 26 | setGeneric("permtest", 27 | function(x, ...) standardGeneric("permtest")) 28 | 29 | #' @rdname update 30 | #' @export 31 | setGeneric("update") 32 | 33 | # For the hat matrices 34 | #' @rdname hat 35 | setGeneric("hat", 36 | function(x, ...) standardGeneric("hat")) 37 | setMethod("hat", 38 | "ANY", 39 | stats::hat) 40 | 41 | # For the labels 42 | setGeneric("labels") 43 | setGeneric("rownames") 44 | setGeneric("colnames") 45 | setGeneric("dimnames") 46 | 47 | # For the dimensions 48 | setGeneric("dim") 49 | 50 | # For the linearFilter 51 | setGeneric("mean") 52 | setGeneric("colMeans") 53 | setGeneric("rowMeans") 54 | 55 | #' @rdname getters_linearFilter 56 | #' @export 57 | setGeneric("alpha", function(x) standardGeneric("alpha")) 58 | 59 | #' @rdname getters_linearFilter 60 | #' @export 61 | setGeneric("na_removed", function(x) standardGeneric("na_removed")) 62 | 63 | # For the tune 64 | 65 | #' @rdname as_tuned 66 | setGeneric("as_tuned", function(x, ...) standardGeneric("as_tuned")) 67 | 68 | #' @rdname as_tuned 69 | setGeneric("as_tskrr", function(x, ...) standardGeneric("as_tskrr")) 70 | 71 | #' @rdname loss 72 | #' @export 73 | setGeneric("loss", function(x, ...) standardGeneric("loss")) 74 | 75 | #' @rdname residuals.tskrr 76 | #' @export 77 | setGeneric("residuals") 78 | -------------------------------------------------------------------------------- /R/Class_tskrrImpute.R: -------------------------------------------------------------------------------- 1 | #' Class tskrrImpute 2 | #' 3 | #' The class \code{tskrrImpute} is a virtual class that represents a 4 | #' \code{\link[xnet:tskrr-class]{tskrr}} model with imputed values in 5 | #' the label matrix Y. Apart from the model, it contains the 6 | #' following extra information on the imputed values. 7 | #' 8 | #' @slot imputeid a vector with integer values indicating which of 9 | #' the values in \code{y} are imputed 10 | #' @slot niter an integer value gving the number of iterations used 11 | #' @slot tol a numeric value with the tolerance used 12 | #' 13 | #' @rdname tskrrImpute-class 14 | #' @aliases tskrrImpute 15 | #' @exportClass tskrrImpute 16 | setClass("tskrrImpute", 17 | slots = c(imputeid = "integer", 18 | niter = "integer", 19 | tol = "numeric"), 20 | prototype = prototype( 21 | niter = 0L, 22 | tol = 0L 23 | ) 24 | ) 25 | 26 | validTskrrImpute <- function(object){ 27 | if(length(object@niter) != 1) 28 | return("niter should contain a single integer value") 29 | if(length(object@tol) != 1) 30 | return("tol should contain a single numeric value") 31 | } 32 | 33 | setValidity("tskrrImpute", validTskrrImpute) 34 | 35 | setMethod("show", 36 | "tskrrImpute", 37 | function(object){ 38 | 39 | ishomog <- is_homogeneous(object) 40 | type <- ifelse(ishomog,"Homogeneous","Heterogeneous") 41 | tl <- ifelse(ishomog,"----------","------------") 42 | cat(paste(type,"two-step kernel ridge regression with imputation"), 43 | paste(tl,"------------------------------------------------",sep="-"), 44 | sep = "\n") 45 | .show_tskrr(object, ishomog) 46 | 47 | cat("\nImputation information:\n") 48 | cat("-----------------------\n") 49 | cat("iterations:", object@niter,"\n") 50 | cat("tolerance:", signif(object@tol, 4),"\n") 51 | 52 | 53 | }) 54 | -------------------------------------------------------------------------------- /R/Class_tskrrTuneHeterogeneous.R: -------------------------------------------------------------------------------- 1 | #' Class tskrrTuneHeterogeneous 2 | #' 3 | #' The class tskrrTuneHeterogeneous represents a tuned Heterogeneous 4 | #' \code{\link[xnet:tskrr-class]{tskrr}} model. It inherits from 5 | #' the classes \code{\link[xnet:tskrrHeterogeneous-class]{tskrrHeterogeneous}} 6 | #' and \code{\link[xnet:tskrrTune-class]{tskrrTune}}. 7 | #' 8 | #' @rdname tskrrTuneHeterogeneous-class 9 | #' @name tskrrTuneHeterogeneous-class 10 | #' @aliases tskrrTuneHeterogeneous 11 | #' @exportClass tskrrTuneHeterogeneous 12 | setClass("tskrrTuneHeterogeneous", 13 | contains = c("tskrrTune", "tskrrHeterogeneous")) 14 | 15 | validTskrrTuneHeterogeneous <- function(object){ 16 | 17 | lossval <- object@loss_values 18 | lgrid <- object@lambda_grid 19 | excl <- object@exclusion 20 | onedim <- object@onedim 21 | 22 | if(!onedim && any(names(lgrid) != c("k","g"))) 23 | return("lambda grid should be a list with two elements named k and g (in that order) for heterogeneous networks") 24 | else if(onedim && any(names(lgrid) != "k") && length(lgrid) > 1) 25 | return("in a one-dimensional search there should only be a single element named k in the lambda grid.") 26 | 27 | if(nrow(lossval) != length(lgrid$k)) 28 | return(paste("Loss values should have",length(lgrid$k),"rows to match the lambda grid.")) 29 | 30 | if(!onedim && ncol(lossval) != length(lgrid$g)) 31 | return(paste("Loss values should have",length(lgrid$g),"columns to match the lambda grid.")) 32 | else if(onedim && ncol(lossval) != 1) 33 | return(paste("Loss values should have one column in case of one-dimensional search.")) 34 | 35 | exclmatch <- match(excl, c("interaction","row","column","both"), 36 | nomatch = 0L) 37 | if(exclmatch == 0) 38 | return("exclusion should be one of 'interaction', 'row', 'column' or 'both'") 39 | 40 | if(object@replaceby0 && excl != "interaction") 41 | return("replaceby0 can only be used with interaction exclusion") 42 | else 43 | return(TRUE) 44 | 45 | } 46 | 47 | setValidity("tskrrTuneHeterogeneous", validTskrrTuneHeterogeneous) 48 | -------------------------------------------------------------------------------- /R/loss_functions.R: -------------------------------------------------------------------------------- 1 | #' loss functions 2 | #' 3 | #' These functions can be used as loss functions in \code{\link{tune}}. 4 | #' Currently, two functions are provided: a function calculating the 5 | #' classic mean squared error (\code{loss_mse}) and a function 6 | #' calculating 1 - AUC (\code{loss_auc}). 7 | #' 8 | #' The AUC is calculated by sorting the \code{Y} matrix based on 9 | #' the order of the values in the \code{LOO} matrix. The false and true 10 | #' positive rates are calculated solely based on that ordering, which 11 | #' allows for values in \code{LOO} outside the range [0,1]. It's 12 | #' a naive implementation which is good enough for tuning, but 13 | #' shouldn't be used as a correct value for 1 - auc in case the 14 | #' values in \code{LOO} are outside the range [0,1]. 15 | #' 16 | #' @section Note: 17 | #' The function \code{loss_auc} should only be used for a \code{Y} 18 | #' matrix that contains solely the values 0 and 1. 19 | #' 20 | #' @param Y the label matrix with observed responses 21 | #' @param LOO the leave-one-out crossvalidation (or predictions if you 22 | #' must). This one can be calculated by the function \code{loo}. 23 | #' @param na.rm a logical value 24 | #' 25 | #' @seealso \code{\link{tune}} for application of the loss function 26 | #' 27 | #' @examples 28 | #' 29 | #' x <- c(1,0,0,1,0,0,1,0,1) 30 | #' y <- c(0.8,-0.1,0.2,0.2,0.4,0.01,1.12,0.9,0.9) 31 | #' loss_mse(x,y) 32 | #' loss_auc(x,y) 33 | #' 34 | #' @rdname loss_functions 35 | #' @name loss_functions 36 | #' @aliases loss_mse loss_auc 37 | #' @export 38 | loss_mse <- function(Y, LOO, na.rm = FALSE){ 39 | mean((Y - LOO)^2, na.rm = na.rm) 40 | } 41 | 42 | #' @rdname loss_functions 43 | #' @export 44 | loss_auc <- function(Y, LOO){ 45 | 46 | id <- order(LOO) 47 | roc_y <- Y[id] 48 | 49 | # Calculate total number positives, negatives and y values 50 | np <- sum(roc_y) 51 | ny <- length(roc_y) 52 | nn <- ny - np 53 | 54 | # tpr and fpr 55 | fpr <- cumsum(roc_y)/np 56 | tpr <- cumsum(roc_y == 0) / nn 57 | 58 | dtpr <- diff(tpr) 59 | dfpr <- diff(fpr) 60 | auc <- sum( dfpr * tpr[2:ny] - (dfpr * dtpr)/2 ) 61 | return(1 - auc) 62 | } 63 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: xnet 2 | Type: Package 3 | Title: Two-Step Kernel Ridge Regression for Network Predictions 4 | Version: 0.1.11 5 | Authors@R: c(person("Joris","Meys", email = "Joris.Meys@UGent.be", role 6 | = c("cre","aut")), person("Michiel", "Stock", email = 7 | "Michiel.Stock@UGent.be", role = "aut")) 8 | Description: Fit a two-step kernel ridge regression model for 9 | predicting edges in networks, and carry out cross-validation 10 | using shortcuts for swift and accurate performance assessment 11 | (Stock et al, 2018 ). 12 | Date: 2020-02-03 13 | BugReports: https://github.com/CenterForStatistics-UGent/xnet/issues 14 | URL: https://github.com/CenterForStatistics-UGent/xnet 15 | Depends: R(>= 3.4.0) 16 | Imports: methods, utils, graphics, stats, grDevices 17 | License: GPL-3 18 | Encoding: UTF-8 19 | LazyData: true 20 | RoxygenNote: 7.0.2 21 | Suggests: testthat, knitr, rmarkdown, ChemmineR, covr, fmcsR 22 | VignetteBuilder: knitr 23 | Collate: 'Class_linearFilter.R' 'all_generics.R' 'Class_permtest.R' 24 | 'Class_tskrr.R' 'Class_tskrrHeterogeneous.R' 25 | 'Class_tskrrHomogeneous.R' 'Class_tskrrImpute.R' 26 | 'Class_tskrrImputeHeterogeneous.R' 27 | 'Class_tskrrImputeHomogeneous.R' 'Class_tskrrTune.R' 28 | 'Class_tskrrTuneHeterogeneous.R' 'Class_tskrrTuneHomogeneous.R' 29 | 'as_tuned.R' 'create_grid.R' 'data_drugtarget.R' 30 | 'data_proteinInteraction.R' 'dim.R' 'eigen2hat.R' 'fitted.R' 31 | 'get_loo_fun.R' 'getlooInternal.R' 'getters_linearFilter.R' 32 | 'getters_permtest.R' 'getters_tskrr.R' 'getters_tskrrImpute.R' 33 | 'getters_tskrrTune.R' 'hat.R' 'impute_tskrr.R' 34 | 'impute_tskrr.fit.R' 'internal_helpers.R' 'is_symmetric.R' 35 | 'labels.R' 'linear_filter.R' 'loo.R' 'looInternal.R' 'loss.R' 36 | 'loss_functions.R' 'match_labels.R' 'permtest.R' 'plot.tskrr.R' 37 | 'plot_grid.R' 'predict.R' 'prepare_lambdas.R' 'residuals.R' 38 | 'test_input.R' 'test_symmetry.R' 'tskrr.R' 'tskrr.fit.R' 39 | 'tune.R' 'update.R' 'valid_dimensions.R' 'valid_labels.R' 40 | 'weights.R' 'xnet-package.R' 41 | -------------------------------------------------------------------------------- /docs/index.md: -------------------------------------------------------------------------------- 1 | --- 2 | --- 3 |

4 | the xnet logo 5 |

6 | 7 | The package `xnet` is a package in development for cross-network analysis 8 | like protein-ligand or plant-pollinator interactions. Currently the 9 | package provides a basic interface for two-step kernel ridge regression, 10 | including quick cross-validation due to algebraic shortcuts. 11 | 12 | The package is still in beta, so expect thorough changes and additions. A first stable version (0.1.10) is released on [CRAN]( https://CRAN.R-project.org/package=xnet). 13 | 14 | The current version can be installed at your own risk using following code: 15 | 16 | install.packages("xnet") 17 | 18 | If you want to download the latest devel version, you can use the following code : 19 | 20 | devtools::install_github("CenterForStatistics-UGent/xnet", ref = "devel) 21 | 22 | It includes a few vignettes explaining how to use the package, how the example data was prepared and how the internal class inheritance works. After installing, you can open the introduction using following code : 23 | 24 | vignette("xnet_ShortIntroduction", package = "xnet") 25 | 26 | The paper describing the method is published in Briefings in Bioinformatics: 27 | 28 | Stock, M., Pahikkala, T., Airola, A., Waegeman, W. and De Baets, B. *Algebraic shortcuts for leave-one-out cross-validation in supervised network inference* Briefings in Bioinformatics, accepted sep 2018. 29 | 30 | [https://doi.org/10.1093/bib/bby095](https://doi.org/10.1093/bib/bby095) 31 | 32 | [Preprint](https://www.biorxiv.org/content/early/2018/01/03/242321.1) 33 | 34 | Our algorithms are part of a larger kernel-based framework for pairwise learning. A paper relating the different methods and their learning properties was recently accepted for publication in Neural Computation: 35 | 36 | Stock, M., Pahikkala, T., Airola, A., De Baets, B. and Waegeman, W. *A comparative study of pairwise learning methods based on kernel ridge regression* Neural Computation 30 (2018), 2245-2283. 37 | 38 | [https://doi.org/10.1162/neco_a_01096](https://doi.org/10.1162/neco_a_01096) 39 | 40 | [Preprint](https://arxiv.org/abs/1803.01575) 41 | -------------------------------------------------------------------------------- /R/eigen2hat.R: -------------------------------------------------------------------------------- 1 | #' Calculate the hat matrix from an eigen decomposition 2 | #' 3 | #' These functions calculate either the hat matrix, the mapping matrix or 4 | #' the original (kernel) matrix for a two-step kernel ridge regression, 5 | #' based on the eigendecomposition of the kernel matrix. 6 | #' 7 | #' For the hat matrix, this boils down to: 8 | #' 9 | #' \deqn{U\Sigma(\Sigma + \lambda I)^{-1} U^{T}} 10 | #' 11 | #' For the map matrix, this is : 12 | #' 13 | #' \deqn{U(\Sigma + \lambda I)^{-1} U^{T}} 14 | #' 15 | #' with \eqn{U} the matrix with eigenvectors, \eqn{\Sigma} a diagonal matrix 16 | #' with the eigenvalues on the diagonal, \eqn{I} the identity matrix and 17 | #' \eqn{\lambda} the hyperparameter linked to this kernel. 18 | #' The internal calculation is optimized to avoid having to invert 19 | #' a matrix. This is done using the fact that \eqn{\Sigma} is a 20 | #' diagonal matrix. 21 | #' 22 | #' @param eigen a matrix with the eigenvectors. 23 | #' @param val an numeric vector with the eigenvalues. 24 | #' @param lambda a single numeric value for the hyperparameter lambda 25 | #' 26 | #' @return a numeric matrix representing either the hat matrix 27 | #' (\code{eigen2hat}), the map matrix (\code{eigen2map}) or 28 | #' the original matrix (\code{eigen2matrix}) 29 | #' 30 | #' @export 31 | eigen2hat <- function(eigen, val , lambda){ 32 | 33 | # Sigma is a diagonal matrix, so Sigma %*% Sigma + lambdaI can 34 | # be calculated based on the vals as val * 1/(val + lambda) 35 | # This can be calculated first due to associativity of the 36 | # matrix multiplication. 37 | 38 | mid <- val / (val + lambda) 39 | 40 | # Use recycling to calculate the right side first 41 | # thanks to associativity of the matrix multiplication. 42 | 43 | return(eigen %*% (mid * t(eigen))) 44 | } 45 | 46 | #' @rdname eigen2hat 47 | #' @export 48 | eigen2map <- function(eigen, val, lambda){ 49 | 50 | mid <- 1 / (val + lambda) 51 | 52 | # Use recycling to calculate the right side first 53 | # thanks to associativity of the matrix multiplication. 54 | 55 | return(eigen %*% (mid * t(eigen))) 56 | } 57 | 58 | #' @rdname eigen2hat 59 | #' @export 60 | eigen2matrix <- function(eigen, val){ 61 | return(eigen %*% (val * t(eigen)) ) 62 | } 63 | -------------------------------------------------------------------------------- /R/test_input.R: -------------------------------------------------------------------------------- 1 | # Function to test inputs for tskrr etc. 2 | 3 | # This function tests the input for all fitting functions. 4 | # Put checkna = FALSE if NA values are allowed in y. 5 | # It returns a list with the following elements: 6 | # - lambda.k 7 | # - lambda.g 8 | # - homogeneous 9 | .test_input <- function(y,k,g, 10 | lambda = 1e-4, 11 | testdim = TRUE, 12 | testlabels = TRUE, 13 | checkna = TRUE){ 14 | 15 | # SET FLAGS 16 | homogeneous <- is.null(g) 17 | 18 | # TESTS INPUT 19 | if( !(is.matrix(y) && is.numeric(y)) ) 20 | stop("y should be a matrix.") 21 | 22 | if( !(is.matrix(k) && is.numeric(k)) ) 23 | stop("k should be a matrix.") 24 | 25 | if(!is.numeric(lambda)) 26 | stop("lambda should be numeric.") 27 | 28 | if(!homogeneous){ 29 | if( !(is.matrix(g) && is.numeric(g)) ) 30 | stop("g should be a matrix.") 31 | 32 | nl <- length(lambda) 33 | if(nl < 1 || nl > 2) 34 | stop("lambda should contain one or two values. See ?tskrr") 35 | 36 | } else { 37 | if(length(lambda) != 1) 38 | stop("lambda should be a single value. See ?tskrr") 39 | } 40 | 41 | if(checkna && any(is.na(y))) 42 | stop(paste("Missing values in the y matrix are not allowed. You can", 43 | "use the function impute_tskrr for imputations.")) 44 | 45 | # TEST KERNELS 46 | if(testdim){ 47 | if(!is_symmetric(k)) 48 | stop("k should be a symmetric matrix.") 49 | 50 | if(!homogeneous && !is_symmetric(g)) 51 | stop("g should be a symmetric matrix.") 52 | 53 | if(!valid_dimensions(y,k,g)) 54 | stop(paste("The dimensions of the matrices don't match.", 55 | "Did you maybe switch the k and g matrices?", 56 | sep = "\n")) 57 | } 58 | if(testlabels){ 59 | 60 | valid_labels(y,k,g) # Generates errors if something's wrong 61 | 62 | } 63 | 64 | # SET LAMBDAS 65 | lambda.k <- lambda[1] 66 | lambda.g <- if(!homogeneous){ 67 | if(nl == 1) lambda else lambda[2] 68 | } else NULL 69 | 70 | return(list( 71 | lambda.k = lambda.k, 72 | lambda.g = lambda.g, 73 | homogeneous = homogeneous 74 | )) 75 | } 76 | -------------------------------------------------------------------------------- /R/getters_tskrrImpute.R: -------------------------------------------------------------------------------- 1 | #' Getters for tskrrImpute objects 2 | #' 3 | #' The functions described here are convenience functions to get 4 | #' information out of a \code{\link[xnet:tskrrImpute-class]{tskrrImpute}} 5 | #' object. 6 | #' 7 | #' @param x a \code{\link[xnet:tskrrImpute-class]{tskrrImpute}} object or 8 | #' an object inheriting from \code{tskrrImpute}. 9 | #' 10 | #' @return For \code{has_imputed_values}: a logical value indicating whether 11 | #' the model has imputed values. If \code{x} is not some form of a 12 | #' \code{\link{tskrr}} model, the function will return an error. 13 | #' 14 | #' 15 | #' @examples 16 | #' 17 | #' data(drugtarget) 18 | #' 19 | #' mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 20 | #' 21 | #' naid <- sample(length(drugTargetInteraction), 30) 22 | #' drugTargetInteraction[naid] <- NA 23 | #' 24 | #' impmod <- impute_tskrr(drugTargetInteraction, targetSim, drugSim) 25 | #' 26 | #' has_imputed_values(mod) 27 | #' has_imputed_values(impmod) 28 | #' 29 | #' # For illustration: extract imputed values 30 | #' id <- is_imputed(impmod) 31 | #' fitted(impmod)[id] 32 | #' 33 | #' @include all_generics.R 34 | #' @rdname getters-tskrrImpute 35 | #' @aliases has_imputed_values 36 | #' @export 37 | has_imputed_values <- function(x){ 38 | if(!inherits(x, "tskrr")) stop("x should be a tskrr model.") 39 | inherits(x, "tskrrImpute") 40 | } 41 | 42 | #' @rdname getters-tskrrImpute 43 | #' @return For \code{which_imputed}: a integer vector with the positions 44 | #' for which the values are imputed. 45 | #' @export 46 | which_imputed <- function(x){ 47 | if(!inherits(x, "tskrrImpute")) 48 | stop("x should be a tskrr model with imputed values.") 49 | x@imputeid 50 | } 51 | 52 | #' @rdname getters-tskrrImpute 53 | #' @return for \code{is_imputed}: a matrix of the same dimensions as the 54 | #' label matrix. It contains the value \code{FALSE} at positions that 55 | #' were not imputed, and \code{TRUE} at positions that were. 56 | #' @export 57 | is_imputed <- function(x){ 58 | if(!inherits(x, "tskrrImpute")) 59 | stop("x should be a tskrr model with imputed values.") 60 | dims <- dim(x@y) 61 | out <- matrix(FALSE, nrow = dims[1], ncol = dims[2]) 62 | out[x@imputeid] <- TRUE 63 | return(out) 64 | } 65 | -------------------------------------------------------------------------------- /man/tskrr.fit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tskrr.fit.R 3 | \name{tskrr.fit} 4 | \alias{tskrr.fit} 5 | \title{Carry out a two-step kernel ridge regression} 6 | \usage{ 7 | tskrr.fit(y, k, g = NULL, lambda.k = NULL, lambda.g = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{y}{a matrix representing the links between the nodes of both 11 | networks.} 12 | 13 | \item{k}{an object of class \code{\link{eigen}} containing the eigen 14 | decomposition of the first kernel matrix.} 15 | 16 | \item{g}{an optional object of class \code{\link{eigen}} containing 17 | the eigen decomposition of the second kernel matrix. If \code{NULL}, 18 | the network is considered to be homogeneous.} 19 | 20 | \item{lambda.k}{a numeric value for the lambda parameter tied 21 | to the first kernel.} 22 | 23 | \item{lambda.g}{a numeric value for the lambda parameter tied 24 | to the second kernel. If \code{NULL}, the model is fit using the same 25 | value for \code{lambda.k} and \code{lambda.g}} 26 | 27 | \item{...}{arguments passed to other functions. Currently ignored.} 28 | } 29 | \value{ 30 | a list with three elements: 31 | \itemize{ 32 | \item k : the hat matrix for the rows 33 | \item g : the hat matrix for the columns (or \code{NULL}) 34 | for homogeneous networks. 35 | \item pred : the predictions 36 | } 37 | } 38 | \description{ 39 | This function provides an interface for two-step kernel ridge regression. 40 | To use this function, you need at least one kernel matrix and one 41 | label matrix. It's the internal engine used by the function 42 | \code{\link{tskrr}}. 43 | } 44 | \details{ 45 | This function is mostly available for internal use. In most cases, it 46 | makes much more sense to use \code{\link{tskrr}}, as that function 47 | returns an object one can work with. The function 48 | \code{tskrr.fit} could be useful when doing simulations or 49 | fitting algorithms, as the information returned from this function 50 | is enough to use the functions returned by \code{\link{get_loo_fun}}. 51 | } 52 | \examples{ 53 | 54 | data(drugtarget) 55 | 56 | K <- eigen(targetSim) 57 | G <- eigen(drugSim) 58 | 59 | res <- tskrr.fit(drugTargetInteraction,K,G, 60 | lambda.k = 0.01, lambda.g = 0.05) 61 | 62 | } 63 | -------------------------------------------------------------------------------- /man/as_tuned.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/all_generics.R, R/as_tuned.R 3 | \name{as_tuned} 4 | \alias{as_tuned} 5 | \alias{as_tskrr} 6 | \alias{as_tuned,tskrrHomogeneous-method} 7 | \alias{as_tuned,tskrrHeterogeneous-method} 8 | \alias{as_tskrr,tskrrTune-method} 9 | \alias{as_tskrr,tskrrImpute-method} 10 | \alias{as_tskrr,tskrr-method} 11 | \title{convert tskrr models} 12 | \usage{ 13 | as_tuned(x, ...) 14 | 15 | as_tskrr(x, ...) 16 | 17 | \S4method{as_tuned}{tskrrHomogeneous}(x, ...) 18 | 19 | \S4method{as_tuned}{tskrrHeterogeneous}(x, ...) 20 | 21 | \S4method{as_tskrr}{tskrrTune}(x) 22 | 23 | \S4method{as_tskrr}{tskrrImpute}(x) 24 | 25 | \S4method{as_tskrr}{tskrr}(x) 26 | } 27 | \arguments{ 28 | \item{x}{a model of class \code{\link[xnet:tskrr-class]{tskrr}}} 29 | 30 | \item{...}{values for the extra slots defined by 31 | the class \code{\link[xnet:tskrrTune-class]{tskrrTune}}} 32 | } 33 | \value{ 34 | For \code{as_tuned}: 35 | a \code{\link[xnet:tskrrTune-class]{tskrrTune}} object of 36 | the proper class (homogeneous or heterogeneous) 37 | 38 | For \code{as_tskrr}: an object of class 39 | \code{\link[xnet:tskrrHomogeneous-class]{tskrrHomogeneous}} or 40 | \code{\link[xnet:tskrrHeterogeneous-class]{tskrrHeterogeneous}} depending 41 | on whether the original object was homogeneous or heterogeneous. 42 | } 43 | \description{ 44 | These functions allow converting models that inherit from the 45 | \code{\link[xnet:tskrr-class]{tskrr}} and 46 | \code{\link[xnet:tskrrTune-class]{tskrrTune}} class into each other, 47 | keeping track of whether the model is homogeneous or heterogeneous. 48 | The dots argument allows specifying values for possible extra slots 49 | when converting from \code{tskrr} to \code{tskrrTune}. 50 | More information on these slots can be found 51 | on the help page of \code{\link[xnet:tskrrTune-class]{tskrrTune}}. 52 | \strong{These functions are not exported.} 53 | } 54 | \section{\bold{Warning}}{ 55 | 56 | This functions do NOT tune a model. they are used internally to 57 | make the connection between both types in the methods. 58 | } 59 | 60 | \seealso{ 61 | \itemize{ 62 | \item \code{\link{tune}} for actually tuning a model. 63 | \item \code{\link[xnet:tskrrTune-class]{tskrrTune}} for 64 | names and possible values of the slots passed through 65 | \dots 66 | } 67 | } 68 | -------------------------------------------------------------------------------- /R/Class_tskrrHomogeneous.R: -------------------------------------------------------------------------------- 1 | #' Class tskrrHomogeneous 2 | #' 3 | #' The class tskrrHomogeneous is a subclass of the superclass 4 | #' \code{\link[xnet:tskrr-class]{tskrr}} specifically for 5 | #' homogeneous networks. 6 | #' 7 | #' @slot y the matrix with responses 8 | #' @slot k the eigen decomposition of the kernel matrix for the rows 9 | #' @slot lambda.k the lambda value used for k 10 | #' @slot pred the matrix with the predictions 11 | #' @slot symmetry a character value that can have the possible values 12 | #' \code{"symmetric"}, \code{"skewed"} or \code{"not"}. It indicates 13 | #' whether the \code{y} matrix is symmetric, skewed-symmetric or not 14 | #' symmetric. 15 | #' @slot has.hat a logical value indicating whether the kernel hat matrices 16 | #' are stored in the object. 17 | #' @slot Hk the kernel hat matrix for the rows. 18 | #' @slot labels a list with elements \code{k} and \code{g} (see 19 | #' \code{\link{tskrr-class}}). For homogeneous networks, \code{g} 20 | #' is always \code{NA}. If \code{k} is \code{NA}, the labels used 21 | #' are integers indicating the row resp column number. 22 | #' 23 | #' @include Class_tskrr.R 24 | #' @rdname tskrrHomogeneous-class 25 | #' @name tskrrHomogeneous-class 26 | #' @aliases tskrrHomogeneous 27 | #' @exportClass tskrrHomogeneous 28 | setClass("tskrrHomogeneous", 29 | contains = "tskrr", 30 | slots = c(symmetry = "character"), 31 | prototype = list(symmetry = "not") 32 | ) 33 | 34 | validTskrrHomogeneous <- function(object){ 35 | 36 | if(!object@symmetry %in% c("symmetric","skewed", "not")) 37 | return("symmetry should be one of: symmetric, skewed or not.") 38 | 39 | else if(object@has.hat && !valid_dimensions(object@y, object@Hk)) 40 | return("The dimensions of the original kernel matrices and the observations don't match.") 41 | 42 | else if(!length(object@labels$g) == 1 || !is.na(object@labels$g)) 43 | return("The element g of labels should be NA") 44 | 45 | else if( 46 | (length(object@labels$k) == 1 && !is.na(object@labels$k)) && 47 | (length(object@labels$k) != nrow(object@y)) 48 | ) 49 | return("The element k should either be NA or a character vector with the same number of values as there are rows in the Y matrix.") 50 | 51 | else 52 | return(TRUE) 53 | } 54 | 55 | setValidity("tskrrHomogeneous", 56 | validTskrrHomogeneous) 57 | -------------------------------------------------------------------------------- /tests/testthat/test_linearFilter_calculations.R: -------------------------------------------------------------------------------- 1 | context("Linear filter calculations") 2 | 3 | # LINEAR FILTER ---------------------------------------- 4 | X <- matrix(c(1,0,0,1,0,0,0,1,0,1,0,1,1,1,0,1,0,0,1,1), 5 | ncol = 5) 6 | alphas <- c(0.1,0.1,0.4,0.4) 7 | linF <- linear_filter(X, alpha = alphas) 8 | linF2 <- linear_filter(X) 9 | cm <- colMeans(X) 10 | rm <- rowMeans(X) 11 | m <- mean(X) 12 | 13 | preds <- alphas[1] * X + 14 | alphas[2] * rep(cm, each = nrow(X)) + 15 | alphas[3] * rep(rm, times = ncol(X)) + 16 | alphas[4] * m 17 | 18 | test_that("Linear filter is constructed correctly",{ 19 | expect_identical(colMeans(linF), cm) 20 | expect_identical(rowMeans(linF), rm) 21 | expect_identical(mean(linF), m) 22 | expect_identical(alpha(linF), alphas) 23 | expect_false(na_removed(linF)) 24 | expect_equal(fitted(linF),preds) 25 | }) 26 | 27 | 28 | test_that("alphas are processed correctly",{ 29 | expect_error(linear_filter(Y, alpha = c(1,2))) 30 | expect_equal(alpha(linF),alphas) 31 | expect_equal(alpha(linF2), rep(0.25,4)) 32 | }) 33 | 34 | Yna <- X 35 | Yna[c(3,8,11,14)] <- NA 36 | linFNA <- linear_filter(Yna, alphas) 37 | linFNONA <- suppressWarnings(linear_filter(Yna, alphas, na.rm = TRUE)) 38 | 39 | cmna <- colMeans(Yna, na.rm = TRUE) 40 | rmna <- rowMeans(Yna, na.rm = TRUE) 41 | mna <- mean(Yna, na.rm = TRUE) 42 | 43 | preds <- alphas[1] * Yna + 44 | alphas[2] * rep(cmna, each = nrow(X)) + 45 | alphas[3] * rep(rmna, times = ncol(X)) + 46 | alphas[4] * mna 47 | 48 | 49 | test_that("NAs are dealt with properly", { 50 | expect_equal(fitted(linFNA), 51 | matrix(NA_real_,ncol = ncol(X), nrow = nrow(X))) 52 | expect_true(na_removed(linFNONA)) 53 | expect_identical(colMeans(linFNONA), cmna) 54 | expect_identical(rowMeans(linFNONA), rmna) 55 | expect_identical(mean(linFNONA), mna) 56 | expect_identical(alpha(linFNONA), alphas) 57 | expect_equal(fitted(linFNONA),preds) 58 | }) 59 | 60 | test_that("linear_filter returns correct errors",{ 61 | expect_error(linear_filter(X, alpha = c(0.5,0.5)), 62 | "alpha should .* either 1 or 4 values") 63 | expect_error(linear_filter(X, alpha = c(0.1,0.1,0.1,0.1)), 64 | "alpha values should .* add up to 1") 65 | expect_error(linear_filter(X, alpha = c(-0.2, 0.2, 0.5,0.5)), 66 | "alpha values should be numbers between 0 and 1") 67 | }) 68 | -------------------------------------------------------------------------------- /R/getters_tskrrTune.R: -------------------------------------------------------------------------------- 1 | #' Getters for tskrrTune objects 2 | #' 3 | #' The functions described here are convenience functions to get 4 | #' information out of a \code{\link[xnet:tskrrTune-class]{tskrrTune}} 5 | #' object. 6 | #' 7 | #' @param x a \code{\link[xnet:tskrrTune-class]{tskrrTune}} object or an 8 | #' object inheriting from \code{tskrrTune}. 9 | #' 10 | #' @return For \code{is_tuned}: a logical value indicating whether the 11 | #' model is tuned. 12 | #' 13 | #' @examples 14 | #' 15 | #' data(drugtarget) 16 | #' 17 | #' mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 18 | #' tuned <- tune(mod, ngrid = 10) 19 | #' 20 | #' is_tuned(mod) 21 | #' is_tuned(tuned) 22 | #' 23 | #' # Basic visualization of the grid. 24 | #' 25 | #' gridvals <- get_grid(tuned) 26 | #' z <- get_loss_values(tuned) 27 | #' 28 | #' \dontrun{ 29 | #' image(gridvals$k,gridvals$g,log(z), log = 'xy', 30 | #' xlab = "lambda k", ylab = "lambda g") 31 | #' } 32 | 33 | #' 34 | #' @include all_generics.R 35 | #' @rdname getters-tskrrTune 36 | #' @aliases is_tuned 37 | #' @export 38 | is_tuned <- function(x){ 39 | if(!inherits(x, "tskrr")) stop("x should be a tskrr model.") 40 | inherits(x, "tskrrTune") 41 | } 42 | 43 | #' @return For \code{get_grid} a list with the elements \code{k} and 44 | #' possibly \code{g}, each containing the different lambdas tried in 45 | #' the tuning for the row and column kernel matrices respectively. 46 | #' @rdname getters-tskrrTune 47 | #' @aliases get_grid 48 | #' @export 49 | get_grid <- function(x){ 50 | if(!inherits(x, "tskrrTune")) stop("x should be a tuned model.") 51 | x@lambda_grid 52 | } 53 | 54 | #' @return For \code{get_loss_values} a matrix with the calculated 55 | #' loss values. Note that each row represents the result for one 56 | #' lambda value related to the row kernel matrix K. For heterogeneous 57 | #' models, every column represents the result for one lambda related 58 | #' to the column kernel matrix G. 59 | #' @rdname getters-tskrrTune 60 | #' @aliases get_loss_values 61 | #' @export 62 | get_loss_values <- function(x){ 63 | if(!inherits(x, "tskrrTune")) stop("x should be a tuned model.") 64 | x@loss_values 65 | } 66 | 67 | #' @return for \code{is_onedim} a single logical value telling whether the 68 | #' grid search in the object was onedimensional. 69 | #' @rdname getters-tskrrTune 70 | #' @aliases has_onedim 71 | has_onedim <- function(x){ 72 | if(!inherits(x, "tskrrTune")) stop("x should be a tuned model.") 73 | x@onedim 74 | } 75 | -------------------------------------------------------------------------------- /man/plot_grid.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_grid.R 3 | \name{plot_grid} 4 | \alias{plot_grid} 5 | \title{Plot the grid of a tuned tskrr model} 6 | \usage{ 7 | plot_grid( 8 | x, 9 | addlambda = TRUE, 10 | lambdapars = list(col = "red"), 11 | log = TRUE, 12 | opts.contour = list(nlevels = 10), 13 | ... 14 | ) 15 | } 16 | \arguments{ 17 | \item{x}{an object that inherits from 18 | \code{\link[xnet:tskrrTune-class]{tskrrTune}}} 19 | 20 | \item{addlambda}{a logical value indicating whether the 21 | lambda with the minimum loss should be added to the plot. 22 | In case of a one dimensional plot, this adds a colored 23 | vertical line. In the case of a two dimensional plot, this 24 | adds a colored point at the minimum.} 25 | 26 | \item{lambdapars}{a list with named \code{\link{par}} values 27 | passed to the function \code{\link{abline}} or 28 | \code{\link{points}} for plotting the best lambda value when 29 | \code{addmin = TRUE}.} 30 | 31 | \item{log}{a logical value indicating whether the lambdas should be 32 | plotted at a log scale (the default) or not.} 33 | 34 | \item{opts.contour}{options passed to the function 35 | \code{\link{contour}} for 2D grid plots. Ignored for 1D 36 | grid plots.} 37 | 38 | \item{...}{arguments passed to other functions. For a one 39 | dimensional plot, this will be the function \code{\link{plot}}} 40 | } 41 | \value{ 42 | \code{NULL} invisibly 43 | } 44 | \description{ 45 | With this function, you can visualize the grid search for optimal 46 | lambdas from a \code{\link[xnet:tskrrTune-class]{tskrrTune}} object. 47 | In the case of two-dimensional grid search, this function plots a 48 | contour plot on a grid, based on the functions \code{\link{image}} 49 | and \code{\link{contour}}. For one-dimensional grid search, the function 50 | creates a single line plot. 51 | } 52 | \examples{ 53 | 54 | data(drugtarget) 55 | 56 | ## One dimensional tuning 57 | tuned1d <- tune(drugTargetInteraction, targetSim, drugSim, 58 | lim = c(1e-4,2), ngrid = 40, 59 | fun = loss_auc, onedim = TRUE) 60 | 61 | plot_grid(tuned1d) 62 | plot_grid(tuned1d, lambdapars = list(col = "green", 63 | lty = 1, lwd = 2), 64 | log = FALSE, las = 2, main = "1D tuning") 65 | 66 | ## Two dimensional tuning 67 | tuned2d <- tune(drugTargetInteraction, targetSim, drugSim, 68 | lim = c(1e-4,10), ngrid = 20, 69 | fun = loss_auc) 70 | 71 | plot_grid(tuned2d) 72 | 73 | } 74 | -------------------------------------------------------------------------------- /man/tskrr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tskrr.R 3 | \name{tskrr} 4 | \alias{tskrr} 5 | \title{Fitting a two step kernel ridge regression} 6 | \usage{ 7 | tskrr( 8 | y, 9 | k, 10 | g = NULL, 11 | lambda = 1e-04, 12 | testdim = TRUE, 13 | testlabels = TRUE, 14 | symmetry = c("auto", "symmetric", "skewed"), 15 | keep = FALSE 16 | ) 17 | } 18 | \arguments{ 19 | \item{y}{a label matrix} 20 | 21 | \item{k}{a kernel matrix for the rows} 22 | 23 | \item{g}{an optional kernel matrix for the columns} 24 | 25 | \item{lambda}{a numeric vector with one or two values for the 26 | hyperparameter lambda. If two values are given, the first one is 27 | used for the k matrix and the second for the g matrix.} 28 | 29 | \item{testdim}{a logical value indicating whether symmetry 30 | and the dimensions of the kernel(s) should be tested. 31 | Defaults to \code{TRUE}, but for large matrices 32 | putting this to \code{FALSE} will speed up the function.} 33 | 34 | \item{testlabels}{a logical value indicating wether the row- and column 35 | names of the matrices have to be checked for consistency. Defaults to 36 | \code{TRUE}, but for large matrices putting this to \code{FALSE} will 37 | speed up the function.} 38 | 39 | \item{symmetry}{a character value with the possibilities 40 | "auto", "symmetric" or "skewed". In case of a homogeneous fit, you 41 | can either specify whether the label matrix is symmetric or 42 | skewed, or you can let the function decide (option "auto").} 43 | 44 | \item{keep}{a logical value indicating whether the kernel hat 45 | matrices should be stored in the model object. Doing so makes the 46 | model object quite larger, but can speed up predictions in 47 | some cases. Defaults to \code{FALSE}.} 48 | } 49 | \value{ 50 | a \code{\link[xnet:tskrr-class]{tskrr}} object 51 | } 52 | \description{ 53 | \code{tskrr} is the primary function for fitting a two-step kernel 54 | ridge regression model. It can be used for both homogeneous and heterogeneous 55 | networks. 56 | } 57 | \examples{ 58 | 59 | # Heterogeneous network 60 | 61 | data(drugtarget) 62 | 63 | mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 64 | 65 | Y <- response(mod) 66 | pred <- fitted(mod) 67 | 68 | # Homogeneous network 69 | 70 | data(proteinInteraction) 71 | 72 | modh <- tskrr(proteinInteraction, Kmat_y2h_sc) 73 | 74 | Yh <- response(modh) 75 | pred <- fitted(modh) 76 | 77 | } 78 | \seealso{ 79 | \code{\link{response}}, \code{\link{fitted}}, 80 | \code{\link{get_eigen}}, \code{\link{eigen2hat}} 81 | } 82 | -------------------------------------------------------------------------------- /R/match_labels.R: -------------------------------------------------------------------------------- 1 | #' Reorder the label matrix 2 | #' 3 | #' Reorders the label matrix based on the labels of the kernel matrices. 4 | #' In case there are no labels, the original label matrix is returned, 5 | #' but with the labels in \code{rows} and \code{cols} as rownames and 6 | #' column names respectively. 7 | #' 8 | #' @param y a matrix representing the label matrix. 9 | #' @param rows a character vector with the labels for the rows or a matrix 10 | #' with rownames that will be used as labels. 11 | #' @param cols a character vector with the labels for the cols or a matrix 12 | #' with colnames that will be used as labels. If \code{NULL}, \code{rows} will be 13 | #' used for both row and column labels. 14 | #' 15 | #' @return a matrix with the rows and columns reordered. 16 | #' 17 | #' @examples 18 | #' mat <- matrix(1:6, ncol = 2, 19 | #' dimnames = list(c("b", "a", "d"), 20 | #' c("ca", "cb")) 21 | #' ) 22 | #' 23 | #' match_labels(mat, c("a","b", "d"), c("ca","cb")) 24 | #' 25 | #' #Using matrices 26 | #' data(drugtarget) 27 | #' out <- match_labels(drugTargetInteraction, targetSim, drugSim) 28 | #' 29 | #' @rdname match_labels 30 | #' @name match_labels 31 | #' @export 32 | match_labels <- function(y,rows,cols = NULL){ 33 | 34 | if(!is.matrix(y)) 35 | stop("y has to be a matrix") 36 | 37 | if(is.matrix(rows)){ 38 | rows <- rownames(rows) 39 | if(is.null(rows)) 40 | stop("There are no rownames for rows.") 41 | } else if(!is.character(rows)) { 42 | stop("rows should be a matrix with rownames or a character vector.") 43 | } 44 | 45 | if(is.null(cols)){ 46 | cols <- rows 47 | } else if(is.matrix(cols)){ 48 | cols <- colnames(cols) 49 | if(is.null(cols)) 50 | stop("There are no colnames for cols.") 51 | } else if(!is.character(cols)){ 52 | stop("cols should be a matrix with colnames or a character vector.") 53 | } 54 | 55 | nr <- length(rows) 56 | nc <- length(cols) 57 | 58 | if(nrow(y) != nr) 59 | stop("row labels not of the correct length.") 60 | if(ncol(y) != nc) 61 | stop("col labels not of the correct length.") 62 | 63 | if(is.null(dn <- dimnames(y))){ 64 | dimnames(y) <- list(rows,cols) 65 | return(y) 66 | } 67 | 68 | rmatch <- match(rows, dn[[1]], 0L) 69 | if(any(rmatch == 0L )) 70 | stop("row labels not compatible with rownames y") 71 | 72 | cmatch <- match(cols, dn[[2]], 0L) 73 | if(any(cmatch == 0L)) 74 | stop("col labels not compatible with colnames y") 75 | 76 | return(y[rmatch,cmatch]) 77 | } 78 | -------------------------------------------------------------------------------- /R/tskrr.fit.R: -------------------------------------------------------------------------------- 1 | #' Carry out a two-step kernel ridge regression 2 | #' 3 | #' This function provides an interface for two-step kernel ridge regression. 4 | #' To use this function, you need at least one kernel matrix and one 5 | #' label matrix. It's the internal engine used by the function 6 | #' \code{\link{tskrr}}. 7 | #' 8 | #' This function is mostly available for internal use. In most cases, it 9 | #' makes much more sense to use \code{\link{tskrr}}, as that function 10 | #' returns an object one can work with. The function 11 | #' \code{tskrr.fit} could be useful when doing simulations or 12 | #' fitting algorithms, as the information returned from this function 13 | #' is enough to use the functions returned by \code{\link{get_loo_fun}}. 14 | #' 15 | #' @param y a matrix representing the links between the nodes of both 16 | #' networks. 17 | #' @param k an object of class \code{\link{eigen}} containing the eigen 18 | #' decomposition of the first kernel matrix. 19 | #' @param g an optional object of class \code{\link{eigen}} containing 20 | #' the eigen decomposition of the second kernel matrix. If \code{NULL}, 21 | #' the network is considered to be homogeneous. 22 | #' @param lambda.k a numeric value for the lambda parameter tied 23 | #' to the first kernel. 24 | #' @param lambda.g a numeric value for the lambda parameter tied 25 | #' to the second kernel. If \code{NULL}, the model is fit using the same 26 | #' value for \code{lambda.k} and \code{lambda.g} 27 | #' @param ... arguments passed to other functions. Currently ignored. 28 | #' 29 | #' @return a list with three elements: 30 | #' \itemize{ 31 | #' \item k : the hat matrix for the rows 32 | #' \item g : the hat matrix for the columns (or \code{NULL}) 33 | #' for homogeneous networks. 34 | #' \item pred : the predictions 35 | #' } 36 | #' 37 | #' @examples 38 | #' 39 | #' data(drugtarget) 40 | #' 41 | #' K <- eigen(targetSim) 42 | #' G <- eigen(drugSim) 43 | #' 44 | #' res <- tskrr.fit(drugTargetInteraction,K,G, 45 | #' lambda.k = 0.01, lambda.g = 0.05) 46 | #' 47 | #' @export 48 | tskrr.fit <- function(y, k, g = NULL, lambda.k = NULL, lambda.g = NULL, 49 | ...){ 50 | 51 | # Set flags 52 | homogeneous <- is.null(g) 53 | 54 | # process input 55 | if(is.null(lambda.g)) lambda.g <- lambda.k 56 | 57 | # get hat matrics 58 | Hk <- eigen2hat(k$vectors, k$values, lambda.k) 59 | Hg <- if(!homogeneous) eigen2hat(g$vectors, g$values, lambda.g) else NULL 60 | 61 | # Create predictions 62 | pred <- if(!homogeneous) 63 | Hk %*% y %*% Hg 64 | else 65 | Hk %*% y %*% Hk 66 | 67 | return(list(k = Hk,g = Hg, pred = pred)) 68 | 69 | } 70 | -------------------------------------------------------------------------------- /man/labels.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/labels.R 3 | \name{labels.tskrr} 4 | \alias{labels.tskrr} 5 | \alias{labels,tskrr-method} 6 | \alias{dimnames,tskrr-method} 7 | \alias{dimnames.tskrr} 8 | \alias{rownames,tskrr-method} 9 | \alias{colnames,tskrr-method} 10 | \title{Extract labels from a tskrr object} 11 | \usage{ 12 | \method{labels}{tskrr}( 13 | object, 14 | prefix = if (is_homogeneous(object)) "row" else c("row", "col"), 15 | ... 16 | ) 17 | 18 | \S4method{labels}{tskrr}( 19 | object, 20 | prefix = if (is_homogeneous(object)) "row" else c("row", "col"), 21 | ... 22 | ) 23 | 24 | \S4method{dimnames}{tskrr}(x) 25 | 26 | \S4method{rownames}{tskrr}(x, do.NULL = TRUE, prefix = "row") 27 | 28 | \S4method{colnames}{tskrr}(x, do.NULL = TRUE, prefix = "col") 29 | } 30 | \arguments{ 31 | \item{object}{a \code{\link{tskrr}} object} 32 | 33 | \item{prefix}{a prefix used for construction of the labels in case 34 | none are available. For \code{label}, a character vector of length 1 for 35 | homogeneous networks or of length 2 for heterogeneous networks. 36 | In case two values are given, the first is used for the rows and the second 37 | for the columns. Otherwise the only value is used for both. In the case of 38 | \code{rownames} and \code{colnames}, a single value. 39 | See also \code{\link[=colnames]{row+colnames}}} 40 | 41 | \item{...}{arguments passed to/from other methods.} 42 | 43 | \item{x}{a \code{\link{tskrr}} object} 44 | 45 | \item{do.NULL}{logical. If \code{FALSE} and labels are \code{NULL}, 46 | labels are created. If \code{TRUE}, the function returns \code{NULL} in 47 | the absence of labels.} 48 | } 49 | \value{ 50 | for \code{labels} and \code{dimnames}: a list with two elements \code{k} and 51 | \code{g} 52 | } 53 | \description{ 54 | These functions allow you to extract the labels from a 55 | \code{\link{tskrr}} object. The function \code{labels} and the 56 | function \code{dimnames} are aliases and do the exact same 57 | thing. The functions \code{rownames} and \code{colnames} work like 58 | you would expect. Note that contrary to the latter two, \code{labels} 59 | will never return \code{NULL}. If no labels are found, it will construct 60 | labels using the prefixes defined in the argument \code{prefix}. 61 | } 62 | \section{Warning}{ 63 | 64 | If the original data didn't contain row- or column names for the 65 | label matrix, \code{rownames} and \code{colnames} will return 66 | \code{NULL}. Other functions will extract the automatically generated 67 | labels, so don't count on \code{rownames} and \code{colnames} if you 68 | want to predict output from other functions! 69 | } 70 | 71 | -------------------------------------------------------------------------------- /man/loss.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/all_generics.R, R/loss.R 3 | \name{loss} 4 | \alias{loss} 5 | \alias{loss,tskrr-method} 6 | \alias{loss,tskrrTune-method} 7 | \alias{loss,permtest-method} 8 | \title{Calculate or extract the loss of a tskrr model} 9 | \usage{ 10 | loss(x, ...) 11 | 12 | \S4method{loss}{tskrr}( 13 | x, 14 | fun = loss_mse, 15 | exclusion = c("interaction", "row", "column", "both"), 16 | replaceby0 = FALSE, 17 | predictions = FALSE, 18 | ... 19 | ) 20 | 21 | \S4method{loss}{tskrrTune}( 22 | x, 23 | fun = loss_mse, 24 | exclusion = c("interaction", "row", "column", "both"), 25 | replaceby0 = FALSE, 26 | predictions = FALSE, 27 | ... 28 | ) 29 | 30 | \S4method{loss}{permtest}(x, ...) 31 | } 32 | \arguments{ 33 | \item{x}{a model that inherits from class 34 | \code{\link[xnet:tskrr-class]{tskrr}}} 35 | 36 | \item{...}{extra arguments passed to the loss function in \code{fun}.} 37 | 38 | \item{fun}{a function to be used for calculating the loss. This 39 | can also be a character value giving the name of one of the loss 40 | functions provided in the package} 41 | 42 | \item{exclusion}{a character value with possible values "interaction", 43 | "row", "column" or "both". 44 | See also \code{\link{loo}} for more information.} 45 | 46 | \item{replaceby0}{a logical value indicating whether the interaction 47 | should be simply removed (\code{FALSE}) or replaced by 0 (\code{TRUE}).} 48 | 49 | \item{predictions}{a logical value to indicate whether the 50 | predictions should be used instead of leave one out crossvalidation. 51 | If set to \code{TRUE}, the other arguments are ignored.} 52 | } 53 | \value{ 54 | a numeric value with the calculated loss 55 | } 56 | \description{ 57 | This function allows calculating the loss of a tskrr model using 58 | either one of the functions defined in \code{\link{loss_functions}} 59 | or a custom user function. If the model inherits from class 60 | \code{\link[xnet:tskrrTune-class]{tskrrTune}} and no additional arguments 61 | are given, the loss is returned for the settings used when tuning. 62 | The function can also be used to extract the original loss from a 63 | \code{\link[xnet:permtest-class]{permtest}} object. 64 | } 65 | \examples{ 66 | data(drugtarget) 67 | 68 | mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 69 | 70 | loss(mod, fun = loss_auc) 71 | 72 | tuned <- tune(mod, fun = loss_auc) 73 | 74 | loss(tuned) 75 | loss(tuned, fun = loss_mse) 76 | 77 | } 78 | \seealso{ 79 | \itemize{ 80 | \item \code{\link{loss_functions}} for possible loss functions 81 | \item \code{\link{tune}} for tuning a model based on loss functions 82 | } 83 | } 84 | -------------------------------------------------------------------------------- /R/Class_tskrrHeterogeneous.R: -------------------------------------------------------------------------------- 1 | #' Class tskrrHeterogeneous 2 | #' 3 | #' The class tskrrHeterogeneous is a subclass of the superclass 4 | #' \code{\link[xnet:tskrr-class]{tskrr}} specifically for 5 | #' heterogeneous networks. 6 | #' 7 | #' @slot y the matrix with responses 8 | #' @slot k the eigen decomposition of the kernel matrix for the rows 9 | #' @slot lambda.k the lambda value used for k 10 | #' @slot pred the matrix with the predictions 11 | #' @slot g the eigen decomposition of the kernel matrix for the columns 12 | #' @slot lambda.g the lambda value used for g 13 | #' @slot has.hat a logical value indicating whether the kernel hat matrices 14 | #' are stored in the object. 15 | #' @slot Hk the kernel hat matrix for the rows. 16 | #' @slot Hg the kernel hat matrix for the columns. 17 | #' @slot labels a list with elements \code{k} and \code{g} (see 18 | #' \code{\link{tskrr-class}}). 19 | #' If any element is \code{NA}, the labels used 20 | #' are integers indicating the row resp column number. 21 | #' 22 | #' @include Class_tskrr.R 23 | #' @rdname tskrrHeterogeneous-class 24 | #' @name tskrrHeterogeneous-class 25 | #' @aliases tskrrHeterogeneous 26 | #' @exportClass tskrrHeterogeneous 27 | setClass("tskrrHeterogeneous", 28 | contains = "tskrr", 29 | slots = c(g = "eigen", 30 | lambda.g = "numeric", 31 | Hg = "matrix"), 32 | prototype = list(lambda.g = 1e-4, 33 | g = structure(list(vectors = matrix(0), 34 | values = numeric(1)), 35 | class = "eigen"), 36 | Hg = matrix(0) 37 | ) 38 | ) 39 | 40 | validTskrrHeterogeneous <- function(object){ 41 | 42 | if(length(object@lambda.g) != 1) 43 | return("lambda.g should be a single value") 44 | 45 | else if(object@has.hat && !valid_dimensions(object@y, object@Hk, object@Hg)) 46 | return("The dimensions of the original kernel matrices and the observations don't match.") 47 | 48 | else if( 49 | (length(object@labels$k) == 1 && !is.na(object@labels$k)) && 50 | (length(object@labels$k) != nrow(object@y)) 51 | ) 52 | return("The labels element k should either be NA or a character vector with the same number of values as there are rows in the Y matrix.") 53 | 54 | else if( 55 | (length(object@labels$g) == 1 && !is.na(object@labels$g)) && 56 | (length(object@labels$g) != ncol(object@y)) 57 | ) 58 | return("The labels element g should either be NA or a character vector with the same number of values as there are columns in the Y matrix.") 59 | 60 | else 61 | return(TRUE) 62 | } 63 | 64 | setValidity("tskrrHeterogeneous", validTskrrHeterogeneous) 65 | -------------------------------------------------------------------------------- /man/impute_tskrr.fit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/impute_tskrr.fit.R 3 | \name{impute_tskrr.fit} 4 | \alias{impute_tskrr.fit} 5 | \title{Impute values based on a two-step kernel ridge regression} 6 | \usage{ 7 | impute_tskrr.fit(y, Hk, Hg, naid = NULL, niter, tol, start, verbose) 8 | } 9 | \arguments{ 10 | \item{y}{a label matrix} 11 | 12 | \item{Hk}{a hat matrix for the rows (see also \code{\link{eigen2hat}} 13 | on how to calculate them from an eigen decomposition)} 14 | 15 | \item{Hg}{a hat matrix for the columns. For homogeneous networks, this 16 | should be Hk again.} 17 | 18 | \item{naid}{an optional index with the values that have to be imputed, 19 | i.e. at which positions you find a \code{NA} value. It can be a vector 20 | with integers or a matrix with \code{TRUE}/\code{FALSE} values.} 21 | 22 | \item{niter}{an integer giving the maximum number of iterations} 23 | 24 | \item{tol}{a numeric value indicating the tolerance for convergence of 25 | the algorithm. It is the maximum sum of squared differences between 26 | to iteration steps.} 27 | 28 | \item{start}{a numeric value indicating the value with which NA's are 29 | replaced in the first step of the algorithm. Defaults to 0.} 30 | 31 | \item{verbose}{either a logical value, 1 or 2. \code{1} means "show the number 32 | of iterations and the final deviation", \code{2} means "show the deviation 33 | every 10 iterations". A value \code{TRUE} is read as \code{1}.} 34 | } 35 | \value{ 36 | a list with two elements: 37 | \itemize{ 38 | \item a matrix \code{y} with the imputed values filled in. 39 | \item a numeric value \code{niter} with the amount of iterations 40 | } 41 | } 42 | \description{ 43 | This function provides an interface for the imputation of values 44 | based on a \code{\link{tskrr}} model and is the internal function 45 | used by \code{\link{impute_tskrr}}. 46 | } 47 | \details{ 48 | This function is mostly available for internal use. In most cases, 49 | it makes much more sense to use \code{\link{impute_tskrr}}, as that 50 | function returns an object one can work with. The function 51 | \code{impute_tskrr.fit} could be useful when doing simulations or 52 | creating fitting algorithms. 53 | } 54 | \examples{ 55 | 56 | data(drugtarget) 57 | 58 | K <- eigen(targetSim) 59 | G <- eigen(drugSim) 60 | 61 | Hk <- eigen2hat(K$vectors, K$values, lambda = 0.01) 62 | Hg <- eigen2hat(G$vectors, G$values, lambda = 0.05) 63 | 64 | drugTargetInteraction[c(3,17,123)] <- NA 65 | 66 | res <- impute_tskrr.fit(drugTargetInteraction, Hk, Hg, 67 | niter = 1000, tol = 10e-10, 68 | start = 0, verbose = FALSE) 69 | 70 | } 71 | \seealso{ 72 | \itemize{ 73 | \item \code{\link{impute_tskrr}} for the user-level function, and 74 | \item \code{\link{eigen2hat}} for conversion of a eigen decomposition to 75 | a hat matrix. 76 | } 77 | } 78 | -------------------------------------------------------------------------------- /man/getters-tskrr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getters_tskrr.R 3 | \name{response,tskrr-method} 4 | \alias{response,tskrr-method} 5 | \alias{response} 6 | \alias{lambda,tskrrHomogeneous-method} 7 | \alias{lambda,tskrrHeterogeneous-method} 8 | \alias{lambda} 9 | \alias{is_tskrr} 10 | \alias{is_homogeneous} 11 | \alias{is_heterogeneous} 12 | \alias{symmetry} 13 | \alias{get_eigen} 14 | \alias{get_kernelmatrix} 15 | \alias{has_hat} 16 | \alias{get_kernel} 17 | \title{Getters for tskrr objects} 18 | \usage{ 19 | \S4method{response}{tskrr}(x, ...) 20 | 21 | \S4method{lambda}{tskrrHomogeneous}(x) 22 | 23 | \S4method{lambda}{tskrrHeterogeneous}(x) 24 | 25 | is_tskrr(x) 26 | 27 | is_homogeneous(x) 28 | 29 | is_heterogeneous(x) 30 | 31 | symmetry(x) 32 | 33 | get_eigen(x, which = c("row", "column")) 34 | 35 | get_kernelmatrix(x, which = c("row", "column")) 36 | 37 | has_hat(x) 38 | 39 | get_kernel(x, which = c("row", "column")) 40 | } 41 | \arguments{ 42 | \item{x}{a \code{\link[xnet:tskrr-class]{tskrr}} object or an 43 | object inheriting from \code{tskrr}.} 44 | 45 | \item{...}{arguments passed to other methods.} 46 | 47 | \item{which}{a character value indicating whether the eigen decomposition 48 | for the row kernel matrix or the column kernel matrix should be returned.} 49 | } 50 | \value{ 51 | For \code{response}: the original label matrix 52 | 53 | For \code{lambda}: a named numeric vector with one resp both lambda 54 | values used in the model. The names are "k" and "g" respectively. 55 | 56 | For \code{is_tskrr} a logical value indicating whether the 57 | object is a \code{tskrr} object 58 | 59 | For \code{is_homogeneous} a logical value indicating whether the 60 | tskrr model is a homogeneous one. 61 | 62 | For \code{is_heterogeneous} a logical value indicating whether the 63 | tskrr model is a heterogeneous one. 64 | 65 | For \code{symmetry} a character value indicating the symmetry 66 | for a \code{\link[xnet:tskrrHomogeneous-class]{homogeneous model}}. If 67 | the model is not homogeneous, \code{NA} is returned. 68 | 69 | For \code{get_eigen} the eigen decomposition of the requested 70 | kernel matrix. 71 | 72 | For \code{get_kernelmatrix} the original kernel matrix 73 | for the rows or columns. 74 | 75 | For \code{has_hat} a logical value indicating whether 76 | the tskrr model contains the kernel hat matrices. 77 | } 78 | \description{ 79 | The functions described here are convenience functions to get 80 | information out of a \code{\link[xnet:tskrr-class]{tskrr}} object. 81 | } 82 | \section{Warning}{ 83 | The function \code{get_kernel} is deprecated. 84 | Use \code{get_kernelmatrix} instead. 85 | } 86 | 87 | \examples{ 88 | data(drugtarget) 89 | 90 | mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 91 | is_homogeneous(mod) 92 | 93 | EigR <- get_eigen(mod) 94 | EigC <- get_eigen(mod, which = 'column') 95 | lambda(mod) 96 | 97 | } 98 | -------------------------------------------------------------------------------- /pre-commit: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env Rscript 2 | 3 | # License: CC0 (just be nice and point others to where you got this) 4 | # Author: Robert M Flight , github.com/rmflight 5 | # 6 | # This is a pre-commit hook that checks that there are files to be committed, and if there are, increments the package version 7 | # in the DESCRIPTION file. 8 | # 9 | # To install it, simply copy this into the ".git/hooks/pre-commit" file of your git repo, change /path/2/Rscript, and make it 10 | # executable. Note that /path/2/Rscript is the same as your /path/2/R/bin/R, or may be in /usr/bin/Rscript depending on your 11 | # installation. This has been tested on both Linux and Windows installations. 12 | # 13 | # In instances where you do NOT want the version incremented, add the environment variable doIncrement=FALSE to your git call. 14 | # eg "doIncrement=FALSE git commit -m "commit message"". 15 | # This is useful when you change the major version number for example. 16 | 17 | doIncrement <- TRUE # default 18 | 19 | # get the environment variable and modify if necessary 20 | tmpEnv <- as.logical(Sys.getenv("doIncrement")) 21 | if (!is.na(tmpEnv)){ 22 | doIncrement <- tmpEnv 23 | } 24 | 25 | # check that there are files that will be committed, don't want to increment version if there won't be a commit 26 | fileDiff <- system("git diff HEAD --name-only", intern=TRUE) 27 | 28 | DESC <- grep("DESCRIPTION",list.files(".", recursive = TRUE),value = TRUE) 29 | 30 | 31 | if (length(DESC) && DESC %in% fileDiff) { 32 | # Don't want to overwrite manual version bump 33 | desc_diff <- system(paste("git diff HEAD", DESC), intern = TRUE) 34 | doIncrement <- !any(grepl("\\+Version", desc_diff)) 35 | staged_files <- system("git diff HEAD --name-only --staged", intern = TRUE) 36 | desc_staged <- DESC %in% staged_files 37 | if (!desc_staged) { 38 | if (doIncrement) cat("DESCRIPTION had additional changes that were committed.\n") 39 | else cat("DESCRIPTION contains manual version bump but was not staged, so it was not committed.\n") 40 | } else if(!doIncrement){ 41 | cat("Manual version set, so no bumping is done.\n") 42 | } 43 | } 44 | 45 | if ((length(fileDiff) > 0) && length(DESC) && doIncrement){ 46 | 47 | currDCF <- read.dcf(DESC) 48 | currVersion <- currDCF[1,"Version"] 49 | splitVersion <- strsplit(currVersion, "-", fixed=TRUE)[[1]] 50 | nVer <- length(splitVersion) 51 | if(nVer < 2){ 52 | cat("No devel version (needs -). Version not updated.\n") 53 | } else { 54 | currEndVersion <- as.integer(trimws(splitVersion[nVer])) 55 | newEndVersion <- as.character(currEndVersion + 1) 56 | if(!is.na(currEndVersion)) splitVersion[nVer] <- newEndVersion 57 | newVersion <- paste(splitVersion, collapse="-") 58 | currDCF[1,"Version"] <- newVersion 59 | currDCF[1, "Date"] <- strftime(as.POSIXlt(Sys.Date()), "%Y-%m-%d") 60 | write.dcf(currDCF, DESC) 61 | system(paste("git add", DESC)) 62 | cat("Incremented package version and added to commit!\n") 63 | } 64 | 65 | } -------------------------------------------------------------------------------- /R/impute_tskrr.fit.R: -------------------------------------------------------------------------------- 1 | #' Impute values based on a two-step kernel ridge regression 2 | #' 3 | #' This function provides an interface for the imputation of values 4 | #' based on a \code{\link{tskrr}} model and is the internal function 5 | #' used by \code{\link{impute_tskrr}}. 6 | #' 7 | #' This function is mostly available for internal use. In most cases, 8 | #' it makes much more sense to use \code{\link{impute_tskrr}}, as that 9 | #' function returns an object one can work with. The function 10 | #' \code{impute_tskrr.fit} could be useful when doing simulations or 11 | #' creating fitting algorithms. 12 | #' 13 | #' @param y a label matrix 14 | #' @param Hk a hat matrix for the rows (see also \code{\link{eigen2hat}} 15 | #' on how to calculate them from an eigen decomposition) 16 | #' @param Hg a hat matrix for the columns. For homogeneous networks, this 17 | #' should be Hk again. 18 | #' @param naid an optional index with the values that have to be imputed, 19 | #' i.e. at which positions you find a \code{NA} value. It can be a vector 20 | #' with integers or a matrix with \code{TRUE}/\code{FALSE} values. 21 | #' @inheritParams impute_tskrr 22 | #' 23 | #' @return a list with two elements: 24 | #' * a matrix \code{y} with the imputed values filled in. 25 | #' * a numeric value \code{niter} with the amount of iterations 26 | #' 27 | #' @seealso 28 | #' * \code{\link{impute_tskrr}} for the user-level function, and 29 | #' * \code{\link{eigen2hat}} for conversion of a eigen decomposition to 30 | #' a hat matrix. 31 | #' @md 32 | #' 33 | #' @examples 34 | #' 35 | #' data(drugtarget) 36 | #' 37 | #' K <- eigen(targetSim) 38 | #' G <- eigen(drugSim) 39 | #' 40 | #' Hk <- eigen2hat(K$vectors, K$values, lambda = 0.01) 41 | #' Hg <- eigen2hat(G$vectors, G$values, lambda = 0.05) 42 | #' 43 | #' drugTargetInteraction[c(3,17,123)] <- NA 44 | #' 45 | #' res <- impute_tskrr.fit(drugTargetInteraction, Hk, Hg, 46 | #' niter = 1000, tol = 10e-10, 47 | #' start = 0, verbose = FALSE) 48 | #' 49 | #' @export 50 | impute_tskrr.fit <- function(y,Hk,Hg,naid = NULL, 51 | niter,tol, start, verbose){ 52 | 53 | if(is.null(naid)) naid <- is.na(y) 54 | if(!any(naid)){ 55 | warning("The matrix didn't contain missing values") 56 | return(list(y = y, 57 | niter = 0L)) 58 | } 59 | 60 | # Replace values 61 | y[naid] <- start 62 | prev <- y[naid] 63 | div <- TRUE 64 | # Loop 65 | iter <- 0 66 | showsteps <- verbose > 1 67 | showres <- verbose > 0 68 | while(iter < niter && div > tol){ 69 | 70 | iter <- iter + 1 71 | 72 | pred <- Hk %*% y %*% Hg 73 | y[naid] <- pred[naid] 74 | 75 | div <- sum((prev - y[naid])^2) 76 | if(showsteps){ 77 | if(iter %% 10 == 0) message("iteration: ",iter," - Deviation: ",div,"\n") 78 | } 79 | prev <- y[naid] 80 | 81 | } 82 | if(showres){ 83 | message("Nr. of iterations: ", iter, " - Deviation:",div,"\n") 84 | } 85 | return(list(y = y, 86 | niter = iter)) 87 | } 88 | -------------------------------------------------------------------------------- /R/as_tuned.R: -------------------------------------------------------------------------------- 1 | #' convert tskrr models 2 | #' 3 | #' These functions allow converting models that inherit from the 4 | #' \code{\link[xnet:tskrr-class]{tskrr}} and 5 | #' \code{\link[xnet:tskrrTune-class]{tskrrTune}} class into each other, 6 | #' keeping track of whether the model is homogeneous or heterogeneous. 7 | #' The dots argument allows specifying values for possible extra slots 8 | #' when converting from \code{tskrr} to \code{tskrrTune}. 9 | #' More information on these slots can be found 10 | #' on the help page of \code{\link[xnet:tskrrTune-class]{tskrrTune}}. 11 | #' **These functions are not exported.** 12 | #' 13 | #' @section \bold{Warning}: 14 | #' This functions do NOT tune a model. they are used internally to 15 | #' make the connection between both types in the methods. 16 | #' 17 | #' @seealso 18 | #' * \code{\link{tune}} for actually tuning a model. 19 | #' * \code{\link[xnet:tskrrTune-class]{tskrrTune}} for 20 | #' names and possible values of the slots passed through 21 | #' \dots 22 | #' @md 23 | #' 24 | #' @param x a model of class \code{\link[xnet:tskrr-class]{tskrr}} 25 | #' @param ... values for the extra slots defined by 26 | #' the class \code{\link[xnet:tskrrTune-class]{tskrrTune}} 27 | #' 28 | #' @return For \code{as_tuned}: 29 | #' a \code{\link[xnet:tskrrTune-class]{tskrrTune}} object of 30 | #' the proper class (homogeneous or heterogeneous) 31 | #' 32 | #' @include all_generics.R 33 | #' @rdname as_tuned 34 | #' @method as_tuned tskrrHomogeneous 35 | setMethod("as_tuned", 36 | "tskrrHomogeneous", 37 | function(x, ...){ 38 | 39 | x <- as(x, "tskrrTuneHomogeneous") 40 | initialize(x, ...) 41 | }) 42 | 43 | #' @rdname as_tuned 44 | #' @method as_tuned tskrrHeterogeneous 45 | setMethod("as_tuned", 46 | "tskrrHeterogeneous", 47 | function(x, ...){ 48 | 49 | x <- as(x, "tskrrTuneHeterogeneous") 50 | initialize(x, ...) 51 | }) 52 | 53 | #' @rdname as_tuned 54 | #' @return For \code{as_tskrr}: an object of class 55 | #' \code{\link[xnet:tskrrHomogeneous-class]{tskrrHomogeneous}} or 56 | #' \code{\link[xnet:tskrrHeterogeneous-class]{tskrrHeterogeneous}} depending 57 | #' on whether the original object was homogeneous or heterogeneous. 58 | #' 59 | #' @method as_tskrr tskrrTune 60 | setMethod("as_tskrr", 61 | "tskrrTune", 62 | function(x){ 63 | if(is_homogeneous(x)) 64 | as(x, "tskrrHomogeneous") 65 | else 66 | as(x, "tskrrHeterogeneous") 67 | }) 68 | 69 | #' @rdname as_tuned 70 | #' @method as_tskrr tskrrImpute 71 | setMethod("as_tskrr", 72 | "tskrrImpute", 73 | function(x){ 74 | if(is_homogeneous(x)) 75 | as(x, "tskrrHomogeneous") 76 | else 77 | as(x, "tskrrHeterogeneous") 78 | }) 79 | 80 | #' @rdname as_tuned 81 | #' @method as_tskrr tskrr 82 | setMethod("as_tskrr", 83 | "tskrr", 84 | function(x){ 85 | return(x) 86 | }) 87 | -------------------------------------------------------------------------------- /man/loo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/all_generics.R, R/loo.R 3 | \name{loo} 4 | \alias{loo} 5 | \alias{loo,tskrrHeterogeneous-method} 6 | \alias{loo,tskrrHomogeneous-method} 7 | \alias{loo,linearFilter-method} 8 | \title{Leave-one-out cross-validation for tskrr} 9 | \usage{ 10 | loo(x, ...) 11 | 12 | \S4method{loo}{tskrrHeterogeneous}( 13 | x, 14 | exclusion = c("interaction", "row", "column", "both"), 15 | replaceby0 = FALSE 16 | ) 17 | 18 | \S4method{loo}{tskrrHomogeneous}( 19 | x, 20 | exclusion = c("edges", "vertices", "interaction", "both"), 21 | replaceby0 = FALSE 22 | ) 23 | 24 | \S4method{loo}{linearFilter}(x, replaceby0 = FALSE) 25 | } 26 | \arguments{ 27 | \item{x}{an object of class \code{\link[xnet:tskrr-class]{tskrr}} or 28 | \code{\link{linearFilter}}.} 29 | 30 | \item{...}{arguments passed to methods. 31 | See Details.} 32 | 33 | \item{exclusion}{a character value with possible values "interaction", 34 | "row", "column", "both" for heterogeneous models, and "edges", "vertices", 35 | "interaction" or "both" for homogeneous models. 36 | Defaults to "interaction". See details.} 37 | 38 | \item{replaceby0}{a logical value indicating whether the interaction 39 | should be simply removed (\code{FALSE}) or replaced by 0 (\code{TRUE}).} 40 | } 41 | \value{ 42 | a numeric matrix with the leave-one-out predictions for 43 | the model. 44 | } 45 | \description{ 46 | Perform a leave-one-out cross-validation for two-step kernel 47 | ridge regression based on the shortcuts described in Stock et al, 2018. 48 | (\url{http://doi.org/10.1093/bib/bby095}). 49 | } 50 | \details{ 51 | The parameter \code{exclusion} defines what is left out. 52 | The value "interaction" means that a single interaction is removed. 53 | In the case of a homogeneous model, this can be interpreted as the 54 | removal of the interaction between two edges. The values "row" and 55 | "column" mean that all interactions for a row edge resp. a column 56 | edge are removed. The value "both" removes all interactions for 57 | a row and a column edge. 58 | 59 | In the case of a homogeneous model, "row" and "column" don't make sense 60 | and will be replaced by "both" with a warning. This can be interpreted 61 | as removing vertices, i.e. all interactions between one edge and 62 | all other edges. Alternatively one can use "edges" to remove edges and 63 | "vertices" to remove vertices. In the case of a homogeneous model, 64 | the setting "edges" translates to "interaction", and "vertices" 65 | translates to "both". For more information, see Stock et al. (2018). 66 | 67 | Replacing by 0 only makes sense when \code{exclusion = "interaction"} and the 68 | label matrix contains only 0 and 1 values. The function checks whether 69 | the conditions are fulfilled and if not, returns an error. 70 | } 71 | \examples{ 72 | data(drugtarget) 73 | 74 | mod <- tskrr(drugTargetInteraction, targetSim, drugSim, 75 | lambda = c(0.01,0.01)) 76 | 77 | delta <- loo(mod, exclusion = 'both') - response(mod) 78 | delta0 <- loo(mod, replaceby0 = TRUE) - response(mod) 79 | 80 | } 81 | -------------------------------------------------------------------------------- /man/residuals.tskrr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/all_generics.R, R/residuals.R 3 | \name{residuals} 4 | \alias{residuals} 5 | \alias{residuals.tskrr} 6 | \alias{residuals,tskrr-method} 7 | \title{calculate residuals from a tskrr model} 8 | \usage{ 9 | residuals(object, ...) 10 | 11 | \method{residuals}{tskrr}( 12 | object, 13 | method = c("predictions", "loo"), 14 | exclusion = c("interaction", "row", "column", "both"), 15 | replaceby0 = FALSE, 16 | ... 17 | ) 18 | 19 | \S4method{residuals}{tskrr}( 20 | object, 21 | method = c("predictions", "loo"), 22 | exclusion = c("interaction", "row", "column", "both"), 23 | replaceby0 = FALSE, 24 | ... 25 | ) 26 | } 27 | \arguments{ 28 | \item{object}{a tskrr model} 29 | 30 | \item{...}{arguments passed from/to other methods.} 31 | 32 | \item{method}{a character value indicating whether the 33 | residuals should be based on the predictions or on a 34 | leave-one-out crossvalidation.} 35 | 36 | \item{exclusion}{a character value with possible values "interaction", 37 | "row", "column", "both" for heterogeneous models, and "edges", "vertices", 38 | "interaction" or "both" for homogeneous models. 39 | Defaults to "interaction". See details.} 40 | 41 | \item{replaceby0}{a logical value indicating whether the interaction 42 | should be simply removed (\code{FALSE}) or replaced by 0 (\code{TRUE}).} 43 | } 44 | \value{ 45 | a matrix(!) with the requested residuals 46 | } 47 | \description{ 48 | This function returns the residuals for 49 | an object inheriting from class \code{\link[xnet:tskrr-class]{tskrr}} 50 | } 51 | \details{ 52 | The parameter \code{exclusion} defines what is left out. 53 | The value "interaction" means that a single interaction is removed. 54 | In the case of a homogeneous model, this can be interpreted as the 55 | removal of the interaction between two edges. The values "row" and 56 | "column" mean that all interactions for a row edge resp. a column 57 | edge are removed. The value "both" removes all interactions for 58 | a row and a column edge. 59 | 60 | In the case of a homogeneous model, "row" and "column" don't make sense 61 | and will be replaced by "both" with a warning. This can be interpreted 62 | as removing vertices, i.e. all interactions between one edge and 63 | all other edges. Alternatively one can use "edges" to remove edges and 64 | "vertices" to remove vertices. In the case of a homogeneous model, 65 | the setting "edges" translates to "interaction", and "vertices" 66 | translates to "both". For more information, see Stock et al. (2018). 67 | 68 | Replacing by 0 only makes sense when \code{exclusion = "interaction"} and the 69 | label matrix contains only 0 and 1 values. The function checks whether 70 | the conditions are fulfilled and if not, returns an error. 71 | } 72 | \examples{ 73 | 74 | data(drugtarget) 75 | mod <- tskrr(drugTargetInteraction, targetSim, drugSim, 76 | lambda = c(0.01,0.01)) 77 | delta <- response(mod) - loo(mod, exclusion = "both") 78 | resid <- residuals(mod, method = "loo", exclusion = "both") 79 | all.equal(delta, resid) 80 | 81 | } 82 | -------------------------------------------------------------------------------- /R/linear_filter.R: -------------------------------------------------------------------------------- 1 | #' Fit a linear filter over a label matrix 2 | #' 3 | #' This function fits a linear filter over a label matrix. It calculates 4 | #' the row, column and total means, and uses those to construct the linear 5 | #' filter. 6 | #' 7 | #' If there are missing values and they are removed before calculating the 8 | #' means, a warning is issued. If \code{na.rm = FALSE} and there are 9 | #' missing values present, the outcome is, by definition, a matrix filled 10 | #' with NA values. 11 | #' 12 | #' 13 | #' 14 | #' @param y a label matrix 15 | #' @param alpha a vector with 4 alpha values, or a single alpha value 16 | #' which then is used for all 4 alphas. 17 | #' @param na.rm a logical value indicating whether missing values should 18 | #' be removed before calculating the row-, column- and total means. 19 | #' 20 | #' @return an object of class \code{\link[=linearFilter-class]{linearFilter}} 21 | #' 22 | #' @examples 23 | #' data(drugtarget) 24 | #' linear_filter(drugTargetInteraction, alpha = 0.25) 25 | #' linear_filter(drugTargetInteraction, alpha = c(0.1,0.1,0.4,0.4)) 26 | #' 27 | #' @export 28 | linear_filter <- function(y, alpha=0.25, na.rm = FALSE){ 29 | 30 | stopifnot(is.matrix(y), 31 | is.numeric(alpha), 32 | is.atomic(alpha)) 33 | 34 | if(length(alpha) == 1) 35 | alpha <- rep(alpha,4) 36 | else if(length(alpha) !=4) 37 | stop("alpha should be a numeric vector with either 1 or 4 values.") 38 | 39 | # Needed to avoid floating point errors when long double disabled 40 | # Per check by BDR using R configured with --disable-long-double 41 | if(abs(sum(alpha) - 1) > .Machine$double.eps^0.5 || 42 | any(alpha > 1) || any(alpha < 0) ) 43 | stop("alpha values should be numbers between 0 and 1 and add up to 1.") 44 | 45 | cm <- colMeans(y, na.rm = na.rm) 46 | rm <- rowMeans(y, na.rm = na.rm) 47 | m <- mean(y, na.rm = na.rm) 48 | nc <- ncol(y) 49 | nr <- nrow(y) 50 | 51 | if(any(is.na(y))){ 52 | if(na.rm){ 53 | warning("NAs removed before fitting the linear filter.") 54 | } else { 55 | # Return the empty matrix for now. 56 | res <- new("linearFilter", 57 | y = y, 58 | alpha = alpha, 59 | pred = matrix(NA_real_, 60 | nrow = nrow(y),ncol = ncol(y)), 61 | mean = NA_real_, 62 | colmeans = cm, 63 | rowmeans = rm, 64 | na.rm = na.rm) 65 | } 66 | 67 | } 68 | 69 | pred <- .linear_filter(y,alpha,cm,rm,m,nr,nc) 70 | 71 | 72 | # simple matrix filter 73 | new("linearFilter", 74 | y = y, 75 | alpha = alpha, 76 | pred = pred, 77 | mean = m, 78 | colmeans = cm, 79 | rowmeans = rm, 80 | na.rm = na.rm) 81 | } 82 | 83 | # Function .linear_filter allows for optimization algorithms. 84 | # Input: cm is column mean, rm is row mean, m is global mean, nc is 85 | # number of columns 86 | .linear_filter <- function(y, alpha, cm, rm, m, nr, nc){ 87 | alpha[1]*y + rep(alpha[2]*cm, each = nr) + 88 | rep(alpha[3]*rm, times = nc) + alpha[4] * m 89 | } 90 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(fitted,linearFilter) 4 | S3method(fitted,tskrr) 5 | S3method(labels,tskrr) 6 | S3method(mean,linearFilter) 7 | S3method(plot,tskrr) 8 | S3method(predict,tskrr) 9 | S3method(print,permtest) 10 | S3method(residuals,tskrr) 11 | export(alpha) 12 | export(create_grid) 13 | export(eigen2hat) 14 | export(eigen2map) 15 | export(eigen2matrix) 16 | export(get_eigen) 17 | export(get_grid) 18 | export(get_kernel) 19 | export(get_kernelmatrix) 20 | export(get_loo_fun) 21 | export(get_loss_values) 22 | export(has_imputed_values) 23 | export(impute_tskrr) 24 | export(impute_tskrr.fit) 25 | export(is_heterogeneous) 26 | export(is_homogeneous) 27 | export(is_imputed) 28 | export(is_symmetric) 29 | export(is_tuned) 30 | export(linear_filter) 31 | export(loo) 32 | export(loss) 33 | export(loss_auc) 34 | export(loss_mse) 35 | export(match_labels) 36 | export(na_removed) 37 | export(permtest) 38 | export(permutations) 39 | export(plot_grid) 40 | export(residuals) 41 | export(symmetry) 42 | export(test_symmetry) 43 | export(tskrr) 44 | export(tskrr.fit) 45 | export(update) 46 | export(valid_dimensions) 47 | export(which_imputed) 48 | exportClasses(permtest) 49 | exportClasses(tskrr) 50 | exportClasses(tskrrHeterogeneous) 51 | exportClasses(tskrrHomogeneous) 52 | exportClasses(tskrrImpute) 53 | exportClasses(tskrrImputeHeterogeneous) 54 | exportClasses(tskrrImputeHomogeneous) 55 | exportClasses(tskrrTune) 56 | exportClasses(tskrrTuneHeterogeneous) 57 | exportClasses(tskrrTuneHomogeneous) 58 | exportMethods("[") 59 | exportMethods(alpha) 60 | exportMethods(colMeans) 61 | exportMethods(colnames) 62 | exportMethods(dim) 63 | exportMethods(dimnames) 64 | exportMethods(fitted) 65 | exportMethods(get_loo_fun) 66 | exportMethods(hat) 67 | exportMethods(labels) 68 | exportMethods(lambda) 69 | exportMethods(loo) 70 | exportMethods(loss) 71 | exportMethods(mean) 72 | exportMethods(na_removed) 73 | exportMethods(permtest) 74 | exportMethods(predict) 75 | exportMethods(residuals) 76 | exportMethods(response) 77 | exportMethods(rowMeans) 78 | exportMethods(rownames) 79 | exportMethods(tune) 80 | exportMethods(update) 81 | exportMethods(weights) 82 | import(methods) 83 | importFrom(grDevices,dev.flush) 84 | importFrom(grDevices,dev.hold) 85 | importFrom(grDevices,heat.colors) 86 | importFrom(graphics,abline) 87 | importFrom(graphics,axis) 88 | importFrom(graphics,box) 89 | importFrom(graphics,contour) 90 | importFrom(graphics,frame) 91 | importFrom(graphics,image) 92 | importFrom(graphics,layout) 93 | importFrom(graphics,mtext) 94 | importFrom(graphics,par) 95 | importFrom(graphics,plot) 96 | importFrom(graphics,plot.new) 97 | importFrom(graphics,plot.window) 98 | importFrom(graphics,points) 99 | importFrom(graphics,rect) 100 | importFrom(graphics,title) 101 | importFrom(stats,as.dendrogram) 102 | importFrom(stats,as.dist) 103 | importFrom(stats,hclust) 104 | importFrom(stats,order.dendrogram) 105 | importFrom(stats,pnorm) 106 | importFrom(stats,printCoefmat) 107 | importFrom(stats,sd) 108 | importFrom(utils,str) 109 | -------------------------------------------------------------------------------- /man/impute_tskrr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/impute_tskrr.R 3 | \name{impute_tskrr} 4 | \alias{impute_tskrr} 5 | \title{Impute missing values in a label matrix} 6 | \usage{ 7 | impute_tskrr( 8 | y, 9 | k, 10 | g = NULL, 11 | lambda = 0.01, 12 | testdim = TRUE, 13 | testlabels = TRUE, 14 | symmetry = c("auto", "symmetric", "skewed"), 15 | keep = FALSE, 16 | niter = 10000, 17 | tol = sqrt(.Machine$double.eps), 18 | start = mean(y, na.rm = TRUE), 19 | verbose = FALSE 20 | ) 21 | } 22 | \arguments{ 23 | \item{y}{a label matrix} 24 | 25 | \item{k}{a kernel matrix for the rows} 26 | 27 | \item{g}{an optional kernel matrix for the columns} 28 | 29 | \item{lambda}{a numeric vector with one or two values for the 30 | hyperparameter lambda. If two values are given, the first one is 31 | used for the k matrix and the second for the g matrix.} 32 | 33 | \item{testdim}{a logical value indicating whether symmetry 34 | and the dimensions of the kernel(s) should be tested. 35 | Defaults to \code{TRUE}, but for large matrices 36 | putting this to \code{FALSE} will speed up the function.} 37 | 38 | \item{testlabels}{a logical value indicating wether the row- and column 39 | names of the matrices have to be checked for consistency. Defaults to 40 | \code{TRUE}, but for large matrices putting this to \code{FALSE} will 41 | speed up the function.} 42 | 43 | \item{symmetry}{a character value with the possibilities 44 | "auto", "symmetric" or "skewed". In case of a homogeneous fit, you 45 | can either specify whether the label matrix is symmetric or 46 | skewed, or you can let the function decide (option "auto").} 47 | 48 | \item{keep}{a logical value indicating whether the kernel hat 49 | matrices should be stored in the model object. Doing so makes the 50 | model object quite larger, but can speed up predictions in 51 | some cases. Defaults to \code{FALSE}.} 52 | 53 | \item{niter}{an integer giving the maximum number of iterations} 54 | 55 | \item{tol}{a numeric value indicating the tolerance for convergence of 56 | the algorithm. It is the maximum sum of squared differences between 57 | to iteration steps.} 58 | 59 | \item{start}{a numeric value indicating the value with which NA's are 60 | replaced in the first step of the algorithm. Defaults to 0.} 61 | 62 | \item{verbose}{either a logical value, 1 or 2. \code{1} means "show the number 63 | of iterations and the final deviation", \code{2} means "show the deviation 64 | every 10 iterations". A value \code{TRUE} is read as \code{1}.} 65 | } 66 | \value{ 67 | A \code{tskrr} model of the class \code{\link{tskrrImputeHeterogeneous}} or \code{\link{tskrrImputeHomogeneous}} depending on whether or 68 | not \code{g} has a value. 69 | } 70 | \description{ 71 | This function implements an optimization algorithm that allows 72 | imputing missing values in the label matrix while fitting a 73 | \code{tskrr} model. 74 | } 75 | \examples{ 76 | 77 | data(drugtarget) 78 | 79 | naid <- sample(length(drugTargetInteraction), 30) 80 | drugTargetInteraction[naid] <- NA 81 | 82 | impute_tskrr(drugTargetInteraction, targetSim, drugSim) 83 | 84 | } 85 | -------------------------------------------------------------------------------- /xnet_JSSPaper/xnet_JSSPaper.R: -------------------------------------------------------------------------------- 1 | # RScript containing the code mentioned in the paper 2 | # Network Prediction with Two-Step Kernel Ridge Regression: The R package xnet 3 | # The package xnet can be installed from CRAN. 4 | # ------------------------------------------------------------------------------- 5 | 6 | ## ----setup---------------------------------------------------------- 7 | library(xnet) 8 | data(drugtarget) 9 | 10 | 11 | ## ----split data------------------------------------------------------ 12 | data(drugtarget) 13 | interaction <- drugTargetInteraction[, -c(1:3)] 14 | traindrugSim <- drugSim[-c(1:3), -c(1:3)] 15 | testdrugSim <- drugSim[1:3, -c(1:3)] 16 | 17 | 18 | ## ----fit a heterogeneous model----------------------------------------------------- 19 | trained <- tune(interaction, targetSim, traindrugSim, 20 | lim = list(k = c(1e-4,10), g = c(1e-3,10)), 21 | ngrid = list(k = 20, g = 10), 22 | fun = loss_auc, 23 | exclusion = "interaction", replaceby0 = TRUE) 24 | lambda(trained) 25 | 26 | 27 | ## Look at the output---------------------------------------------------------------------------------- 28 | trained 29 | 30 | 31 | ## ----modelplot, fig.cap="Heatmap of the residuals for the training model on interactions between drugs and neural receptors. Negative values indicate possible interactions not present in the original data."---- 32 | plot(trained, dendro = "none", 33 | which = "residuals", cols = 10:30, rows = 10:25, 34 | main = "Residuals for drug target interaction.") 35 | 36 | 37 | ## ----lossplot, fig.cap = "Contour plot of the loss values for different combinations of lambda values for the training model on drug-target interaction. The red cross indicates the lowest loss value."---- 38 | plot_grid(trained, main = "Loss surface for drug-target interaction") 39 | 40 | 41 | ## Looking at the similarity matrix------------------------------------------------------------------------- 42 | testdrugSim[, 1:6] 43 | 44 | 45 | ## ---- Calculate the AUC------------------------------------------------- 46 | library(pROC) 47 | newpreds <- predict(trained, g = testdrugSim) 48 | pvec <- as.vector(newpreds) 49 | rvec <- as.vector(drugTargetInteraction[, 1:3]) 50 | curve <- roc(rvec, pvec) 51 | auc(curve) 52 | 53 | 54 | ## Illustration of imputation-------------------------------------- 55 | data("proteinInteraction") 56 | idrow <- seq(10,150, by = 10) 57 | idcol <- seq(5, 145, by = 10) 58 | proteiny <- proteinInteraction 59 | proteiny[idrow,idcol] <- proteiny[idcol,idrow] <- NA 60 | 61 | imputed <- impute_tskrr(y = proteiny, k = Kmat_y2h_sc, 62 | start = 0.5) 63 | 64 | 65 | ## ---- plotimpute, fig.cap="Visualization of the imputed values for the missing values in the protein-protein interaction dataset."---- 66 | id <- is_imputed(imputed) 67 | rowid <- rowSums(id) > 0 68 | colid <- colSums(id) > 0 69 | plot(imputed, rows = rowid, cols = colid, 70 | dendro = "none", which = "response") 71 | 72 | 73 | ## ---- Calculating AUC for imputation-------------------------------- 74 | id <- which_imputed(imputed) 75 | orig <- proteinInteraction[id] 76 | imp <- response(imputed)[id] 77 | curve <- roc(orig, imp) 78 | auc(curve) -------------------------------------------------------------------------------- /man/permtest.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/all_generics.R, R/Class_permtest.R, 3 | % R/permtest.R 4 | \name{permtest} 5 | \alias{permtest} 6 | \alias{print.permtest} 7 | \alias{permtest,tskrrHeterogeneous-method} 8 | \alias{permtest,tskrrHomogeneous-method} 9 | \alias{permtest,tskrrTune-method} 10 | \title{Calculate the relative importance of the edges} 11 | \usage{ 12 | permtest(x, ...) 13 | 14 | \method{print}{permtest}(x, digits = max(3L, getOption("digits") - 3), ...) 15 | 16 | \S4method{permtest}{tskrrHeterogeneous}( 17 | x, 18 | n = 100, 19 | permutation = c("both", "row", "column"), 20 | exclusion = c("interaction", "row", "column", "both"), 21 | replaceby0 = FALSE, 22 | fun = loss_mse, 23 | exact = FALSE 24 | ) 25 | 26 | \S4method{permtest}{tskrrHomogeneous}( 27 | x, 28 | n = 100, 29 | permutation = c("both"), 30 | exclusion = c("interaction", "both"), 31 | replaceby0 = FALSE, 32 | fun = loss_mse, 33 | exact = FALSE 34 | ) 35 | 36 | \S4method{permtest}{tskrrTune}(x, permutation = c("both", "row", "column"), n = 100) 37 | } 38 | \arguments{ 39 | \item{x}{either a \code{\link{tskrr-class}} or a 40 | \code{\link{tskrrTune-class}} object} 41 | 42 | \item{...}{arguments passed to other methods} 43 | 44 | \item{digits}{the number of digits shown in the output} 45 | 46 | \item{n}{the number of permutations for every kernel matrix} 47 | 48 | \item{permutation}{a character string that defines whether the row, 49 | column or both kernel matrices should be permuted. Ignored in case of 50 | a homogeneous network} 51 | 52 | \item{exclusion}{the exclusion to be used in the \code{\link{loo}} function. See also \code{\link{get_loo_fun}}} 53 | 54 | \item{replaceby0}{a logical value indicating whether \code{\link{loo}} 55 | removes a value in the leave-one-out procedure or replaces it by zero. 56 | See also \code{\link{get_loo_fun}}.} 57 | 58 | \item{fun}{a function (or a character string with the name of a 59 | function) that calculates the loss. See also \code{\link{tune}} and 60 | \code{\link{loss_functions}}} 61 | 62 | \item{exact}{a logical value that indicates whether or not an 63 | exact p-value should be calculated, or be approximated based on 64 | a normal distribution.} 65 | } 66 | \value{ 67 | An object of the class permtest. 68 | } 69 | \description{ 70 | This function does a permutation-based evaluation of the impact of 71 | different edges on the final result. It does so by permuting the kernel 72 | matrices, refitting the model and calculating a loss function. 73 | } 74 | \details{ 75 | The test involved uses a normal approximation. It assumes that under the 76 | null hypothesis, the loss values are approximately normally distributed. 77 | The cumulative probability of a loss as small or smaller than 78 | the one found in the original model, is calculated based on a normal 79 | distribution from which the mean and sd are calculated from the permutations. 80 | } 81 | \section{Warning}{ 82 | It should be noted that this normal approximation is an ad-hoc approach. 83 | There's no guarantee that the actual distribution of the loss under the 84 | null hypothesis is normal. Depending on the loss function, a significant 85 | deviation from the theoretic distribution can exist. Hence this functions should only 86 | be used as a rough guidance in model evaluation. 87 | } 88 | 89 | \examples{ 90 | 91 | # Heterogeneous network 92 | 93 | data(drugtarget) 94 | 95 | mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 96 | permtest(mod, fun = loss_auc) 97 | 98 | } 99 | -------------------------------------------------------------------------------- /tests/testthat/test_homogeneous_tune.R: -------------------------------------------------------------------------------- 1 | context("tuning homogeneous models") 2 | 3 | dfile <- system.file("testdata","testdataH.rda", package = "xnet") 4 | 5 | load(dfile) 6 | 7 | # Create test model 8 | lambdas <- c(0.01) 9 | mod <- tskrr(Yh,Kh,lambda = lambdas) 10 | 11 | # Test errors --------------------------------------------- 12 | 13 | test_that("input of tune is correctly processed",{ 14 | expect_error(tune(mod, lim = "a"), 15 | "lim .* single series of numeric values") 16 | expect_error(tune(mod, lim = numeric(0)), 17 | "lim needs 2 numeric values") 18 | expect_error(tune(mod, lim = list(c(0.01,1), c(1,2))), 19 | "lim .* single series of numeric values") 20 | expect_error(tune(mod, ngrid = list(12,12)), 21 | "ngrid .* single series of numeric values") 22 | expect_warning(tune(mod, onedim = FALSE), 23 | "one-dimensional search .* homogeneous networks") 24 | 25 | }) 26 | 27 | # Test output --------------------------------------------- 28 | tuned <- tune(mod, 29 | lim = list(c(0.001,1)), 30 | ngrid = list(20), 31 | exclusion = "both") 32 | manlambdas <- create_grid(lim = c(0.001,1), 33 | ngrid = 20) 34 | tunedman <- tune(mod, 35 | lambda = manlambdas, 36 | exclusion = "both") 37 | tunedirect <- tune(Yh, Kh, 38 | lim = list(c(0.001,1)), 39 | ngrid = list(20), 40 | exclusion = "both") 41 | 42 | test_that("Output of tuned model is correct", { 43 | # retuning should give the exact same outcome 44 | expect_identical(tuned, 45 | tune(tuned, 46 | lim = list(c(0.001,1)), 47 | ngrid = list(20), 48 | exclusion = "both")) 49 | # manually setting lambdas should give exact same outcome 50 | expect_identical(tuned, 51 | tunedman) 52 | # You should get the exact same loo function 53 | expect_identical(get_loo_fun(tuned), 54 | get_loo_fun(mod, 55 | exclusion = "both")) 56 | # Loss function should be correct 57 | expect_identical(tuned@loss_function, 58 | loss_mse) 59 | # grid is correct 60 | expect_identical(get_grid(tuned), 61 | list(k = manlambdas)) 62 | # loss values are correct 63 | lossval <- get_loss_values(tuned) 64 | expect_equal(dim(lossval), c(length(manlambdas),1)) 65 | 66 | testmod <- update(mod,manlambdas[15]) 67 | expect_equal(lossval[15,1], 68 | loss(testmod, exclusion = "both")) 69 | # direct construction of the model works 70 | expect_equal(tuned, 71 | tunedirect) 72 | 73 | }) 74 | 75 | # loss -------------------------- 76 | 77 | test_that("loss is calculated correctly",{ 78 | expect_equal(loss(tuned),loss_mse(response(tuned), 79 | loo(tuned, exclusion = "both"))) 80 | expect_equal(loss(tuned, exclusion = "interaction", fun = loss_auc, 81 | replaceby0 = TRUE), 82 | loss_auc(response(tuned), 83 | loo(tuned, replaceby0 = TRUE))) 84 | }) 85 | 86 | 87 | # Test behaviour as tskrr --------------------------------- 88 | test_that("get_loo_fun works correctly on tuned homogeneous models",{ 89 | expect_identical(get_loo_fun(tuned, 90 | exclusion = "interaction", 91 | replaceby0 = TRUE), 92 | get_loo_fun(mod, 93 | exclusion = "interaction", 94 | replaceby0 = TRUE)) 95 | }) 96 | -------------------------------------------------------------------------------- /R/update.R: -------------------------------------------------------------------------------- 1 | #' Update a tskrr object with a new lambda 2 | #' 3 | #' This function allows you to refit a \code{\link{tskrr}} with a 4 | #' new lambda. It can be used to do manual tuning/cross-validation. 5 | #' If the object has the hat matrices stored, these are updated 6 | #' as well. 7 | #' 8 | #' @param object a \code{\link[xnet:tskrr-class]{tskrr}} object 9 | #' @inheritParams tskrr 10 | #' @param ... arguments passed to methods 11 | #' 12 | #' @return an updated \code{\link[xnet:tskrr-class]{tskrr}} object 13 | #' fitted with the new lambdas. 14 | #' 15 | #' @examples 16 | #' data(drugtarget) 17 | #' 18 | #' mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 19 | #' 20 | #' # Update with the same lambda 21 | #' mod2 <- update(mod, lambda = 1e-3) 22 | #' 23 | #' # Use different lambda for rows and columns 24 | #' mod3 <- update(mod, lambda = c(0.01,0.001)) 25 | #' 26 | #' # A model with the hat matrices stored 27 | #' lambda <- c(0.001,0.01) 28 | #' modkeep <- tskrr(drugTargetInteraction, targetSim, drugSim, keep = TRUE) 29 | #' Hk_1 <- hat(modkeep, which = "row") 30 | #' modkeep2 <- update(modkeep, lambda = lambda) 31 | #' Hk_2 <- hat(modkeep2, which = "row") 32 | #' 33 | #' # Calculate new hat matrix by hand: 34 | #' decomp <- get_eigen(modkeep, which = "row") 35 | #' Hk_byhand <- eigen2hat(decomp$vectors, 36 | #' decomp$values, 37 | #' lambda = lambda[1]) 38 | #' identical(Hk_2, Hk_byhand) 39 | #' 40 | #' @rdname update 41 | #' @export 42 | setMethod("update", 43 | "tskrrHomogeneous", 44 | function(object, lambda){ 45 | 46 | if(missing(lambda) || !is.numeric(lambda) || length(lambda) != 1){ 47 | stop(paste("lambda should be a single numeric value", 48 | "for homogeneous networks.")) 49 | } 50 | 51 | decomp <- get_eigen(object) 52 | 53 | Hk <- eigen2hat(decomp$vectors, 54 | decomp$values, 55 | lambda) 56 | 57 | object@lambda.k <- lambda 58 | object@pred <- Hk %*% object@y %*% Hk 59 | 60 | if(has_hat(object)) 61 | object@Hk <- Hk 62 | 63 | return(object) 64 | }) 65 | 66 | #' @rdname update 67 | #' @export 68 | setMethod("update", 69 | "tskrrHeterogeneous", 70 | function(object, lambda){ 71 | 72 | if(missing(lambda) || 73 | !is.numeric(lambda) || 74 | (ll<- length(lambda)) < 1 || 75 | ll > 2){ 76 | stop(paste("lambda should be a numeric vector", 77 | "with one or two values")) 78 | } 79 | 80 | if(ll == 1){ 81 | lambda.k <- lambda.g <- lambda 82 | } else { 83 | lambda.k <- lambda[1] 84 | lambda.g <- lambda[2] 85 | } 86 | 87 | decompk <- get_eigen(object, 'row') 88 | decompg <- get_eigen(object, 'column') 89 | 90 | Hk <- eigen2hat(decompk$vectors, 91 | decompk$values, 92 | lambda.k) 93 | Hg <- eigen2hat(decompg$vectors, 94 | decompg$values, 95 | lambda.g) 96 | 97 | object@lambda.k <- lambda.k 98 | object@lambda.g <- lambda.g 99 | object@pred <- Hk %*% object@y %*% Hg 100 | 101 | if(has_hat(object)){ 102 | object@Hk <- Hk 103 | object@Hg <- Hg 104 | } 105 | 106 | return(object) 107 | }) 108 | -------------------------------------------------------------------------------- /R/looInternal.R: -------------------------------------------------------------------------------- 1 | #' Leave-one-out cross-validation for two-step kernel ridge regression 2 | #' 3 | #' These functions implement different cross-validation scenarios for 4 | #' two-step kernel ridge regression. It uses the shortcuts for 5 | #' leave-one-out cross-validation. 6 | #' 7 | #' These functions are primarily for internal use and hence not exported. 8 | #' Be careful when using them, as they do not perform any sanity check 9 | #' on the input. It is up to the user to make sure the input makes sense. 10 | #' 11 | #' @seealso \code{\link{loo}} for the user-level function. 12 | #' 13 | #' @param Y the matrix with responses 14 | #' @param Hk the hat matrix for the first kernel (rows of Y) 15 | #' @param Hg the hat matrix for the second kernel (columns of Y) 16 | #' @param alpha a vector of length 4 with the alpha values from a 17 | #' \code{\link{linearFilter}} model 18 | #' @param pred the predictions 19 | #' @param ... added to allow for specifying pred even when not needed. 20 | #' 21 | #' @return a matrix with the leave-one-out predictions 22 | #' @rdname looInternal 23 | #' @name loo_internal 24 | loo.i <- function(Y, Hk, Hg, pred){ 25 | L <- tcrossprod(diag(Hk), diag(Hg)) 26 | return((pred - Y * L) / (1 - L)) 27 | } 28 | 29 | #' @rdname looInternal 30 | loo.i0 <- function(Y, Hk, Hg, pred){ 31 | L <- tcrossprod(diag(Hk), diag(Hg)) 32 | return((pred - Y * L)) 33 | } 34 | 35 | #' @rdname looInternal 36 | loo.r <- function(Y, Hk, Hg, ...){ 37 | div <- 1 - diag(Hk) 38 | diag(Hk) <- 0 39 | 40 | return( (Hk %*% Y %*% Hg) / div ) 41 | } 42 | 43 | #' @rdname looInternal 44 | loo.c <- function(Y, Hk, Hg, ...){ 45 | div <- 1 - diag(Hg) 46 | diag(Hg) <- 0 47 | 48 | return( (Hk %*% Y %*% Hg) / rep(div, each = nrow(Y)) ) 49 | } 50 | 51 | #' @rdname looInternal 52 | loo.b <- function(Y, Hk, Hg, ...){ 53 | divk <- 1 - diag(Hk) 54 | divg <- 1 - diag(Hg) 55 | 56 | diag(Hk) <- 0 57 | diag(Hg) <- 0 58 | 59 | pred <- Hk %*% Y %*% Hg 60 | div <- tcrossprod(divk, divg) 61 | 62 | return(pred / div) 63 | } 64 | 65 | #################################### 66 | ## SHORTCUTS FOR HOMOGENOUS NETWORKS 67 | 68 | #' @rdname looInternal 69 | loo.e.sym <- function(Y, Hk, pred){ 70 | 71 | L <- tcrossprod(diag(Hk)) + Hk^2 72 | return((pred - L * Y) / ( 1 - L)) 73 | 74 | } 75 | 76 | #' @rdname looInternal 77 | loo.e.skew <- function(Y, Hk, pred){ 78 | 79 | L <- tcrossprod(diag(Hk)) - Hk^2 80 | return((pred - L * Y) / ( 1 - L)) 81 | 82 | } 83 | 84 | #' @rdname looInternal 85 | loo.e0.sym <- function(Y, Hk, pred){ 86 | 87 | L <- tcrossprod(diag(Hk)) + Hk^2 88 | return( (pred - L * Y) ) 89 | 90 | } 91 | 92 | #' @rdname looInternal 93 | loo.e0.skew <- function(Y, Hk, pred){ 94 | 95 | L <- tcrossprod(diag(Hk)) - Hk^2 96 | return( (pred - L * Y) ) 97 | 98 | } 99 | 100 | #' @rdname looInternal 101 | loo.v <- function(Y, Hk, ...){ 102 | 103 | Hk0 <- Hk 104 | diag(Hk0) <- 0 105 | div <- 1 - diag(Hk) 106 | 107 | Floo <- Hk0 %*% Y / div 108 | FlooV <- Floo %*% Hk 109 | 110 | FlooV <- FlooV + Hk * ((diag(FlooV) - diag(Floo)) / div) 111 | return(FlooV) 112 | } 113 | 114 | #################################### 115 | ## SHORTCUTS FOR LINEAR FILTERS 116 | 117 | #' @rdname looInternal 118 | loo.i.lf <- function(Y, alpha, pred){ 119 | 120 | d <- dim(Y) 121 | n <- length(Y) 122 | 123 | lev <- alpha[1] + alpha[2] / d[1] + alpha[3] / d[2] + alpha[4] / n 124 | 125 | loolf <- (pred - Y*lev) / (1 - lev) 126 | return(loolf) 127 | } 128 | 129 | #' @rdname looInternal 130 | loo.i0.lf <- function(Y, alpha, pred){ 131 | 132 | d <- dim(Y) 133 | n <- length(Y) 134 | 135 | lev <- alpha[1] + alpha[2] / d[1] + alpha[3] / d[2] + alpha[4] / n 136 | 137 | loolf <- (pred - Y*lev) 138 | return(loolf) 139 | } 140 | -------------------------------------------------------------------------------- /R/loss.R: -------------------------------------------------------------------------------- 1 | #' Calculate or extract the loss of a tskrr model 2 | #' 3 | #' This function allows calculating the loss of a tskrr model using 4 | #' either one of the functions defined in \code{\link{loss_functions}} 5 | #' or a custom user function. If the model inherits from class 6 | #' \code{\link[xnet:tskrrTune-class]{tskrrTune}} and no additional arguments 7 | #' are given, the loss is returned for the settings used when tuning. 8 | #' The function can also be used to extract the original loss from a 9 | #' \code{\link[xnet:permtest-class]{permtest}} object. 10 | #' 11 | #' @param x a model that inherits from class 12 | #' \code{\link[xnet:tskrr-class]{tskrr}} 13 | #' @param fun a function to be used for calculating the loss. This 14 | #' can also be a character value giving the name of one of the loss 15 | #' functions provided in the package 16 | #' @param exclusion a character value with possible values "interaction", 17 | #' "row", "column" or "both". 18 | #' See also \code{\link{loo}} for more information. 19 | #' @param replaceby0 a logical value indicating whether the interaction 20 | #' should be simply removed (\code{FALSE}) or replaced by 0 (\code{TRUE}). 21 | #' @param predictions a logical value to indicate whether the 22 | #' predictions should be used instead of leave one out crossvalidation. 23 | #' If set to \code{TRUE}, the other arguments are ignored. 24 | #' @param ... extra arguments passed to the loss function in \code{fun}. 25 | #' 26 | #' @return a numeric value with the calculated loss 27 | #' 28 | #' @seealso 29 | #' * \code{\link{loss_functions}} for possible loss functions 30 | #' * \code{\link{tune}} for tuning a model based on loss functions 31 | #' @md 32 | #' 33 | #' @examples 34 | #' data(drugtarget) 35 | #' 36 | #' mod <- tskrr(drugTargetInteraction, targetSim, drugSim) 37 | #' 38 | #' loss(mod, fun = loss_auc) 39 | #' 40 | #' tuned <- tune(mod, fun = loss_auc) 41 | #' 42 | #' loss(tuned) 43 | #' loss(tuned, fun = loss_mse) 44 | #' 45 | #' @rdname loss 46 | #' @export 47 | setMethod("loss", 48 | "tskrr", 49 | function(x, 50 | fun = loss_mse, 51 | exclusion = c("interaction","row","column","both"), 52 | replaceby0 = FALSE, 53 | predictions = FALSE, 54 | ...){ 55 | 56 | fun <- match.fun(fun) 57 | exclusion <- match.arg(exclusion) 58 | # needed to make this work for homogeneous models! 59 | loo <- if(predictions){ 60 | fitted(x) 61 | } else { 62 | loo(x, exclusion, replaceby0) 63 | } 64 | fun(response(x), loo, ...) 65 | }) 66 | 67 | #' @rdname loss 68 | #' @export 69 | setMethod("loss", 70 | "tskrrTune", 71 | function(x, 72 | fun = loss_mse, 73 | exclusion = c("interaction","row","column","both"), 74 | replaceby0 = FALSE, 75 | predictions = FALSE, 76 | ...){ 77 | 78 | # When no arguments are given, return the loss from object 79 | if(missing(fun) && missing(predictions) && 80 | missing(exclusion) && missing(replaceby0)) 81 | return(x@best_loss) 82 | else 83 | callGeneric(as_tskrr(x), 84 | fun, 85 | exclusion, 86 | replaceby0, 87 | predictions, 88 | ...) 89 | 90 | }) 91 | 92 | #' @rdname loss 93 | #' @export 94 | setMethod("loss", 95 | "permtest", 96 | function(x, 97 | ...){ 98 | x@orig_loss 99 | }) 100 | -------------------------------------------------------------------------------- /man/get_loo_fun.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/all_generics.R, R/get_loo_fun.R 3 | \name{get_loo_fun} 4 | \alias{get_loo_fun} 5 | \alias{get_loo_fun,tskrrHeterogeneous-method} 6 | \alias{get_loo_fun,tskrrHomogeneous-method} 7 | \alias{get_loo_fun,linearFilter-method} 8 | \alias{get_loo_fun,character-method} 9 | \alias{get_loo_fun,tskrrTune-method} 10 | \title{Retrieve a loo function} 11 | \usage{ 12 | get_loo_fun(x, ...) 13 | 14 | \S4method{get_loo_fun}{tskrrHeterogeneous}( 15 | x, 16 | exclusion = c("interaction", "row", "column", "both"), 17 | replaceby0 = FALSE 18 | ) 19 | 20 | \S4method{get_loo_fun}{tskrrHomogeneous}( 21 | x, 22 | exclusion = c("edges", "vertices", "interaction", "both"), 23 | replaceby0 = FALSE 24 | ) 25 | 26 | \S4method{get_loo_fun}{linearFilter}(x, replaceby0 = FALSE) 27 | 28 | \S4method{get_loo_fun}{character}( 29 | x = c("tskrrHeterogeneous", "tskrrHomogeneous", "linearFilter"), 30 | ... 31 | ) 32 | 33 | \S4method{get_loo_fun}{tskrrTune}(x, ...) 34 | } 35 | \arguments{ 36 | \item{x}{a character value with the class or a \code{\link{tskrr}} 37 | or \code{\link{linearFilter}} object.} 38 | 39 | \item{...}{arguments passed to or from other methods.} 40 | 41 | \item{exclusion}{a character value with possible values "interaction", 42 | "row", "column", "both" for heterogeneous models, and "edges", "vertices", 43 | "interaction" or "both" for homogeneous models. 44 | Defaults to "interaction". See details.} 45 | 46 | \item{replaceby0}{a logical value indicating whether the interaction 47 | should be simply removed (\code{FALSE}) or replaced by 0 (\code{TRUE}).} 48 | } 49 | \value{ 50 | a function taking the arguments y, and possibly pred 51 | for calculating the leave-one-out cross-validation. For class 52 | \code{tskrrHeterogeneous}, the returned function also 53 | has an argument Hk and Hg, representing the hat matrix for the rows 54 | and the columns respectively. For class \code{tskrrHomogeneous}, 55 | only the extra argument Hk is available. For class \code{linearFilter}, 56 | the extra argument is called \code{alpha} and takes the alpha vector 57 | of that model. 58 | } 59 | \description{ 60 | This function returns the correct function needed to perform 61 | one of the leave-one-out cross-validations. It's primarily meant 62 | for internal use but can be useful when doing simulations. 63 | } 64 | \details{ 65 | This function can be used to select the correct loo function in 66 | a simulation or tuning algorithm, based on the model object you 67 | created. Depending on its class, the returned functions will have 68 | different arguments, so you should only use this if you know 69 | what you're doing and after you checked the actual returned 70 | functions in \code{\link{loo_internal}}. 71 | 72 | Using \code{replaceby0} only makes sense if you only remove the interaction. 73 | In all other cases, this argument is ignored. 74 | 75 | For the class \code{tskrrHomogeneous}, it doesn't make sense to 76 | remove rows or columns. If you chose this option, the function will 77 | throw an error. Removing edges corresponds to the setting "edges" or 78 | "interaction". Removing vertices corresponds to the setting "vertices" or 79 | "both". These terms can be used interchangeably. 80 | 81 | For the class \code{linearFilter} it only makes sense to exclude the 82 | interaction (i.e., a single cell). Therefore you do not have an argument 83 | \code{exclusion} for that method. 84 | 85 | For the classes \code{tskrrTune} and \code{tskrrImpute}, 86 | not specifying \code{exclusion} or \code{replaceby0} returns the used 87 | loo function. If you specify either of them, 88 | it will use the method for the appropriate model and return 89 | a new loo function. 90 | } 91 | \seealso{ 92 | \code{\link{loo}} for carrying out a leave on out crossvalidation, 93 | and \code{\link{loo_internal}} for more information on the internal 94 | functions one retrieves with this one. 95 | } 96 | -------------------------------------------------------------------------------- /R/valid_labels.R: -------------------------------------------------------------------------------- 1 | #' Test the correctness of the labels. 2 | #' 3 | #' This function checks whether the labels between the Y, K, and G 4 | #' matrices make sense. This means that all the labels found as 5 | #' rownames for \code{y} can be found as rownames \emph{and} column 6 | #' names of \code{k}, and all the colnames for \code{y} can be found 7 | #' as rownames \emph{and} colnames of \code{g} (if provided). 8 | #' 9 | #' Compatible labels mean that it is unequivocally clear which 10 | #' rows and columns can be linked throughout the model. In case none 11 | #' of the matrices have row- or colnames, the labels are considered 12 | #' compatible. In all other cases, all matrices should have both row 13 | #' and column names. They should fulfill the following conditions: 14 | #' 15 | #' \itemize{ 16 | #' \item the row- and column names of a kernel matrix must contain 17 | #' the same values in the same order. Otherwise, the matrix can't 18 | #' be symmetric. 19 | #' \item the rownames of \code{y} should correspond to the rownames 20 | #' of \code{k} 21 | #' \item the colnames of \code{y} should correspond to the colnames 22 | #' of \code{g} if it is supplied, or the colnames of \code{k} in 23 | #' case \code{g} is \code{NULL} 24 | #' } 25 | #' 26 | #' @param y the label matrix 27 | #' @param k the kernel matrix for the rows 28 | #' @param g the kernel matrix for the columns (optional). If not available, 29 | #' it takes the value \code{NULL} 30 | #' 31 | #' @note This is a non-exported convenience function. 32 | #' 33 | #' @return \code{TRUE} if all labels are compatible, an error otherwise. 34 | #' 35 | #' @rdname valid_labels 36 | valid_labels <- function(y, k, g = NULL){ 37 | 38 | if(!valid_dimensions(y, k, g)) 39 | stop("Dimensions are incompatible.") 40 | 41 | rny <- rownames(y) 42 | cny <- colnames(y) 43 | rnk <- rownames(k) 44 | cnk <- colnames(k) 45 | 46 | checkg <- !is.null(g) 47 | 48 | # Check for NULL 49 | rynull <- is.null(rny) 50 | rknull <- is.null(rnk) 51 | cynull <- is.null(cny) 52 | cknull <- is.null(cnk) 53 | 54 | if(checkg){ 55 | rng <- rownames(g) 56 | cng <- colnames(g) 57 | rgnull <- is.null(rng) 58 | cgnull <- is.null(cng) 59 | 60 | if(all(rynull,rknull,rgnull,cynull,cknull,cgnull)) 61 | return(TRUE) 62 | else if(any(rynull,rknull,rgnull,cynull,cknull,cgnull)) 63 | stop(paste("Not all row labels and col labels could be found.", 64 | "You need to have compatible row and column labels", 65 | "for all matrices. See also ?valid_labels.")) 66 | } else { 67 | if(all(rynull,rknull,cynull,cknull)) 68 | return(TRUE) 69 | else if(any(rynull,rknull,cynull,cknull)) 70 | stop(paste("Not all row labels and col labels could be found.", 71 | "You need to have compatible row and column labels", 72 | "for all matrices. See also ?valid_labels.")) 73 | } 74 | 75 | if(!all(rnk == cnk)) 76 | stop("Different row- and colnames found for k.") 77 | 78 | out <- all(match(rny,rnk,0L) > 0L) 79 | 80 | if(!out) 81 | stop(paste("rownames of y and k are not matching.", 82 | "See also ?valid_labels.")) 83 | 84 | if(checkg){ 85 | # When there is g, check against g 86 | cng <- colnames(g) 87 | rng <- rownames(g) 88 | 89 | if(!all(rng == cng)) 90 | stop("Different row- and colnames found for g.") 91 | out <- all(match(cny,cng,0L) > 0L) 92 | 93 | if(!out) 94 | stop(paste("colnames of y and g are not matching.", 95 | "See also ?valid_labels.")) 96 | 97 | } else { 98 | # No g, so check against k again 99 | out <- all(match(cny, cnk,0L) > 0L) 100 | 101 | if(!out) 102 | stop(paste("colnames of y and k are not matching.", 103 | "See also ?valid_labels.")) 104 | } 105 | return(out) 106 | } 107 | -------------------------------------------------------------------------------- /R/Class_tskrr.R: -------------------------------------------------------------------------------- 1 | #' Class tskrr 2 | #' 3 | #' The class tskrr represents a two step kernel ridge regression fitting 4 | #' object, and is normally generated by the function \code{\link{tskrr}}. 5 | #' This is a superclass so it should not be instantiated directly. 6 | #' 7 | #' @slot y the matrix with responses 8 | #' @slot k the eigen decomposition of the kernel matrix for the rows 9 | #' @slot lambda.k the lambda value used for k 10 | #' @slot pred the matrix with the predictions 11 | #' @slot has.hat a logical value indicating whether the kernel hat matrices 12 | #' are stored in the object. 13 | #' @slot Hk the kernel hat matrix for the rows. 14 | #' @slot labels a list with two character vectors, \code{k} and 15 | #' \code{g}, containing the labels for the rows resp. columns. See 16 | #' \code{\link{tskrrHomogeneous}} and 17 | #' \code{\link{tskrrHeterogeneous}} for more details. 18 | #' 19 | #' @seealso the classes \code{\link{tskrrHomogeneous}} and 20 | #' \code{\link{tskrrHeterogeneous}} for the actual classes. 21 | #' 22 | #' @importFrom utils str 23 | #' 24 | #' @rdname tskrr-class 25 | #' @name tskrr-class 26 | #' @exportClass tskrr 27 | setOldClass("eigen") 28 | 29 | setClass("tskrr", 30 | slots = c(y = "matrix", 31 | k = "eigen", 32 | lambda.k = "numeric", 33 | pred = "matrix", 34 | has.hat = "logical", 35 | Hk = "matrix", 36 | labels = "list"), 37 | prototype = list(y = matrix(0), 38 | k = structure(list(vectors = matrix(0), 39 | values = numeric(1)), 40 | class = "eigen" 41 | ), 42 | lambda.k = 1e-4, 43 | pred = matrix(0), 44 | has.hat = FALSE, 45 | Hk = matrix(0), 46 | labels = list(k = NA_character_, 47 | g = NA_character_))) 48 | 49 | validTskrr <- function(object){ 50 | 51 | if(!all(is.numeric(object@y), 52 | is.numeric(object@pred))) 53 | return("y and pred should be a numeric matrix.") 54 | 55 | else if(length(object@lambda.k) != 1) 56 | return("lambda.k should be a single value.") 57 | 58 | else if(length(object@labels) != 2) 59 | return("labels should be a list with 2 elements") 60 | 61 | else if(any(names(object@labels) != c("k","g"))) 62 | return("The elements in labels should be called k and g") 63 | 64 | else if(!all(sapply(object@labels, is.character))) 65 | return("The elements in labels should be character vectors") 66 | 67 | else 68 | return(TRUE) 69 | } 70 | 71 | setValidity("tskrr", validTskrr) 72 | ################################################ 73 | # SHOW METHOD 74 | 75 | .show_tskrr <- function(object, homogeneous){ 76 | dims <- paste(dim(object@y), collapse = " x ") 77 | cat("Dimensions:", dims,"\n") 78 | cat("Lambda:\n") 79 | print(lambda(object)) 80 | 81 | labs <- labels(object) 82 | if(homogeneous) 83 | cat("\nLabels:") 84 | else 85 | cat("\nRow Labels:") 86 | 87 | str(labs$k, give.length = FALSE, give.head = FALSE, 88 | width = getOption("width") - 11) 89 | if(!homogeneous){ 90 | cat("Col Labels:") 91 | str(labs$g, give.length = FALSE, give.head = FALSE, 92 | width = getOption("width") - 11) 93 | } 94 | } 95 | 96 | setMethod("show", 97 | "tskrr", 98 | function(object){ 99 | ishomog <- is_homogeneous(object) 100 | type <- ifelse(ishomog,"Homogeneous","Heterogeneous") 101 | tl <- ifelse(ishomog,"----------","------------") 102 | cat(paste(type,"two-step kernel ridge regression"), 103 | paste(tl,"--------------------------------",sep="-"), 104 | sep = "\n") 105 | 106 | .show_tskrr(object, ishomog) 107 | 108 | }) 109 | 110 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # NOTE: This workflow is overkill for most R packages 2 | # check-standard.yaml is likely a better choice 3 | # usethis::use_github_action("check-standard") will install it. 4 | # 5 | # For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag. 6 | # https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions 7 | on: 8 | push: 9 | branches: 10 | - main 11 | pull_request: 12 | branches: 13 | - main 14 | 15 | name: R-CMD-check 16 | 17 | jobs: 18 | R-CMD-check: 19 | runs-on: ${{ matrix.config.os }} 20 | 21 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 22 | 23 | strategy: 24 | fail-fast: false 25 | matrix: 26 | config: 27 | - {os: macOS-latest, r: 'release'} 28 | - {os: windows-latest, r: 'release'} 29 | - {os: ubuntu-18.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/bionic/latest", http-user-agent: "R/4.0.0 (ubuntu-18.04) R (4.0.0 x86_64-pc-linux-gnu x86_64 linux-gnu) on GitHub Actions" } 30 | - {os: ubuntu-18.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/bionic/latest"} 31 | 32 | env: 33 | RSPM: ${{ matrix.config.rspm }} 34 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 35 | 36 | steps: 37 | - uses: actions/checkout@v2 38 | 39 | - uses: r-lib/actions/setup-r@v1 40 | id: install-r 41 | with: 42 | r-version: ${{ matrix.config.r }} 43 | http-user-agent: ${{ matrix.config.http-user-agent }} 44 | 45 | - uses: r-lib/actions/setup-pandoc@v1 46 | 47 | - name: Install pak and query dependencies 48 | run: | 49 | install.packages("pak", repos = "https://r-lib.github.io/p/pak/dev/") 50 | saveRDS(pak::pkg_deps("local::.", dependencies = TRUE), ".github/r-depends.rds") 51 | shell: Rscript {0} 52 | 53 | - name: Restore R package cache 54 | uses: actions/cache@v2 55 | with: 56 | path: | 57 | ${{ env.R_LIBS_USER }}/* 58 | !${{ env.R_LIBS_USER }}/pak 59 | key: ${{ matrix.config.os }}-${{ steps.install-r.outputs.installed-r-version }}-1-${{ hashFiles('.github/r-depends.rds') }} 60 | restore-keys: ${{ matrix.config.os }}-${{ steps.install-r.outputs.installed-r-version }}-1- 61 | 62 | - name: Install system dependencies 63 | if: runner.os == 'Linux' 64 | run: | 65 | pak::local_system_requirements(execute = TRUE) 66 | pak::pkg_system_requirements("rcmdcheck", execute = TRUE) 67 | shell: Rscript {0} 68 | 69 | - name: Install dependencies 70 | run: | 71 | pak::local_install_dev_deps(upgrade = TRUE) 72 | pak::pkg_install("rcmdcheck") 73 | shell: Rscript {0} 74 | 75 | - name: Session info 76 | run: | 77 | options(width = 100) 78 | pkgs <- installed.packages()[, "Package"] 79 | sessioninfo::session_info(pkgs, include_base = TRUE) 80 | shell: Rscript {0} 81 | 82 | - name: Check 83 | env: 84 | _R_CHECK_CRAN_INCOMING_: false 85 | run: | 86 | options(crayon.enabled = TRUE) 87 | rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") 88 | shell: Rscript {0} 89 | 90 | - name: Show testthat output 91 | if: always() 92 | run: find check -name 'testthat.Rout*' -exec cat '{}' \; || true 93 | shell: bash 94 | 95 | - name: Upload check results 96 | if: failure() 97 | uses: actions/upload-artifact@main 98 | with: 99 | name: ${{ matrix.config.os }}-r${{ matrix.config.r }}-results 100 | path: check 101 | 102 | - name: Don't use tar from old Rtools to store the cache 103 | if: ${{ runner.os == 'Windows' && startsWith(steps.install-r.outputs.installed-r-version, '3.6' ) }} 104 | shell: bash 105 | run: echo "C:/Program Files/Git/usr/bin" >> $GITHUB_PATH 106 | -------------------------------------------------------------------------------- /R/Class_tskrrTune.R: -------------------------------------------------------------------------------- 1 | #' Class tskrrTune 2 | #' 3 | #' The class tskrrTune represents a tuned \code{\link[xnet:tskrr-class]{tskrr}} 4 | #' model, and is the output of the function \code{\link{tune}}. Apart from 5 | #' the model, it contains extra information on the tuning procedure. This is 6 | #' a virtual class only. 7 | #' 8 | #' @slot lambda_grid a list object with the elements \code{k} and possibly 9 | #' \code{g} indicating the tested lambda values for the row kernel \code{K} 10 | #' and - if applicable - the column kernel \code{G}. Both elements have 11 | #' to be numeric. 12 | #' @slot best_loss a numeric value with the loss associated with the 13 | #' best lambdas 14 | #' @slot loss_values a matrix with the loss results from the searched grid. 15 | #' The rows form the X dimension (related to the first lambda), the columns 16 | #' form the Y dimension (related to the second lambda if applicable) 17 | #' @slot loss_function the used loss function 18 | #' @slot exclusion a character value describing the exclusion used 19 | #' @slot replaceby0 a logical value indicating whether or not the cross 20 | #' validation replaced the excluded values by zero 21 | #' @slot onedim a logical value indicating whether the grid search 22 | #' was done in one dimension. For homogeneous networks, this is 23 | #' true by default. 24 | #' 25 | #' @seealso 26 | #' * the function \code{tune} for the tuning itself 27 | #' * the class \code{\link{tskrrTuneHomogeneous}} and 28 | #' \code{tskrrTuneHeterogeneous} for the actual classes. 29 | #' @md 30 | #' 31 | #' @rdname tskrrTune-class 32 | #' @name tskrrTune-class 33 | #' @aliases tskrrTune 34 | #' @exportClass tskrrTune 35 | setClass("tskrrTune", 36 | slots = c(lambda_grid = "list", 37 | best_loss = "numeric", 38 | loss_values = "matrix", 39 | loss_function = "function", 40 | exclusion = "character", 41 | replaceby0 = "logical", 42 | onedim = "logical")) 43 | 44 | validTskrrTune <- function(object){ 45 | 46 | lossval <- object@loss_values 47 | lgrid <- object@lambda_grid 48 | excl <- object@exclusion 49 | 50 | # General tests 51 | if(!all(sapply(lgrid, is.numeric))) 52 | return("lambda_grid should have only numeric elements.") 53 | 54 | if(length(object@best_loss) != 1) 55 | return("best_loss should be a single value.") 56 | 57 | if(length(excl) != 1) 58 | return("exclusion should be a single character value.") 59 | 60 | if(length(object@onedim) != 1) 61 | return("onedim should be a single logical value.") 62 | else 63 | return(TRUE) 64 | } 65 | 66 | setValidity("tskrrTune", validTskrrTune) 67 | 68 | setMethod("show", 69 | "tskrrTune", 70 | function(object){ 71 | 72 | # HEADER 73 | 74 | ishomog <- is_homogeneous(object) 75 | type <- ifelse(ishomog,"homogeneous","heterogeneous") 76 | tl <- ifelse(ishomog,"----------","------------") 77 | cat(paste("Tuned",type,"two-step kernel ridge regression"), 78 | paste("-----",tl,"--------------------------------",sep="-"), 79 | sep = "\n") 80 | .show_tskrr(object, ishomog) 81 | 82 | # Information on tuning 83 | excl <- object@exclusion 84 | if(object@replaceby0) excl <- paste(excl,"(values replaced by 0)") 85 | 86 | if(identical(object@loss_function, loss_mse)) 87 | loss_name <- "Mean Squared Error (loss_mse)" 88 | else if(identical(object@loss_function, loss_auc)) 89 | loss_name <- "Area under curve (loss_auc)" 90 | else 91 | loss_name <- "custom function by user" 92 | 93 | cat("\nTuning information:\n") 94 | cat("-------------------\n") 95 | cat("exclusion setting:",object@exclusion,"\n") 96 | cat("loss value:", object@best_loss,"\n") 97 | cat("loss function:", loss_name,"\n") 98 | if(object@onedim && is_heterogeneous(object)) 99 | cat("Grid search done in one dimension.\n") 100 | 101 | }) 102 | 103 | 104 | -------------------------------------------------------------------------------- /tests/testthat/test_heterogeneous_tune.R: -------------------------------------------------------------------------------- 1 | context("tuning heterogeneous models") 2 | 3 | dfile <- system.file("testdata","testdata.rda", package = "xnet") 4 | 5 | load(dfile) 6 | 7 | # Create test model 8 | lambdas <- c(0.01,0.015) 9 | mod <- tskrr(Y,K,G,lambda = lambdas) 10 | 11 | # Test errors --------------------------------------------- 12 | 13 | test_that("input of tune is correctly processed",{ 14 | expect_error(tune(mod, lim = "a"), 15 | "lim .* numeric vector .* list with two") 16 | expect_error(tune(mod, lim = numeric(0)), 17 | "lim .* 2 numeric values") 18 | expect_error(tune(mod, lim = list(c(0.01,1), c(1,2,3))), 19 | "lim .* 2 numeric values") 20 | }) 21 | 22 | # Test output --------------------------------------------- 23 | tuned <- tune(mod, 24 | lim = list(c(0.001,1),c(0.015,2)), 25 | ngrid = list(10,20), 26 | exclusion = "row") 27 | 28 | manlambdas <- list( 29 | k = create_grid(lim = c(0.001,1),ngrid = 10), 30 | g = create_grid(lim = c(0.015,2), ngrid = 20) 31 | ) 32 | tunedman <- tune(mod, 33 | lambda = manlambdas, 34 | exclusion = "row") 35 | tunedirect <- tune(Y,K,G, 36 | lim = list(c(0.001,1),c(0.015,2)), 37 | ngrid = list(10,20), 38 | exclusion = "row" 39 | ) 40 | 41 | test_that("Output of tuned model is correct", { 42 | # retuning should give the exact same outcome 43 | expect_identical(tuned, 44 | tune(tuned, 45 | lim = list(c(0.001,1),c(0.015,2)), 46 | ngrid = list(10,20), 47 | exclusion = "row")) 48 | # manually setting lambdas should give exact same outcome 49 | expect_identical(tuned, 50 | tunedman) 51 | # You should get the exact same loo function 52 | expect_identical(get_loo_fun(tuned), 53 | get_loo_fun(mod, 54 | exclusion = "row")) 55 | # Loss function should be correct 56 | expect_identical(tuned@loss_function, 57 | loss_mse) 58 | 59 | # grid is correct 60 | expect_identical(get_grid(tuned), 61 | manlambdas) 62 | # loss values are correct 63 | lossval <- get_loss_values(tuned) 64 | expect_equal(dim(lossval), c(length(manlambdas$k), 65 | length(manlambdas$g))) 66 | 67 | testmod <- update(mod,c(manlambdas$k[6], manlambdas$g[12])) 68 | expect_equal(lossval[6,12], 69 | loss(testmod, exclusion = "row")) 70 | # direct construction of model goes OK 71 | expect_equal(tuned, 72 | tunedirect) 73 | 74 | }) 75 | 76 | # Test one dimensional search --------------------------------- 77 | tune1d <- tune(mod, lim = c(0.01,1), ngrid = 10, onedim = TRUE) 78 | tune2d <- tune(mod, lim = c(0.01,1), ngrid = 10) 79 | 80 | test_that("one dimensional search gives correct result",{ 81 | expect_equal(as.vector(get_loss_values(tune1d)), 82 | diag(get_loss_values(tune2d))) 83 | expect_true(has_onedim(tune1d)) 84 | expect_false(has_onedim(tune2d)) 85 | expect_null(get_grid(tune1d)$g) 86 | expect_equal(get_grid(tune1d)$k, get_grid(tune2d)$k) 87 | 88 | }) 89 | 90 | 91 | # loss -------------------------- 92 | 93 | test_that("loss is calculated correctly",{ 94 | expect_equal(loss(tuned),loss_mse(response(tuned), 95 | loo(tuned, exclusion = "row"))) 96 | expect_equal(loss(tuned, exclusion = "interaction", fun = loss_auc, 97 | replaceby0 = TRUE), 98 | loss_auc(response(tuned), 99 | loo(tuned, replaceby0 = TRUE))) 100 | }) 101 | 102 | 103 | # Test behaviour as tskrr --------------------------------- 104 | test_that("get_loo_fun works correctly on tuned models",{ 105 | expect_identical(get_loo_fun(tuned, 106 | exclusion = "interaction", 107 | replaceby0 = TRUE), 108 | get_loo_fun(mod, 109 | exclusion = "interaction", 110 | replaceby0 = TRUE)) 111 | }) 112 | -------------------------------------------------------------------------------- /R/Class_permtest.R: -------------------------------------------------------------------------------- 1 | #' Class permtest 2 | #' 3 | #' This class represents the permutation test outcomes. See also 4 | #' the function \code{\link{permtest}}. 5 | #' 6 | #' @slot orig_loss a numeric value with the original loss of 7 | #' the model. 8 | #' @slot perm_losses a numeric vector with the losses of the 9 | #' different permutations. 10 | #' @slot n the number of permutations 11 | #' @slot loss_function the function used to calculate the losses. 12 | #' @slot exclusion a character value indicating the exclusion 13 | #' setting used for the test 14 | #' @slot replaceby0 a locigal value that indicates whether the 15 | #' exclusion was done by replacing with zero. See also 16 | #' \code{\link{loo}}. 17 | #' @slot permutation a character value that indicats in which 18 | #' kernel matrices were permuted. 19 | #' @slot pval a p value indicating how likely it is to find a 20 | #' smaller loss than the one of the model based on a normal 21 | #' approximation. 22 | #' @slot exact a logical value indicating whether the P value was 23 | #' calculated exactly or approximated by the normal distribution. 24 | #' 25 | #' @seealso 26 | #' * the function \code{\link{permtest}} for the actual test. 27 | #' * the function \code{\link{loo}} for the leave one out 28 | #' procedures 29 | #' * the function \code{\link{t.test}} for the actual test 30 | #' @md 31 | #' 32 | #' @include all_generics.R 33 | #' 34 | #' @rdname permtest-class 35 | #' @name permtest-class 36 | #' @exportClass permtest 37 | setClass("permtest", 38 | slots = c(orig_loss = "numeric", 39 | perm_losses = "numeric", 40 | n = "numeric", 41 | loss_function = "function", 42 | exclusion = "character", 43 | replaceby0 = "logical", 44 | permutation = "character", 45 | pval = "numeric", 46 | exact = "logical")) 47 | 48 | # Validity testing 49 | validPermtest <- function(object){ 50 | if(length(object@orig_loss) != 1) 51 | return("orig_loss should be a single value.") 52 | if(length(object@pval) != 1) 53 | return("pval should be a single value.") 54 | if(length(object@perm_losses) != object@n) 55 | return("perm_losses doesn't have a length of n.") 56 | if(length(object@exact)!= 1) 57 | return("exact should be a single value.") 58 | 59 | } 60 | 61 | setValidity("permtest", validPermtest) 62 | 63 | # internal 64 | 65 | .make_res_table <- function(perm_losses, orig_loss, pval){ 66 | avg <- mean(perm_losses) 67 | sd <- sd(perm_losses) 68 | # results 69 | res <- matrix( 70 | c(orig_loss, avg, sd, pval), 71 | nrow = 1, 72 | dimnames = list( 73 | " ", 74 | c("Loss", "Avg. loss", "St.dev", "Pr(X < loss)") 75 | ) 76 | ) 77 | } 78 | 79 | # Show method 80 | #' @param digits the number of digits shown in the output 81 | #' @rdname permtest 82 | #' @export 83 | print.permtest <- function(x, 84 | digits = max(3L, getOption("digits") - 3), 85 | ...){ 86 | 87 | if(identical(x@loss_function, loss_mse)) 88 | loss_name <- "Mean Squared Error (loss_mse)" 89 | else if(identical(x@loss_function, loss_auc)) 90 | loss_name <- "Area under curve (loss_auc)" 91 | else 92 | loss_name <- "custom function by user" 93 | 94 | excl <- x@exclusion 95 | if(x@replaceby0) excl <- paste(excl,"(values replaced by 0)") 96 | 97 | loss_name <- paste(" Loss function:",loss_name,"\n") 98 | excl <- paste(" Exclusion:", excl, "\n") 99 | perm <- paste0(" Permutations: ", x@n," (direction: ",x@permutation,")\n") 100 | 101 | res <- .make_res_table(x@perm_losses, 102 | x@orig_loss, 103 | x@pval) 104 | 105 | cat("\n") 106 | cat(strwrap("Permutation test for a tskrr model", prefix = "\t")) 107 | cat("\n") 108 | cat("Using:\n") 109 | cat(loss_name) 110 | cat(excl) 111 | cat(perm) 112 | cat("\n") 113 | printCoefmat(res, digits = digits) 114 | cat("\n") 115 | if(!x@exact) 116 | cat("P value is approximated based on a normal distribution.\n\n") 117 | invisible(res) 118 | 119 | } 120 | 121 | setMethod("show", 122 | "permtest", 123 | function(object){ 124 | print.permtest(object) 125 | }) 126 | -------------------------------------------------------------------------------- /vignettes/Preparation_example_data.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Preparation of the example data" 3 | author: "Joris Meys" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Preparation of the example data} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | ```{r setup, include = FALSE} 13 | knitr::opts_chunk$set( 14 | collapse = TRUE, 15 | comment = "#>" 16 | ) 17 | ``` 18 | 19 | The example data used in this package was originally published by 20 | [Yamanishi et al, 2008](https://doi.org/10.1093/bioinformatics/btn162). They 21 | used [the KEGG data base](https://www.kegg.jp/) to get information drug-target 22 | interaction for different groups of enzymes. We used their supplementary 23 | material as a basis for the example data provided to the package. Their 24 | supplementary datasets can be downloaded from [here](http://web.kuicr.kyoto-u.ac.jp/supp/yoshi/drugtarget/). 25 | 26 | ## Obtaining the original data 27 | 28 | The original adjacency matrix and similarity of the targets 29 | were downloaded from that website using the following code: 30 | 31 | ```{r getFiles, eval = FALSE} 32 | adjAddress <- "http://web.kuicr.kyoto-u.ac.jp/supp/yoshi/drugtarget/nr_admat_dgc.txt" 33 | 34 | targetAddress <- "http://web.kuicr.kyoto-u.ac.jp/supp/yoshi/drugtarget/nr_simmat_dg.txt" 35 | 36 | drugTargetInteraction <- as.matrix( 37 | read.table(adjAddress, header = TRUE, row.names = 1, sep = "\t") 38 | ) 39 | targetSim <- as.matrix( 40 | read.table(targetAddress, header =TRUE, row.names = 1, sep = "\t") 41 | ) 42 | ``` 43 | 44 | This data was used as is from the website. 45 | 46 | ## Processing the drug similarities 47 | 48 | In the original paper the authors relied on the SIMCOMP algorithm, but this 49 | method returns non-symmetric matrices and hence the original data cannot 50 | be used in a meaningful way for a two-step kernel ridge regression. Hence we decided to recreate the similarities between the different drugs, 51 | this time using the algorithms provided in the 52 | [fmcsR package v1.20.0](https://bioconductor.org/packages/release/bioc/html/fmcsR.html). 53 | The code used to obtain and process the drug similarities is heavily based on 54 | code kindly provided by Dr. Thomas Girke on the 55 | [BioConductor support forum](https://support.bioconductor.org/p/106712/#106744). 56 | 57 | ### Obtaining the data 58 | 59 | To read in the structural data for all compounds we create a function that 60 | constructs the actual link and retrieves the data from KEGG. This function 61 | is based on the tools provided in the 62 | [ChemmineR package v2.30.2](http://bioconductor.org/packages/ChemmineR/): 63 | 64 | ```{r importKEGG, eval = FALSE} 65 | library(ChemmineR) 66 | importKEGG <- function(ids){ 67 | sdfset <- SDFset() # creates an empty SDF set 68 | 69 | # We use the link format for obtaining the data 70 | urlp <- "http://www.genome.jp/dbget-bin/www_bget?-f+m+drug+" 71 | 72 | # Combine everything in an sdfset 73 | for(i in ids){ 74 | url <- paste0(urlp, i) 75 | tmp <- as(read.SDFset(url), "SDFset") 76 | cid(tmp) <- i 77 | sdfset <- c(sdfset, tmp) 78 | } 79 | return(sdfset) 80 | } 81 | # Now read the SDF information for all compounds in the research 82 | keggsdf <- importKEGG(colnames(drugTargetInteraction)) 83 | ``` 84 | 85 | ### Calculating the similarities 86 | 87 | The `fmcs` function in the `fmcsR` package allows to compute a similarity 88 | score between two compounds. It returns a few different similarity measures, 89 | including the Tanimoto coefficient. This coefficient turns out to be a 90 | valid kernel for chemical similarities 91 | ([Ralaivola et al, 2005](https://doi.org/10.1016/j.neunet.2005.07.009) , 92 | [Bajusz et al, 2015](https://doi.org/10.1186/s13321-015-0069-3)). So 93 | in this example we continue with the Tanimoto coefficients. 94 | 95 | ```{r tanimoto, eval = FALSE} 96 | # Keep in mind this needs some time to run! 97 | drugSim <- sapply(cid(keggsdf), 98 | function(x){ 99 | fmcsBatch(keggsdf[x], keggsdf, 100 | au = 0, bu = 0)[,"Tanimoto_Coefficient"] 101 | }) 102 | ``` 103 | 104 | All data is stored in the package and can be accessed using 105 | 106 | ```{r} 107 | data(drugtarget) 108 | ``` --------------------------------------------------------------------------------