[ { "path": ".Rbuildignore", "content": "^.*\\.Rproj$\n^\\.Rproj\\.user$\nmofapy2\nDockerfile\nsetup.py\n" }, { "path": ".gitattributes", "content": "*.sh text eol=lf\n" }, { "path": ".gitignore", "content": "# Resilio Sync\n.sync\n\n# MAC\n*Icon*\n.DS_Store\n\n# Rstudio projects\n*.Rproj\n.Rhistory\n\n*_site/\n# Pycharm\n.idea\n\n# HTML\n# *.html\n\n# Models outputs\n*.hdf5\n\n# Distribution / packaging\n.Python\nenv/\nbuild/\ndevelop-eggs/\ndist/\ndownloads/\neggs/\n.eggs/\nlib/\nlib64/\nparts/\nsdist/\nvar/\n*.pyc\n*.egg-info/\n.installed.cfg\n*.egg\n.Rproj.user\n*.Rcheck\n.Rproj.user\n.Rhistory\n.RData\n*.ipynb_checkpoints\n\n*_cache/\n*_files/\n\n*.tar.gz" }, { "path": ".gitmodules", "content": "[submodule \"mofapy2\"]\n\tpath = mofapy2\n\turl = git@github.com:bioFAM/mofapy2\n" }, { "path": "DESCRIPTION", "content": "Package: MOFA2\nType: Package\nTitle: Multi-Omics Factor Analysis v2\nVersion: 1.21.3\nMaintainer: Ricard Argelaguet \nAuthors@R: c(person(\"Ricard\", \"Argelaguet\", role = c(\"aut\", \"cre\"),\n email = \"ricard.argelaguet@gmail.com\",\n comment = c(ORCID = \"http://orcid.org/0000-0003-3199-3722\")),\n person(\"Damien\", \"Arnol\", role = \"aut\",\n email = \"damien.arnol@gmail.com\",\n comment = c(ORCID = \"http://orcid.org/0000-0003-2462-534X\")),\n person(\"Danila\", \"Bredikhin\", role = \"aut\",\n email = \"danila.bredikhin@embl.de\",\n comment = c(ORCID = \"https://orcid.org/0000-0001-8089-6983\")), \n person(\"Britta\", \"Velten\", role = \"aut\",\n \t\temail = \"britta.velten@gmail.com\",\n \t\tcomment = c(ORCID = \"http://orcid.org/0000-0002-8397-3515\"))\n )\nDate: 2023-01-12\nLicense: file LICENSE\nDescription: The MOFA2 package contains a collection of tools for training and analysing multi-omic factor analysis (MOFA). MOFA is a probabilistic factor model that aims to identify principal axes of variation from data sets that can comprise multiple omic layers and/or groups of samples. Additional time or space information on the samples can be incorporated using the MEFISTO framework, which is part of MOFA2. Downstream analysis functions to inspect molecular features underlying each factor, visualisation, imputation etc are available.\nEncoding: UTF-8\nDepends: R (>= 4.0)\nImports: rhdf5, dplyr, tidyr, reshape2, pheatmap, ggplot2, methods, RColorBrewer, cowplot, ggrepel, reticulate, HDF5Array, grDevices, stats, magrittr, forcats, utils, corrplot, DelayedArray, Rtsne, uwot, basilisk, stringi\nSuggests: knitr, testthat, Seurat, SeuratObject, ggpubr, foreach, psych, MultiAssayExperiment, SummarizedExperiment, SingleCellExperiment, ggrastr, mvtnorm, GGally, rmarkdown, data.table, tidyverse, BiocStyle, Matrix, markdown\nbiocViews: DimensionReduction, Bayesian, Visualization\nURL: https://biofam.github.io/MOFA2/index.html\nBugReports: https://github.com/bioFAM/MOFA2\nVignetteBuilder: knitr\nLazyData: false\nStagedInstall: no\nNeedsCompilation: yes\nRoxygenNote: 7.3.3\nSystemRequirements: Python (>=3), numpy, pandas, h5py, scipy, argparse, sklearn, mofapy2\n" }, { "path": "Dockerfile", "content": "FROM r-base:4.0.2\n\nWORKDIR /mofa2\nADD . /mofa2\n\nRUN apt-get update && apt-get install -f && apt-get install -y python3 python3-setuptools python3-dev python3-pip\nRUN apt-get install -y libcurl4-openssl-dev \nRUN apt-get install -y libcairo2-dev libfreetype6-dev libpng-dev libtiff5-dev libjpeg-dev libxt-dev libharfbuzz-dev libfribidi-dev\n\n# Install mofapy2\nRUN python3 -m pip install 'https://github.com/bioFAM/mofapy2/tarball/master'\n\n# Install bioconductor dependencies\nRUN R --vanilla -e \"\\\n if (!requireNamespace('BiocManager', quietly = TRUE)) install.packages('BiocManager', repos = 'https://cran.r-project.org'); \\\n sapply(c('rhdf5', 'dplyr', 'tidyr', 'reshape2', 'pheatmap', 'corrplot', \\\n 'ggplot2', 'ggbeeswarm', 'scales', 'GGally', 'doParallel', 'RColorBrewer', \\\n 'cowplot', 'ggrepel', 'foreach', 'reticulate', 'HDF5Array', 'DelayedArray', \\\n 'ggpubr', 'forcats', 'Rtsne', 'uwot', \\\n 'systemfonts', 'ragg', 'Cairo', 'ggrastr', 'basilisk', 'mvtnorm'), \\ \n BiocManager::install)\"\nRUN R CMD INSTALL --build .\n\nCMD []\n" }, { "path": "LICENSE", "content": " GNU LESSER GENERAL PUBLIC LICENSE\n Version 3, 29 June 2007\n\n Copyright (C) 2007 Free Software Foundation, Inc. \n Everyone is permitted to copy and distribute verbatim copies\n of this license document, but changing it is not allowed.\n\n\n This version of the GNU Lesser General Public License incorporates\nthe terms and conditions of version 3 of the GNU General Public\nLicense, supplemented by the additional permissions listed below.\n\n 0. Additional Definitions.\n\n As used herein, \"this License\" refers to version 3 of the GNU Lesser\nGeneral Public License, and the \"GNU GPL\" refers to version 3 of the GNU\nGeneral Public License.\n\n \"The Library\" refers to a covered work governed by this License,\nother than an Application or a Combined Work as defined below.\n\n An \"Application\" is any work that makes use of an interface provided\nby the Library, but which is not otherwise based on the Library.\nDefining a subclass of a class defined by the Library is deemed a mode\nof using an interface provided by the Library.\n\n A \"Combined Work\" is a work produced by combining or linking an\nApplication with the Library. The particular version of the Library\nwith which the Combined Work was made is also called the \"Linked\nVersion\".\n\n The \"Minimal Corresponding Source\" for a Combined Work means the\nCorresponding Source for the Combined Work, excluding any source code\nfor portions of the Combined Work that, considered in isolation, are\nbased on the Application, and not on the Linked Version.\n\n The \"Corresponding Application Code\" for a Combined Work means the\nobject code and/or source code for the Application, including any data\nand utility programs needed for reproducing the Combined Work from the\nApplication, but excluding the System Libraries of the Combined Work.\n\n 1. Exception to Section 3 of the GNU GPL.\n\n You may convey a covered work under sections 3 and 4 of this License\nwithout being bound by section 3 of the GNU GPL.\n\n 2. Conveying Modified Versions.\n\n If you modify a copy of the Library, and, in your modifications, a\nfacility refers to a function or data to be supplied by an Application\nthat uses the facility (other than as an argument passed when the\nfacility is invoked), then you may convey a copy of the modified\nversion:\n\n a) under this License, provided that you make a good faith effort to\n ensure that, in the event an Application does not supply the\n function or data, the facility still operates, and performs\n whatever part of its purpose remains meaningful, or\n\n b) under the GNU GPL, with none of the additional permissions of\n this License applicable to that copy.\n\n 3. Object Code Incorporating Material from Library Header Files.\n\n The object code form of an Application may incorporate material from\na header file that is part of the Library. You may convey such object\ncode under terms of your choice, provided that, if the incorporated\nmaterial is not limited to numerical parameters, data structure\nlayouts and accessors, or small macros, inline functions and templates\n(ten or fewer lines in length), you do both of the following:\n\n a) Give prominent notice with each copy of the object code that the\n Library is used in it and that the Library and its use are\n covered by this License.\n\n b) Accompany the object code with a copy of the GNU GPL and this license\n document.\n\n 4. Combined Works.\n\n You may convey a Combined Work under terms of your choice that,\ntaken together, effectively do not restrict modification of the\nportions of the Library contained in the Combined Work and reverse\nengineering for debugging such modifications, if you also do each of\nthe following:\n\n a) Give prominent notice with each copy of the Combined Work that\n the Library is used in it and that the Library and its use are\n covered by this License.\n\n b) Accompany the Combined Work with a copy of the GNU GPL and this license\n document.\n\n c) For a Combined Work that displays copyright notices during\n execution, include the copyright notice for the Library among\n these notices, as well as a reference directing the user to the\n copies of the GNU GPL and this license document.\n\n d) Do one of the following:\n\n 0) Convey the Minimal Corresponding Source under the terms of this\n License, and the Corresponding Application Code in a form\n suitable for, and under terms that permit, the user to\n recombine or relink the Application with a modified version of\n the Linked Version to produce a modified Combined Work, in the\n manner specified by section 6 of the GNU GPL for conveying\n Corresponding Source.\n\n 1) Use a suitable shared library mechanism for linking with the\n Library. A suitable mechanism is one that (a) uses at run time\n a copy of the Library already present on the user's computer\n system, and (b) will operate properly with a modified version\n of the Library that is interface-compatible with the Linked\n Version.\n\n e) Provide Installation Information, but only if you would otherwise\n be required to provide such information under section 6 of the\n GNU GPL, and only to the extent that such information is\n necessary to install and execute a modified version of the\n Combined Work produced by recombining or relinking the\n Application with a modified version of the Linked Version. (If\n you use option 4d0, the Installation Information must accompany\n the Minimal Corresponding Source and Corresponding Application\n Code. If you use option 4d1, you must provide the Installation\n Information in the manner specified by section 6 of the GNU GPL\n for conveying Corresponding Source.)\n\n 5. Combined Libraries.\n\n You may place library facilities that are a work based on the\nLibrary side by side in a single library together with other library\nfacilities that are not Applications and are not covered by this\nLicense, and convey such a combined library under terms of your\nchoice, if you do both of the following:\n\n a) Accompany the combined library with a copy of the same work based\n on the Library, uncombined with any other library facilities,\n conveyed under the terms of this License.\n\n b) Give prominent notice with the combined library that part of it\n is a work based on the Library, and explaining where to find the\n accompanying uncombined form of the same work.\n\n 6. Revised Versions of the GNU Lesser General Public License.\n\n The Free Software Foundation may publish revised and/or new versions\nof the GNU Lesser General Public License from time to time. Such new\nversions will be similar in spirit to the present version, but may\ndiffer in detail to address new problems or concerns.\n\n Each version is given a distinguishing version number. If the\nLibrary as you received it specifies that a certain numbered version\nof the GNU Lesser General Public License \"or any later version\"\napplies to it, you have the option of following the terms and\nconditions either of that published version or of any later version\npublished by the Free Software Foundation. If the Library as you\nreceived it does not specify a version number of the GNU Lesser\nGeneral Public License, you may choose any version of the GNU Lesser\nGeneral Public License ever published by the Free Software Foundation.\n\n If the Library as you received it specifies that a proxy can decide\nwhether future versions of the GNU Lesser General Public License shall\napply, that proxy's public statement of acceptance of any version is\npermanent authorization for you to choose that version for the\nLibrary.\n" }, { "path": "NAMESPACE", "content": "# Generated by roxygen2: do not edit by hand\n\nexport(\"%>%\")\nexport(\"covariates_names<-\")\nexport(\"factors_names<-\")\nexport(\"features_metadata<-\")\nexport(\"features_names<-\")\nexport(\"groups_names<-\")\nexport(\"samples_metadata<-\")\nexport(\"samples_names<-\")\nexport(\"views_names<-\")\nexport(add_mofa_factors_to_seurat)\nexport(calculate_contribution_scores)\nexport(calculate_variance_explained)\nexport(calculate_variance_explained_per_sample)\nexport(cluster_samples)\nexport(compare_elbo)\nexport(compare_factors)\nexport(correlate_factors_with_covariates)\nexport(covariates_names)\nexport(create_mofa)\nexport(create_mofa_from_MultiAssayExperiment)\nexport(create_mofa_from_Seurat)\nexport(create_mofa_from_SingleCellExperiment)\nexport(create_mofa_from_df)\nexport(create_mofa_from_matrix)\nexport(factors_names)\nexport(features_metadata)\nexport(features_names)\nexport(get_covariates)\nexport(get_data)\nexport(get_default_data_options)\nexport(get_default_mefisto_options)\nexport(get_default_model_options)\nexport(get_default_stochastic_options)\nexport(get_default_training_options)\nexport(get_dimensions)\nexport(get_elbo)\nexport(get_expectations)\nexport(get_factors)\nexport(get_group_kernel)\nexport(get_imputed_data)\nexport(get_interpolated_factors)\nexport(get_lengthscales)\nexport(get_scales)\nexport(get_variance_explained)\nexport(get_weights)\nexport(groups_names)\nexport(impute)\nexport(interpolate_factors)\nexport(load_model)\nexport(make_example_data)\nexport(plot_alignment)\nexport(plot_ascii_data)\nexport(plot_data_heatmap)\nexport(plot_data_overview)\nexport(plot_data_scatter)\nexport(plot_data_vs_cov)\nexport(plot_dimred)\nexport(plot_enrichment)\nexport(plot_enrichment_detailed)\nexport(plot_enrichment_heatmap)\nexport(plot_factor)\nexport(plot_factor_cor)\nexport(plot_factors)\nexport(plot_factors_vs_cov)\nexport(plot_group_kernel)\nexport(plot_interpolation_vs_covariate)\nexport(plot_sharedness)\nexport(plot_smoothness)\nexport(plot_top_weights)\nexport(plot_variance_explained)\nexport(plot_variance_explained_by_covariates)\nexport(plot_variance_explained_per_feature)\nexport(plot_weights)\nexport(plot_weights_heatmap)\nexport(plot_weights_scatter)\nexport(predict)\nexport(prepare_mofa)\nexport(run_enrichment)\nexport(run_mofa)\nexport(run_tsne)\nexport(run_umap)\nexport(samples_metadata)\nexport(samples_names)\nexport(select_model)\nexport(set_covariates)\nexport(subset_factors)\nexport(subset_features)\nexport(subset_groups)\nexport(subset_samples)\nexport(subset_views)\nexport(summarise_factors)\nexport(views_names)\nexportClasses(MOFA)\nexportMethods(\"covariates_names<-\")\nexportMethods(\"factors_names<-\")\nexportMethods(\"features_metadata<-\")\nexportMethods(\"features_names<-\")\nexportMethods(\"groups_names<-\")\nexportMethods(\"samples_metadata<-\")\nexportMethods(\"samples_names<-\")\nexportMethods(\"views_names<-\")\nexportMethods(covariates_names)\nexportMethods(factors_names)\nexportMethods(features_metadata)\nexportMethods(features_names)\nexportMethods(groups_names)\nexportMethods(samples_metadata)\nexportMethods(samples_names)\nexportMethods(views_names)\nimport(basilisk)\nimport(cowplot)\nimport(dplyr)\nimport(ggplot2)\nimport(grDevices)\nimport(methods)\nimport(pheatmap)\nimport(reshape2)\nimport(reticulate)\nimport(tidyr)\nimportFrom(DelayedArray,DelayedArray)\nimportFrom(HDF5Array,HDF5ArraySeed)\nimportFrom(RColorBrewer,brewer.pal)\nimportFrom(Rtsne,Rtsne)\nimportFrom(basilisk,BasiliskEnvironment)\nimportFrom(corrplot,corrplot)\nimportFrom(cowplot,plot_grid)\nimportFrom(dplyr,bind_rows)\nimportFrom(dplyr,desc)\nimportFrom(dplyr,filter)\nimportFrom(dplyr,group_by)\nimportFrom(dplyr,left_join)\nimportFrom(dplyr,mutate)\nimportFrom(dplyr,summarise)\nimportFrom(dplyr,top_n)\nimportFrom(forcats,fct_na_value_to_level)\nimportFrom(ggrepel,geom_text_repel)\nimportFrom(grDevices,colorRampPalette)\nimportFrom(magrittr,\"%>%\")\nimportFrom(magrittr,set_colnames)\nimportFrom(pheatmap,pheatmap)\nimportFrom(reshape2,melt)\nimportFrom(rhdf5,h5ls)\nimportFrom(rhdf5,h5read)\nimportFrom(stats,as.formula)\nimportFrom(stats,complete.cases)\nimportFrom(stats,cor)\nimportFrom(stats,dist)\nimportFrom(stats,kmeans)\nimportFrom(stats,median)\nimportFrom(stats,p.adjust)\nimportFrom(stats,p.adjust.methods)\nimportFrom(stats,pnorm)\nimportFrom(stats,pt)\nimportFrom(stats,quantile)\nimportFrom(stats,rbinom)\nimportFrom(stats,rnorm)\nimportFrom(stats,rpois)\nimportFrom(stats,sd)\nimportFrom(stats,var)\nimportFrom(stats,wilcox.test)\nimportFrom(stringi,stri_enc_mark)\nimportFrom(tidyr,gather)\nimportFrom(tidyr,spread)\nimportFrom(utils,as.relistable)\nimportFrom(utils,head)\nimportFrom(utils,modifyList)\nimportFrom(utils,relist)\nimportFrom(utils,tail)\nimportFrom(uwot,umap)\n" }, { "path": "R/AllClasses.R", "content": "\n##########################################################\n## Define a general class to store a MOFA trained model ##\n##########################################################\n\n#' @title Class to store a mofa model\n#' @description\n#' The \\code{MOFA} is an S4 class used to store all relevant data to analyse a MOFA model\n#' @slot data The input data\n#' @slot intercepts Feature intercepts\n#' @slot samples_metadata Samples metadata\n#' @slot features_metadata Features metadata.\n#' @slot imputed_data The imputed data.\n#' @slot expectations expected values of the factors and the loadings.\n#' @slot dim_red non-linear dimensionality reduction manifolds.\n#' @slot training_stats model training statistics.\n#' @slot data_options Data processing options.\n#' @slot training_options Model training options.\n#' @slot stochastic_options Stochastic variational inference options.\n#' @slot model_options Model options.\n#' @slot mefisto_options Options for the use of MEFISO\n#' @slot dimensions Dimensionalities of the model: \n#' M for the number of views, \n#' G for the number of groups,\n#' N for the number of samples (per group),\n#' C for the number of covariates per sample,\n#' D for the number of features (per view),\n#' K for the number of factors.\n#' @slot on_disk Logical indicating whether data is loaded from disk.\n#' @slot cache Cache.\n#' @slot status Auxiliary variable indicating whether the model has been trained.\n#' @slot covariates optional slot to store sample covariate for training in MEFISTO\n#' @slot covariates_warped optional slot to store warped sample covariate for training in MEFISTO\n#' @slot interpolated_Z optional slot to store interpolated factor values (used only with MEFISTO)\n#' @name MOFA\n#' @rdname MOFA\n#' @aliases MOFA-class\n#' @exportClass MOFA\n\nsetClassUnion(\"listOrNULL\",members = c(\"list\",\"NULL\"))\nsetClass(\"MOFA\", \n slots=c(\n data = \"list\",\n covariates = \"listOrNULL\",\n covariates_warped = \"listOrNULL\",\n intercepts = \"list\",\n imputed_data = \"list\",\n interpolated_Z = \"list\",\n samples_metadata = \"list\",\n features_metadata = \"list\",\n expectations = \"list\", \n training_stats = \"list\",\n data_options = \"list\",\n model_options = \"list\",\n training_options = \"list\",\n stochastic_options = \"list\",\n mefisto_options = \"list\",\n dimensions = \"list\",\n on_disk = \"logical\",\n dim_red = \"list\",\n cache = \"list\",\n status = \"character\"\n )\n)\n\n# Printing method\nsetMethod(\"show\", \"MOFA\", function(object) {\n \n if (!.hasSlot(object, \"dimensions\") || length(object@dimensions) == 0)\n stop(\"Error: dimensions not defined\")\n if (!.hasSlot(object, \"status\") || length(object@status) == 0)\n stop(\"Error: status not defined\")\n \n if (object@status == \"trained\") {\n nfactors <- object@dimensions[[\"K\"]]\n if(!.hasSlot(object, \"covariates\") || is.null(object@covariates)) {\n cat(sprintf(\"Trained MOFA with the following characteristics: \\n Number of views: %d \\n Views names: %s \\n Number of features (per view): %s \\n Number of groups: %d \\n Groups names: %s \\n Number of samples (per group): %s \\n Number of factors: %d \\n\",\n object@dimensions[[\"M\"]], paste(views_names(object), collapse=\" \"), paste(as.character(object@dimensions[[\"D\"]]), collapse=\" \"),\n object@dimensions[[\"G\"]], paste(groups_names(object), collapse=\" \"), paste(as.character(object@dimensions[[\"N\"]]), collapse=\" \"),\n nfactors))\n } else {\n cat(sprintf(\"Trained MEFISTO with the following characteristics: \\n Number of views: %d \\n Views names: %s \\n Number of features (per view): %s \\n Number of groups: %d \\n Groups names: %s \\n Number of samples (per group): %s \\n Number of covariates per sample: %d \\n Number of factors: %d \\n\",\n object@dimensions[[\"M\"]], paste(views_names(object), collapse=\" \"), paste(as.character(object@dimensions[[\"D\"]]), collapse=\" \"),\n object@dimensions[[\"G\"]], paste(groups_names(object), collapse=\" \"), paste(as.character(object@dimensions[[\"N\"]]), collapse=\" \"),\n object@dimensions[[\"C\"]], nfactors))\n }\n } else {\n if(!.hasSlot(object, \"covariates\") || is.null(object@covariates)) {\n cat(sprintf(\"Untrained MOFA model with the following characteristics: \\n Number of views: %d \\n Views names: %s \\n Number of features (per view): %s \\n Number of groups: %d \\n Groups names: %s \\n Number of samples (per group): %s \\n \",\n object@dimensions[[\"M\"]], paste(views_names(object), collapse=\" \"), paste(as.character(object@dimensions[[\"D\"]]), collapse=\" \"),\n object@dimensions[[\"G\"]], paste(groups_names(object), collapse=\" \"), paste(as.character(object@dimensions[[\"N\"]]), collapse=\" \")))\n } else {\n cat(sprintf(\"Untrained MEFISTO model with the following characteristics: \\n Number of views: %d \\n Views names: %s \\n Number of features (per view): %s \\n Number of groups: %d \\n Groups names: %s \\n Number of samples (per group): %s \\n Number of covariates per sample: %d \\n \",\n object@dimensions[[\"M\"]], paste(views_names(object), collapse=\" \"), paste(as.character(object@dimensions[[\"D\"]]), collapse=\" \"),\n object@dimensions[[\"G\"]], paste(groups_names(object), collapse=\" \"), paste(as.character(object@dimensions[[\"N\"]]), collapse=\" \"),\n object@dimensions[[\"C\"]]))\n }\n }\n cat(\"\\n\")\n})\n\n\n" }, { "path": "R/AllGenerics.R", "content": "\n##################\n## Factor Names ##\n##################\n\n#' @title factors_names: set and retrieve factor names\n#' @name factors_names\n#' @rdname factors_names\n#' @export\nsetGeneric(\"factors_names\", function(object) { standardGeneric(\"factors_names\") })\n\n#' @name factors_names\n#' @rdname factors_names\n#' @aliases factors_names<-\n#' @export\nsetGeneric(\"factors_names<-\", function(object, value) { standardGeneric(\"factors_names<-\") })\n\n#####################\n## Covariate Names ##\n#####################\n\n#' @title covariates_names: set and retrieve covariate names\n#' @name covariates_names\n#' @rdname covariates_names\n#' @export\nsetGeneric(\"covariates_names\", function(object) { standardGeneric(\"covariates_names\") })\n\n#' @name covariates_names\n#' @rdname covariates_names\n#' @aliases covariates_names<-\n#' @export\nsetGeneric(\"covariates_names<-\", function(object, value) { standardGeneric(\"covariates_names<-\") })\n\n\n##################\n## Sample Names ##\n##################\n\n#' @title samples_names: set and retrieve sample names\n#' @name samples_names\n#' @rdname samples_names\n#' @export\nsetGeneric(\"samples_names\", function(object) { standardGeneric(\"samples_names\") })\n\n#' @name samples_names\n#' @rdname samples_names\n#' @aliases samples_names<-\n#' @export\nsetGeneric(\"samples_names<-\", function(object, value) { standardGeneric(\"samples_names<-\") })\n\n#####################\n## Sample Metadata ##\n#####################\n\n#' @title samples_metadata: retrieve sample metadata\n#' @name samples_metadata\n#' @rdname samples_metadata\n#' @export\nsetGeneric(\"samples_metadata\", function(object) { standardGeneric(\"samples_metadata\") })\n\n#' @name samples_metadata\n#' @rdname samples_metadata\n#' @aliases samples_metadata<-\n#' @export\nsetGeneric(\"samples_metadata<-\", function(object, value) { standardGeneric(\"samples_metadata<-\") })\n\n###################\n## Feature Names ##\n###################\n\n#' @title features_names: set and retrieve feature names\n#' @name features_names\n#' @rdname features_names\n#' @export\nsetGeneric(\"features_names\", function(object) { standardGeneric(\"features_names\") })\n\n#' @name features_names\n#' @rdname features_names\n#' @aliases features_names<-\n#' @export\nsetGeneric(\"features_names<-\", function(object, value) { standardGeneric(\"features_names<-\") })\n\n######################\n## Feature Metadata ##\n######################\n\n#' @title features_metadata: set and retrieve feature metadata\n#' @name features_metadata\n#' @rdname features_metadata\n#' @export\nsetGeneric(\"features_metadata\", function(object) { standardGeneric(\"features_metadata\") })\n\n#' @name features_metadata\n#' @rdname features_metadata\n#' @aliases features_metadata<-\n#' @export\nsetGeneric(\"features_metadata<-\", function(object, value) { standardGeneric(\"features_metadata<-\") })\n\n################\n## View Names ##\n################\n\n#' @title views_names: set and retrieve view names\n#' @name views_names\n#' @rdname views_names\n#' @export\nsetGeneric(\"views_names\", function(object) { standardGeneric(\"views_names\") })\n\n#' @name views_names\n#' @rdname views_names\n#' @aliases views_names<-\n#' @export\nsetGeneric(\"views_names<-\", function(object, value) { standardGeneric(\"views_names<-\") })\n\n################\n## group Names ##\n################\n\n#' @title groups_names: set and retrieve group names\n#' @name groups_names\n#' @rdname groups_names\n#' @export\nsetGeneric(\"groups_names\", function(object) { standardGeneric(\"groups_names\") })\n\n#' @name groups_names\n#' @rdname groups_names\n#' @aliases groups_names<-\n#' @export\nsetGeneric(\"groups_names<-\", function(object, value) { standardGeneric(\"groups_names<-\") })\n" }, { "path": "R/QC.R", "content": "#' @importFrom stringi stri_enc_mark\n.quality_control <- function(object, verbose = FALSE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Check views names\n if (verbose == TRUE) message(\"Checking views names...\")\n stopifnot(!is.null(views_names(object)))\n stopifnot(!duplicated(views_names(object)))\n if (any(grepl(\"/\", views_names(object)))) {\n stop(\"Some of the views names contain `/` symbol, which is not supported.\n This can be fixed e.g. with:\n views_names(object) <- gsub(\\\"/\\\", \\\"-\\\", views_names(object))\")\n }\n \n # Check groups names\n if (verbose == TRUE) message(\"Checking groups names...\")\n if (any(grepl(\"/\", groups_names(object)))) {\n stop(\"Some of the groups names contain `/` symbol, which is not supported.\n This can be fixed e.g. with:\n groups_names(object) <- gsub(\\\"/\\\", \\\"-\\\", groups_names(object))\")\n }\n stopifnot(!is.null(groups_names(object)))\n stopifnot(!duplicated(groups_names(object)))\n \n # Check samples names\n if (verbose == TRUE) message(\"Checking samples names...\")\n stopifnot(!is.null(samples_names(object)))\n stopifnot(!duplicated(unlist(samples_names(object))))\n enc <- stringi::stri_enc_mark(unlist(samples_names(object)))\n if (any(enc!=\"ASCII\")) {\n tmp <- unname(unlist(samples_names(object))[enc!=\"ASCII\"])\n stop(sprintf(\"non-ascii characters detected in the following samples names, please rename them and run again create_mofa():\\n- %s \", paste(tmp, collapse=\"\\n- \")))\n print()\n }\n \n # Check features names\n if (verbose == TRUE) message(\"Checking features names...\")\n stopifnot(!is.null(features_names(object)))\n stopifnot(!duplicated(unlist(features_names(object))))\n enc <- stringi::stri_enc_mark(unlist(features_names(object)))\n if (any(enc!=\"ASCII\")) {\n tmp <- unname(unlist(features_names(object))[enc!=\"ASCII\"])\n stop(sprintf(\"non-ascii characters detected in the following features names, please rename them and run again create_mofa():\\n- %s \", paste(tmp, collapse=\"\\n- \")))\n print()\n }\n \n # Check dimensionalities in the input data\n if (verbose == TRUE) message(\"Checking dimensions...\")\n N <- object@dimensions$N\n D <- object@dimensions$D\n for (i in views_names(object)) {\n for (j in groups_names(object)) {\n stopifnot(ncol(object@data[[i]][[j]]) == N[[j]])\n stopifnot(nrow(object@data[[i]][[j]]) == D[[i]])\n stopifnot(length(colnames(object@data[[i]][[j]])) == N[[j]])\n stopifnot(length(rownames(object@data[[i]][[j]])) == D[[i]])\n }\n }\n \n # Check that there are no features with complete missing values (across all groups)\n if (object@status == \"untrained\" || object@data_options[[\"loaded\"]]) {\n if (verbose == TRUE) message(\"Checking there are no features with complete missing values...\")\n for (i in views_names(object)) {\n if (!(is(object@data[[i]][[1]], \"dgCMatrix\") || is(object@data[[i]][[1]], \"dgTMatrix\"))) {\n tmp <- as.data.frame(sapply(object@data[[i]], function(x) rowMeans(is.na(x)), simplify = TRUE))\n if (any(unlist(apply(tmp, 1, function(x) mean(x==1)))==1))\n warning(\"You have features which do not contain a single observation in any group, consider removing them...\")\n }\n }\n }\n \n # check dimensionalities of sample_covariates \n if (verbose == TRUE) message(\"Checking sample covariates...\")\n if(.hasSlot(object, \"covariates\") && !is.null(object@covariates)){\n stopifnot(ncol(object@covariates) == sum(object@dimensions$N))\n stopifnot(nrow(object@covariates) == object@dimensions$C)\n stopifnot(all(unlist(samples_names(object)) == colnames(object@covariates)))\n }\n \n # Sanity checks that are exclusive for an untrained model \n if (object@status == \"untrained\") {\n \n # Check features names\n if (verbose == TRUE) message(\"Checking features names...\")\n tmp <- lapply(object@data, function(x) unique(lapply(x,rownames)))\n for (x in tmp) stopifnot(length(x)==1)\n for (x in tmp) if (any(duplicated(x[[1]]))) stop(\"There are duplicated features names within the same view. Please rename\")\n all_names <- unname(unlist(tmp))\n duplicated_names <- unique(all_names[duplicated(all_names)])\n if (length(duplicated_names)>0) \n warning(\"There are duplicated features names across different views. We will add the suffix *_view* only for those features \n Example: if you have both TP53 in mRNA and mutation data it will be renamed to TP53_mRNA, TP53_mutation\")\n for (i in names(object@data)) {\n for (j in names(object@data[[i]])) {\n tmp <- which(rownames(object@data[[i]][[j]]) %in% duplicated_names)\n if (length(tmp)>0) {\n rownames(object@data[[i]][[j]])[tmp] <- paste(rownames(object@data[[i]][[j]])[tmp], i, sep=\"_\")\n }\n }\n }\n \n # Sanity checks that are exclusive for a trained model \n } else if (object@status == \"trained\") {\n # Check expectations\n if (verbose == TRUE) message(\"Checking expectations...\")\n stopifnot(all(c(\"W\", \"Z\") %in% names(object@expectations)))\n # if(.hasSlot(object, \"covariates\") && !is.null(object@covariates)) stopifnot(\"Sigma\" %in% names(object@expectations))\n stopifnot(all(sapply(object@expectations$W, is.matrix)))\n stopifnot(all(sapply(object@expectations$Z, is.matrix)))\n \n # Check for intercept factors\n if (object@data_options[[\"loaded\"]]) { \n if (verbose == TRUE) message(\"Checking for intercept factors...\")\n if (!is.null(object@data)) {\n factors <- do.call(\"rbind\",get_factors(object))\n r <- suppressWarnings( t(do.call('rbind', lapply(object@data, function(x) \n abs(cor(colMeans(do.call(\"cbind\",x),na.rm=TRUE),factors, use=\"pairwise.complete.obs\"))\n ))) )\n intercept_factors <- which(rowSums(r>0.75)>0)\n if (length(intercept_factors)) {\n warning(sprintf(\"Factor(s) %s are strongly correlated with the average expression of features for at least one of your omics. Such factors appear when there are differences in the total 'levels' between your samples, *sometimes* because of poor normalisation in the preprocessing steps.\\n\",paste(intercept_factors,collapse=\", \")))\n }\n }\n }\n \n # Check for correlated factors\n if (verbose == TRUE) message(\"Checking for highly correlated factors...\")\n Z <- do.call(\"rbind\",get_factors(object))\n op <- options(warn=-1) # suppress warnings\n \n noise <- matrix(rnorm(n=length(Z), mean=0, sd=1e-10), nrow(Z), ncol(Z))\n tmp <- cor(Z+noise); diag(tmp) <- NA\n options(op) # activate warnings again\n if (max(tmp,na.rm=TRUE)>0.5) {\n warning(\"The model contains highly correlated factors (see `plot_factor_cor(MOFAobject)`). \\nWe recommend that you train the model with less factors and that you let it train for a longer time.\\n\")\n }\n \n }\n \n return(object) \n}\n" }, { "path": "R/basilisk.R", "content": "# .mofapy2_dependencies <- c(\n# \"h5py==3.1.0\",\n# \"pandas==1.2.1\",\n# \"scikit-learn==0.24.1\",\n# \"dtw-python==1.1.10\"\n# )\n\n.mofapy2_dependencies <- c(\n \"python=3.12.12\",\n \"numpy=1.26.4\",\n \"scipy=1.12.0\",\n \"pandas=2.2.1\",\n \"h5py=3.10.0\",\n \"scikit-learn=1.4.0\",\n \"dtw-python=1.3.1\"\n)\n\n.mofapy2_version <- \"0.7.3\"\n\n#' @importFrom basilisk BasiliskEnvironment\nmofa_env <- BasiliskEnvironment(\"mofa_env\", pkgname=\"MOFA2\", packages=.mofapy2_dependencies, pip = paste0(\"mofapy2==\",.mofapy2_version))" }, { "path": "R/calculate_variance_explained.R", "content": "#' @title Calculate variance explained by the model\n#' @description This function takes a trained MOFA model as input and calculates the proportion of variance explained \n#' (i.e. the coefficient of determinations (R^2)) by the MOFA factors across the different views.\n#' @name calculate_variance_explained\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param views character vector with the view names, or numeric vector with view indexes. Default is 'all'\n#' @param groups character vector with the group names, or numeric vector with group indexes. Default is 'all'\n#' @param factors character vector with the factor names, or numeric vector with the factor indexes. Default is 'all'\n#' @return a list with matrices with the amount of variation explained per factor and view.\n#' @importFrom utils relist as.relistable\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Calculate variance explained (R2)\n#' r2 <- calculate_variance_explained(model)\n#' \n#' # Plot variance explained values (view as x-axis, and factor as y-axis)\n#' plot_variance_explained(model, x=\"view\", y=\"factor\")\n#' \n#' # Plot variance explained values (view as x-axis, and group as y-axis)\n#' plot_variance_explained(model, x=\"view\", y=\"group\")\n#' \n#' # Plot variance explained values for factors 1 to 3\n#' plot_variance_explained(model, x=\"view\", y=\"group\", factors=1:3)\n#' \n#' # Scale R2 values\n#' plot_variance_explained(model, max_r2 = 0.25)\ncalculate_variance_explained <- function(object, views = \"all\", groups = \"all\", factors = \"all\") {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if (any(object@model_options$likelihoods!=\"gaussian\"))\n stop(\"Not possible to recompute the variance explained estimates when using non-gaussian likelihoods.\")\n if (any(object@model_options$likelihoods!=\"gaussian\"))\n if (isFALSE(object@data_options$loaded)) stop(\"Data is not loaded, cannot compute variance explained.\")\n \n # Define factors, views and groups\n views <- .check_and_get_views(object, views)\n groups <- .check_and_get_groups(object, groups)\n factors <- .check_and_get_factors(object, factors)\n K <- length(factors)\n \n # Collect relevant expectations\n W <- get_weights(object, views=views, factors=factors)\n Z <- get_factors(object, groups=groups, factors=factors)\n Y <- lapply(get_data(object, add_intercept = FALSE)[views], function(view) view[groups])\n Y <- lapply(Y, function(x) lapply(x,t))\n \n # Replace masked values on Z by 0 (so that they do not contribute to predictions)\n for (g in groups) {\n Z[[g]][is.na(Z[[g]])] <- 0\n }\n \n # Calculate coefficient of determination per group and view\n r2_m <- tryCatch({\n lapply(groups, function(g) sapply(views, function(m) {\n a <- sum((as.matrix(Y[[m]][[g]]) - tcrossprod(Z[[g]], W[[m]]))**2, na.rm = TRUE)\n b <- sum(Y[[m]][[g]]**2, na.rm = TRUE)\n return(1 - a/b)\n })\n )}, error = function(err) {\n stop(paste0(\"Calculating explained variance doesn't work with the current version of DelayedArray.\\n\",\n \" Do not sort factors if you're trying to load the model (sort_factors = FALSE),\\n\",\n \" or load the full dataset into memory (on_disk = FALSE).\"))\n return(err)\n })\n r2_m <- .name_views_and_groups(r2_m, groups, views)\n \n # Lower bound is zero\n r2_m = lapply(r2_m, function(x){\n x[x < 0] = 0\n return(x)\n })\n \n # Calculate coefficient of determination per group, factor and view\n r2_mk <- lapply(groups, function(g) {\n tmp <- sapply(views, function(m) { sapply(factors, function(k) {\n a <- sum((as.matrix(Y[[m]][[g]]) - tcrossprod(Z[[g]][,k], W[[m]][,k]))**2, na.rm = TRUE)\n b <- sum(Y[[m]][[g]]**2, na.rm = TRUE)\n return(1 - a/b)\n })\n })\n tmp <- matrix(tmp, ncol = length(views), nrow = length(factors))\n colnames(tmp) <- views\n rownames(tmp) <- factors\n return(tmp)\n })\n names(r2_mk) <- groups\n \n # Lower bound is 0\n r2_mk = lapply(r2_mk, function(x){\n x[x < 0] = 0\n return(x)\n })\n \n # Transform from fraction to percentage\n r2_mk = utils::relist(unlist(utils::as.relistable(r2_mk)) * 100 ) \n r2_m = utils::relist(unlist(utils::as.relistable(r2_m)) * 100 )\n \n # Store results\n r2_list <- list(r2_total = r2_m, r2_per_factor = r2_mk)\n \n return(r2_list)\n}\n\n\n\n#' @title Calculate variance explained by the MOFA factors for each sample\n#' @description This function takes a trained MOFA model as input and calculates, **for each sample** the proportion of variance explained \n#' (i.e. the coefficient of determinations (R^2)) by the MOFA factors across the different views.\n#' @name calculate_variance_explained_per_sample\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param views character vector with the view names, or numeric vector with view indexes. Default is 'all'\n#' @param groups character vector with the group names, or numeric vector with group indexes. Default is 'all'\n#' @param factors character vector with the factor names, or numeric vector with the factor indexes. Default is 'all'\n#' @return a list with matrices with the amount of variation explained per sample and view.\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Calculate variance explained (R2)\n#' r2 <- calculate_variance_explained_per_sample(model)\n#'\ncalculate_variance_explained_per_sample <- function(object, views = \"all\", groups = \"all\", factors = \"all\") {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if (any(object@model_options$likelihoods!=\"gaussian\"))\n stop(\"Not possible to recompute the variance explained estimates when using non-gaussian likelihoods.\")\n if (any(object@model_options$likelihoods!=\"gaussian\"))\n if (isFALSE(object@data_options$loaded)) stop(\"Data is not loaded, cannot compute variance explained.\")\n \n # Define factors, views and groups\n views <- .check_and_get_views(object, views)\n groups <- .check_and_get_groups(object, groups)\n factors <- .check_and_get_factors(object, factors)\n \n # Collect relevant expectations\n W <- get_weights(object, views=views, factors=factors)\n Z <- get_factors(object, groups=groups, factors=factors)\n Y <- lapply(get_data(object, add_intercept = FALSE)[views], function(view) view[groups])\n Y <- lapply(Y, function(x) lapply(x,t))\n \n # Replace masked values on Z by 0 (so that they do not contribute to predictions)\n for (g in groups) { Z[[g]][is.na(Z[[g]])] <- 0 }\n \n # samples <- unlist(samples_names(object)[groups])\n samples <- samples_names(object)[groups]\n \n # Calculate coefficient of determination per sample and view\n r2 <- lapply(groups, function(g) {\n tmp <- sapply(views, function(m) {\n a <- rowSums((Y[[m]][[g]] - tcrossprod(Z[[g]],W[[m]]))**2, na.rm=TRUE)\n b <- rowSums(Y[[m]][[g]]**2, na.rm = TRUE)\n return(100*(1-a/b))\n })\n tmp <- matrix(tmp, ncol = length(views), nrow = length(samples[[g]]))\n tmp[tmp<0] <- 0\n colnames(tmp) <- views\n rownames(tmp) <- samples[[g]]\n return(tmp)\n }); names(r2) <- groups\n \n return(r2)\n}\n\n\n\n\n\n\n\n\n#' @title Plot variance explained by the model\n#' @description plots the variance explained by the MOFA factors across different views and groups, as specified by the user.\n#' Consider using cowplot::plot_grid(plotlist = ...) to combine the multiple plots that this function generates.\n#' @name plot_variance_explained\n#' @param object a \\code{\\link{MOFA}} object\n#' @param x character specifying the dimension for the x-axis (\"view\", \"factor\", or \"group\").\n#' @param y character specifying the dimension for the y-axis (\"view\", \"factor\", or \"group\").\n#' @param split_by character specifying the dimension to be faceted (\"view\", \"factor\", or \"group\").\n#' @param factors character vector with a factor name(s), or numeric vector with the index(es) of the factor(s). Default is \"all\".\n#' @param plot_total logical value to indicate if to plot the total variance explained (for the variable in the x-axis)\n#' @param min_r2 minimum variance explained for the color scheme (default is 0).\n#' @param max_r2 maximum variance explained for the color scheme.\n#' @param legend logical indicating whether to add a legend to the plot (default is TRUE).\n#' @param use_cache logical indicating whether to use cache (default is TRUE)\n#' @param ... extra arguments to be passed to \\code{\\link{calculate_variance_explained}}\n#' @import ggplot2\n#' @importFrom cowplot plot_grid\n#' @importFrom stats as.formula\n#' @importFrom reshape2 melt\n#' @return A list of \\code{\\link{ggplot}} objects (if \\code{plot_total} is TRUE) or a single \\code{\\link{ggplot}} object\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Calculate variance explained (R2)\n#' r2 <- calculate_variance_explained(model)\n#' \n#' # Plot variance explained values (view as x-axis, and factor as y-axis)\n#' plot_variance_explained(model, x=\"view\", y=\"factor\")\n#' \n#' # Plot variance explained values (view as x-axis, and group as y-axis)\n#' plot_variance_explained(model, x=\"view\", y=\"group\")\n#' \n#' # Plot variance explained values for factors 1 to 3\n#' plot_variance_explained(model, x=\"view\", y=\"group\", factors=1:3)\n#' \n#' # Scale R2 values\n#' plot_variance_explained(model, max_r2=0.25)\nplot_variance_explained <- function(object, x = \"view\", y = \"factor\", split_by = NA, plot_total = FALSE, \n factors = \"all\", min_r2 = 0, max_r2 = NULL, legend = TRUE, use_cache = TRUE, ...) {\n \n # Sanity checks \n if (length(unique(c(x, y, split_by))) != 3) { \n stop(paste0(\"Please ensure x, y, and split_by arguments are different.\\n\",\n \" Possible values are `view`, `group`, and `factor`.\"))\n }\n \n # Automatically fill split_by in\n if (is.na(split_by)) split_by <- setdiff(c(\"view\", \"factor\", \"group\"), c(x, y, split_by))\n \n # Calculate variance explained\n if ((use_cache) & .hasSlot(object, \"cache\") && (\"variance_explained\" %in% names(object@cache))) {\n r2_list <- object@cache$variance_explained\n } else {\n r2_list <- calculate_variance_explained(object, factors = factors, ...)\n }\n \n r2_mk <- r2_list$r2_per_factor\n \n # convert matrix to long data frame for ggplot2\n r2_mk_df <- melt(\n lapply(r2_mk, function(x)\n melt(as.matrix(x), varnames = c(\"factor\", \"view\"))\n ), id.vars=c(\"factor\", \"view\", \"value\")\n )\n colnames(r2_mk_df)[ncol(r2_mk_df)] <- \"group\"\n \n # Subset factors for plotting\n if ((length(factors) == 1) && (factors[1] == \"all\")) {\n factors <- factors_names(object)\n } else {\n if (is.numeric(factors)) {\n factors <- factors_names(object)[factors]\n } else { \n stopifnot(all(factors %in% factors_names(object)))\n }\n r2_mk_df <- r2_mk_df[r2_mk_df$factor %in% factors,]\n }\n \n r2_mk_df$factor <- factor(r2_mk_df$factor, levels = factors)\n r2_mk_df$group <- factor(r2_mk_df$group, levels = groups_names(object))\n r2_mk_df$view <- factor(r2_mk_df$view, levels = views_names(object))\n \n # Detect whether to split by group or by view\n groups <- names(r2_list$r2_total)\n views <- colnames(r2_list$r2_per_factor[[1]])\n \n # Set R2 limits\n if (!is.null(min_r2)) r2_mk_df$value[r2_mk_df$valuemax_r2] <- max_r2\n } else {\n max_r2 = max(r2_mk_df$value)\n }\n \n \n # Grid plot with the variance explained per factor and view/group\n p1 <- ggplot(r2_mk_df, aes(x=.data[[x]], y=.data[[y]])) + \n geom_tile(aes(fill=.data$value), color=\"black\") +\n facet_wrap(as.formula(sprintf('~%s',split_by)), nrow=1) +\n labs(x=\"\", y=\"\", title=\"\") +\n scale_fill_gradientn(colors=c(\"gray97\",\"darkblue\"), guide=\"colorbar\", limits=c(min_r2,max_r2)) +\n guides(fill=guide_colorbar(\"Var. (%)\")) +\n theme(\n axis.text.x = element_text(size=rel(1.0), color=\"black\"),\n axis.text.y = element_text(size=rel(1.1), color=\"black\"),\n axis.line = element_blank(),\n axis.ticks = element_blank(),\n panel.background = element_blank(),\n strip.background = element_blank(),\n strip.text = element_text(size=rel(1.0))\n )\n \n if (isFALSE(legend)) p1 <- p1 + theme(legend.position = \"none\")\n \n # remove facet title\n if (length(unique(r2_mk_df[,split_by]))==1) p1 <- p1 + theme(strip.text = element_blank())\n \n # Add total variance explained bar plots\n if (plot_total) {\n \n r2_m_df <- melt(lapply(r2_list$r2_total, function(x) lapply(x, function(z) z)),\n varnames=c(\"view\", \"group\"), value.name=\"R2\")\n colnames(r2_m_df)[(ncol(r2_m_df)-1):ncol(r2_m_df)] <- c(\"view\", \"group\")\n \n r2_m_df$group <- factor(r2_m_df$group, levels = MOFA2::groups_names(object))\n r2_m_df$view <- factor(r2_m_df$view, levels = views_names(object))\n \n # Barplots for total variance explained\n min_lim_bplt <- min(0, r2_m_df$R2)\n max_lim_bplt <- max(r2_m_df$R2)\n \n # Barplot with variance explained per view/group (across all factors)\n p2 <- ggplot(r2_m_df, aes(x=.data[[x]], y=.data$R2)) + \n # ggtitle(sprintf(\"%s\\nTotal variance explained per %s\", i, x)) +\n geom_bar(stat=\"identity\", fill=\"deepskyblue4\", color=\"black\", width=0.9) +\n facet_wrap(as.formula(sprintf('~%s',split_by)), nrow=1) +\n xlab(\"\") + ylab(\"Variance explained (%)\") +\n scale_y_continuous(limits=c(min_lim_bplt, max_lim_bplt), expand=c(0.005, 0.005)) +\n theme(\n axis.ticks.x = element_blank(),\n axis.text.x = element_text(color=\"black\"),\n axis.text.y = element_text(color=\"black\"),\n axis.title.y = element_text(color=\"black\"),\n axis.line = element_line(color=\"black\"),\n panel.background = element_blank(),\n strip.background = element_blank(),\n strip.text = element_text()\n )\n \n # remove facet title\n if (length(unique(r2_m_df[,split_by]))==1) p2 <- p2 + theme(strip.text = element_blank())\n \n # Bind plots \n plot_list <- list(p1,p2)\n \n } else {\n plot_list <- p1\n }\n \n return(plot_list)\n}\n\n\n#' @title Plot variance explained by the model for a set of features\n#' \n#' @description Returns a tile plot with a group on the X axis and a feature along the Y axis\n#' \n#' @name plot_variance_explained_per_feature\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param view a view name or index.\n#' @param features a vector with indices or names for features from the respective view, \n#' or number of top features to be fetched by their loadings across specified factors. \n#' \"all\" to plot all features.\n#' @param split_by_factor logical indicating whether to split R2 per factor or plot R2 jointly\n#' @param group_features_by column name of features metadata to group features by\n#' @param groups a vector with indices or names for sample groups (default is all)\n#' @param factors a vector with indices or names for factors (default is all)\n#' @param min_r2 minimum variance explained for the color scheme (default is 0).\n#' @param max_r2 maximum variance explained for the color scheme.\n#' @param legend logical indicating whether to add a legend to the plot (default is TRUE).\n#' @param return_data logical indicating whether to return the data frame to plot instead of plotting\n#' @param ... extra arguments to be passed to \\code{\\link{calculate_variance_explained}}\n#' @return ggplot object\n#' @import ggplot2\n#' @importFrom cowplot plot_grid\n#' @importFrom stats as.formula\n#' @importFrom reshape2 melt\n#' @export\n#' @examples \n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' plot_variance_explained_per_feature(model, view = 1)\n\nplot_variance_explained_per_feature <- function(object, view, features = 10,\n split_by_factor = FALSE, group_features_by = NULL,\n groups = \"all\", factors = \"all\",\n min_r2 = 0, max_r2 = NULL, legend = TRUE,\n return_data = FALSE, ...) {\n \n # Check that one view is requested\n view <- .check_and_get_views(object, view)\n if (length(view) != 1)\n stop(\"Please choose a single view to plot features from\")\n \n # Fetch loadings, factors, and data \n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Fetch relevant features)\n if (is.numeric(features) && (length(features) == 1)) {\n features <- as.integer(features)\n features <- .get_top_features_by_loading(object, view = view, factors = factors, nfeatures = features)\n } else if (is.character(features)) {\n if (features[1]==\"all\") features <- 1:object@dimensions$D[[view]]\n }\n features <- .check_and_get_features_from_view(object, view = view, features)\n \n # Collect relevant expectations\n groups <- .check_and_get_groups(object, groups)\n factors <- .check_and_get_factors(object, factors)\n # 1. Loadings: choose a view, one or multiple factors, and subset chosen features\n W <- get_weights(object, views = view, factors = factors)\n W <- lapply(W, function(W_m) W_m[rownames(W_m) %in% features,,drop=FALSE])\n # 2. Factor values: choose one or multiple groups and factors\n Z <- get_factors(object, groups = groups, factors = factors)\n # 3. Data: Choose a view, one or multiple groups, and subset chosen features\n # Y <- lapply(get_expectations(object, \"Y\")[view], function(Y_m) lapply(Y_m[groups], t))\n Y <- lapply(get_data(object, add_intercept = FALSE)[view], function(Y_m) lapply(Y_m[groups], t))\n Y <- lapply(Y, function(Y_m) lapply(Y_m, function(Y_mg) Y_mg[,colnames(Y_mg) %in% features,drop=FALSE]))\n \n # Replace masked values on Z by 0 (so that they do not contribute to predictions)\n for (g in groups) {\n Z[[g]][is.na(Z[[g]])] <- 0\n }\n \n m <- view # Use shorter notation when calculating R2\n \n if (split_by_factor) {\n \n # Calculate coefficient of determination per group, factor and feature\n r2_gdk <- lapply(groups, function(g) {\n r2_g <- sapply(features, function(d) { \n sapply(factors, function(k) {\n a <- sum((as.matrix(Y[[m]][[g]][,d,drop=FALSE]) - tcrossprod(Z[[g]][,k,drop=FALSE], W[[m]][d,k,drop=FALSE]))**2, na.rm = TRUE)\n b <- sum(Y[[m]][[g]][,d,drop=FALSE]**2, na.rm = TRUE)\n return(1 - a/b)\n })\n })\n r2_g <- matrix(r2_g, ncol = length(features), nrow = length(factors))\n colnames(r2_g) <- features\n rownames(r2_g) <- factors\n # Lower bound is zero\n r2_g[r2_g < 0] <- 0\n r2_g\n })\n names(r2_gdk) <- groups\n \n # Convert matrix to long data frame for ggplot2\n r2_gdk_df <- do.call(rbind, r2_gdk)\n r2_gdk_df <- data.frame(r2_gdk_df, \n \"group\" = rep(groups, lapply(r2_gdk, nrow)),\n \"factor\" = rownames(r2_gdk_df))\n r2_gdk_df <- melt(r2_gdk_df, id.vars = c(\"group\", \"factor\"))\n colnames(r2_gdk_df) <- c(\"group\", \"factor\", \"feature\", \"value\")\n \n r2_gdk_df$group <- factor(r2_gdk_df$group, levels = unique(r2_gdk_df$group))\n \n r2_df <- r2_gdk_df\n \n } else {\n \n # Calculate coefficient of determination per group and feature\n r2_gd <- lapply(groups, function(g) {\n r2_g <- lapply(features, function(d) {\n a <- sum((as.matrix(Y[[m]][[g]][,d,drop=FALSE]) - tcrossprod(Z[[g]], W[[m]][d,,drop=FALSE]))**2, na.rm = TRUE)\n b <- sum(Y[[m]][[g]][,d,drop=FALSE]**2, na.rm = TRUE)\n return(1 - a/b)\n })\n names(r2_g) <- features\n # Lower bound is zero\n r2_g[r2_g < 0] <- 0\n r2_g\n })\n names(r2_gd) <- groups\n \n # Convert matrix to long data frame for ggplot2\n tmp <- as.matrix(data.frame(lapply(r2_gd, unlist))) \n colnames(tmp) <- groups\n r2_gd_df <- melt(tmp)\n colnames(r2_gd_df) <- c(\"feature\", \"group\", \"value\")\n \n r2_gd_df$group <- factor(r2_gd_df$group, levels = unique(r2_gd_df$group))\n \n r2_df <- r2_gd_df\n \n }\n \n # Transform from fraction to percentage\n r2_df$value <- 100*r2_df$value\n \n # Calculate minimum R2 to display\n if (!is.null(min_r2)) {\n r2_df$value[r2_df$valuemax_r2] <- max_r2\n } else {\n max_r2 <- max(r2_df$value)\n }\n \n # Group features\n if (!is.null(group_features_by)) {\n features_indices <- match(r2_df$feature, features_metadata(object)$feature)\n features_grouped <- features_metadata(object)[,group_features_by,drop=FALSE][features_indices,,drop=FALSE]\n # If features grouped using multiple variables, concatenate them\n if (length(group_features_by) > 1) {\n features_grouped <- apply(features_grouped, 1, function(row) paste0(row, collapse=\"_\"))\n } else {\n features_grouped <- features_grouped[,group_features_by,drop=TRUE]\n }\n r2_df[\"feature_group\"] <- features_grouped\n }\n \n if (return_data)\n return(r2_df)\n \n if (split_by_factor) {\n r2_df$factor <- factor(r2_df$factor, levels = factors_names(object))\n }\n \n # Grid plot with the variance explained per feature in every group\n p <- ggplot(r2_df, aes(x = .data$group, y = .data$feature)) + \n geom_tile(aes(fill = .data$value), color = \"black\") +\n guides(fill = guide_colorbar(\"R2 (%)\")) +\n labs(x = \"\", y = \"\", title = \"\") +\n scale_fill_gradientn(colors=c(\"gray97\",\"darkblue\"), guide=\"colorbar\", limits=c(min_r2, max_r2)) +\n theme_classic() +\n theme(\n axis.text = element_text(size = 12),\n axis.line = element_blank(),\n axis.ticks = element_blank(),\n strip.text = element_text(size = 12),\n )\n \n if (!is.null(group_features_by) && split_by_factor) {\n p <- p + facet_grid(feature_group ~ factor, scales = \"free_y\")\n } else if (split_by_factor) {\n p <- p + facet_wrap(~factor, nrow = 1)\n } else if (!is.null(group_features_by)) {\n p <- p + facet_wrap(~feature_group, ncol = 1, scales = \"free\")\n }\n \n if (!legend)\n p <- p + theme(legend.position = \"none\")\n \n return(p)\n}\n" }, { "path": "R/cluster_samples.R", "content": "\n##########################################################\n## Functions to cluster samples based on latent factors ##\n##########################################################\n\n#' @title K-means clustering on samples based on latent factors\n#' @name cluster_samples\n#' @description MOFA factors are continuous in nature but they can be used to predict discrete clusters of samples. \\cr\n#' The clustering can be performed in a single factor, which is equivalent to setting a manual threshold.\n#' More interestingly, it can be done using multiple factors, where multiple sources of variation are aggregated. \\cr\n#' Importantly, this type of clustering is not weighted and does not take into account the different importance of the latent factors. \n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param k number of clusters (integer).\n#' @param factors character vector with the factor name(s), or numeric vector with the index of the factor(s) to use. \n#' Default is 'all'\n#' @param ... extra arguments passed to \\code{\\link{kmeans}}\n#' @details In some cases, due to model technicalities, samples can have missing values in the latent factor space. \n#' In such a case, these samples are currently ignored in the clustering procedure.\n#' @return output from \\code{\\link{kmeans}} function\n#' @importFrom stats kmeans\n#' @export \n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Cluster samples in the factor space using factors 1 to 3 and K=2 clusters \n#' clusters <- cluster_samples(model, k=2, factors=1:3)\ncluster_samples <- function(object, k, factors = \"all\", ...) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Define factors\n factors <- .check_and_get_factors(object, factors)\n \n # Collect relevant data\n Z <- get_factors(object, factors=factors)\n if (is(Z, \"list\")) Z <- do.call(rbind, Z)\n N <- nrow(Z)\n \n # For now remove sample with missing values on factors\n # (TO-DO) incorporate a clustering function that is able to cope with missing values\n haveAllZ <- apply(Z, 1, function(x) all(!is.na(x)))\n if(!all(haveAllZ)) warning(paste(\"Removing\", sum(!haveAllZ), \"samples with missing values on at least one factor\"))\n Z <- Z[haveAllZ,]\n \n # Perform k-means clustering\n kmeans.out <- kmeans(Z, centers=k, ...)\n\n return(kmeans.out) \n\n}\n" }, { "path": "R/compare_models.R", "content": "\n################################################\n## Functions to compare different MOFA models ##\n################################################\n\n\n#' @title Plot the correlation of factors between different models\n#' @name compare_factors\n#' @description Different \\code{\\link{MOFA}} objects are compared in terms of correlation between their factors.\n#' @param models a list with \\code{\\link{MOFA}} objects.\n#' @param ... extra arguments passed to pheatmap\n#' @details If assessing model robustness across trials, the output should look like a block diagonal matrix, \n#' suggesting that all factors are robustly detected in all model instances.\n#' @return Plots a heatmap of the Pearson correlation between latent factors across all input models.\n#' @importFrom stats cor\n#' @importFrom pheatmap pheatmap\n#' @importFrom grDevices colorRampPalette\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model1 <- load_model(file)\n#' model2 <- load_model(file)\n#' \n#' # Compare factors between models\n#' compare_factors(list(model1,model2))\ncompare_factors <- function(models, ...) {\n \n # Sanity checks\n if(!is.list(models))\n stop(\"'models' has to be a list\")\n if (!all(sapply(models, function (l) is(l, \"MOFA\"))))\n stop(\"Each element of the the list 'models' has to be an instance of MOFA\")\n\n # Give generic names if no names present\n if(is.null(names(models))) names(models) <- paste(\"model\", seq_len(length(models)), sep=\"\")\n\n # Get latent factors\n LFs <- lapply(seq_along(models), function(i){\n do.call(rbind, get_factors(models[[i]]))\n })\n \n # Sanity checks\n if (is.null(Reduce(intersect,lapply(LFs, rownames))))\n stop(\"No common samples in all models for comparison\")\n\n # Align samples between models\n samples_names <- Reduce(intersect, lapply(LFs, rownames))\n LFs <- lapply(LFs, function(z) {\n z[samples_names,,drop=FALSE]\n })\n \n # Rename factors\n for (i in seq_along(LFs))\n colnames(LFs[[i]]) <- paste(names(models)[i], colnames(LFs[[i]]), sep=\"_\")\n\n # calculate correlation between factors across models\n corLFs <- cor(Reduce(cbind, LFs), use=\"complete.obs\")\n corLFs[is.na(corLFs)] <- 0\n corLFs <- abs(corLFs)\n\n # Plot heatmap\n breaksList <- seq(0,1, by=0.01)\n colors <- colorRampPalette(c(\"white\",RColorBrewer::brewer.pal(9,name=\"YlOrRd\")))(length(breaksList))\n pheatmap(corLFs, color = colors, breaks = breaksList, ...)\n}\n\n\n\n#' @title Compare different trained \\code{\\link{MOFA}} objects in terms of the final value of the ELBO statistics and number of inferred factors\n#' @name compare_elbo\n#' @description Different objects of \\code{\\link{MOFA}} are compared in terms of the final value of the ELBO statistics.\n#' For model selection the model with the highest ELBO value is selected.\n#' @param models a list containing \\code{\\link{MOFA}} objects.\n#' @param log logical indicating whether to plot the log of the ELBO.\n#' @param return_data logical indicating whether to return a data.frame with the ELBO values per model\n#' @return A \\code{\\link{ggplot}} object or the underlying data.frame if return_data is TRUE\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model1 <- load_model(file)\n#' model2 <- load_model(file)\n#' \n#' # Compare ELBO between models\n#' \\dontrun{compare_elbo(list(model1,model2))}\ncompare_elbo <- function(models, log = FALSE, return_data = FALSE) {\n \n # Sanity checks\n if(!is.list(models))\n stop(\"'models' has to be a list\")\n if (!all(sapply(models, function (l) is(l, \"MOFA\"))))\n stop(\"Each element of the the list 'models' has to be an instance of MOFA\")\n \n # Give generic names if no names present\n if (is.null(names(models))) names(models) <- paste0(\"model_\", seq_along(models))\n \n # Get ELBO values\n elbo_vals <- sapply(models, get_elbo)\n \n # Generate plot\n df <- data.frame(\n ELBO = elbo_vals, \n model = names(models)\n )\n \n \n # take the log\n if (log) {\n message(\"Plotting the log2 of the negative of the ELBO (the higher the better)\")\n df$ELBO <- log2(-df$ELBO)\n }\n \n if (all(df$ELBO<0)) {\n df$ELBO <- abs(df$ELBO)\n message(\"Plotting the absolute value of the ELBO for every model (the smaller the better)\")\n} else {\n message(\"Plotting the ELBO for every model (the higher the better)\")\n }\n \n # return data\n if (return_data) return(df)\n \n gg <- ggplot(df, aes(x=.data$model, y=.data$ELBO)) + \n geom_bar(stat=\"identity\", color=\"black\", fill=\"grey70\") +\n labs(x=\"\", y=\"Evidence Lower Bound (ELBO)\") +\n theme_classic()\n \n return(gg)\n}\n\n\n\n#' @title Select a model from a list of trained \\code{\\link{MOFA}} objects based on the best ELBO value\n#' @name select_model\n#' @description Different objects of \\code{\\link{MOFA}} are compared in terms of the final value of the ELBO statistics\n#' and the model with the highest ELBO value is selected.\n#' @param models a list containing \\code{\\link{MOFA}} objects.\n#' @param plot boolean indicating whether to show a plot of the ELBO for each model instance\n#' @return A \\code{\\link{MOFA}} object\n#' @export\nselect_model <- function(models, plot = FALSE) {\n # Sanity checks\n if(!is.list(models))\n stop(\"'models' has to be a list\")\n if (!all(sapply(models, function (l) is(l, \"MOFA\"))))\n stop(\"Each element of the the list 'models' has to be an instance of MOFA\")\n\n elbo_vals <- sapply(models, get_elbo)\n if(plot) compare_elbo(models)\n models[[which.max(elbo_vals)]]\n}\n" }, { "path": "R/contribution_scores.R", "content": "#' @title Calculate contribution scores for each view in each sample\n#' @description This function calculates, *for each sample* how much each view contributes to its location in the latent manifold, what we call \\emph{contribution scores}\n#' @name calculate_contribution_scores\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param views character vector with the view names, or numeric vector with view indexes. Default is 'all'\n#' @param groups character vector with the group names, or numeric vector with group indexes. Default is 'all'\n#' @param factors character vector with the factor names, or numeric vector with the factor indexes. Default is 'all'\n#' @param scale logical indicating whether to scale the sample-wise variance explained values by the total amount of variance explained per view. \n#' This effectively normalises each view by its total variance explained. It is important when different amounts of variance is explained for each view (check with \\code{plot_variance_explained(..., plot_total=TRUE)})\n#' @details Contribution scores are calculated in three steps:\n#' \\itemize{\n#' \\item{\\strong{Step 1}: calculate variance explained for each cell i and each view m (\\eqn{R_{im}}), using all factors}\n#' \\item{\\strong{Step 2} (optional): scale values by the total variance explained for each view}\n#' \\item{\\strong{Step 3}: calculate contribution score (\\eqn{C_{im}}) for cell i and view m as: \\deqn{C_{im} = \\frac{R2_{im}}{\\sum_{m} R2_{im}} } }\n#' }\n#' Note that contribution scores can be calculated using any number of data modalities, but it is easier to interpret when you specify two. \\cr\n#' Please note that this functionality is still experimental, contact the authors if you have questions.\n#' @return adds the contribution scores to the metadata slot (\\code{samples_metadata(MOFAobject)}) and to the \\code{MOFAobject@cache} slot\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' model <- calculate_contribution_scores(model)\n#'\ncalculate_contribution_scores <- function(object, views = \"all\", groups = \"all\", factors = \"all\", scale = TRUE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if (any(object@model_options$likelihoods!=\"gaussian\"))\n stop(\"Not possible to compute contribution scores when using non-gaussian likelihoods.\")\n\n # Define factors, views and groups\n views <- .check_and_get_views(object, views)\n if (length(views)<2) stop(\"contribution scores only make sense when having at least 2 views\")\n groups <- .check_and_get_groups(object, groups)\n factors <- .check_and_get_factors(object, factors)\n if (length(factors)<2) stop(\"contribution scores only make sense when having at least 2 factors\")\n \n # fetch variance explained values\n r2.per.sample <- calculate_variance_explained_per_sample(object, factors=factors, views = views, groups = groups)\n \n # scale the variance explained values to the total amount of variance explained per view\n if (scale) {\n r2.per.view <- get_variance_explained(object, factors=factors, views = views, groups = groups)[[\"r2_total\"]]\n r2.per.sample <- lapply(1:length(groups), function(g) sweep(r2.per.sample[[g]], 2, r2.per.view[[g]],\"/\"))\n }\n \n # concatenate groups\n r2.per.sample <- do.call(\"rbind\",r2.per.sample)\n \n # Calculate the fraction of (relative) variance explained for each view in each cell -> the contribution score\n contribution_scores <- r2.per.sample / rowSums(r2.per.sample)\n \n # Add contribution scores to the sample metadata\n for (i in colnames(contribution_scores)) {\n object <- .add_column_to_metadata(object, contribution_scores[,i], paste0(i,\"_contribution\"))\n }\n # Add contribution scores to the cache\n object@cache[[\"contribution_scores\"]] <- contribution_scores\n \n \n return(object)\n \n}\n\n\nget_contribution_scores <- function(object, groups = \"all\", views = \"all\", factors = \"all\", \n as.data.frame = FALSE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Get factors and groups\n groups <- .check_and_get_groups(object, groups)\n views <- .check_and_get_views(object, views)\n factors <- .check_and_get_factors(object, factors)\n \n # Fetch\n if (.hasSlot(object, \"cache\") && (\"contribution_scores\" %in% names(object@cache))) {\n scores_list <- object@cache[[\"contribution_scores\"]]\n } else {\n scores_list <- calculate_contribution_scores(object, factors = factors, views = views, groups = groups)\n }\n \n # Convert to data.frame format\n if (as.data.frame) {\n scores <- reshape2::melt( do.call(\"rbind\",scores_list) )\n colnames(scores) <- c(\"sample\", \"view\", \"value\")\n } else {\n scores <- scores_list\n }\n \n return(scores)\n \n}\n\nplot_contribution_scores <- function(object, samples = \"all\", group_by = NULL, return_data = FALSE, ...) {\n\n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # (TO-DO) get samples\n \n # get contribution scores\n scores <- get_contribution_scores(object, as.data.frame = TRUE, ...)\n \n # TO-DO: CHECK THAT GROUP IS A CHARACTER/FACTOR\n # individual samples\n if (is.null(group_by)) {\n \n to.plot <- scores\n if (return_data) return(to.plot)\n p <- ggplot(to.plot, aes(x=.data$view, y=.data$value)) +\n geom_bar(aes(fill=view), stat=\"identity\", color=\"black\") +\n facet_wrap(~sample) +\n labs(x=\"\", y=\"Contribution score\") +\n theme_classic() +\n theme(\n axis.text.x = element_blank(),\n axis.ticks.x = element_blank(),\n legend.position = \"top\",\n legend.title = element_blank()\n )\n return(p)\n \n # group samples\n } else {\n \n to.plot <- merge(scores, object@samples_metadata[,c(\"sample\",group_by)], by=\"sample\")\n if (return_data) return(to.plot)\n p <- ggplot(to.plot, aes(x=.data$view, y=.data$value)) +\n geom_boxplot(aes(fill=view)) +\n facet_wrap(as.formula(paste(\"~\", group_by))) +\n labs(x=\"\", y=\"Contribution score\") +\n theme_classic() +\n theme(\n axis.text.x = element_blank(),\n axis.ticks.x = element_blank(),\n legend.position = \"top\",\n legend.title = element_blank()\n )\n return(p)\n }\n}" }, { "path": "R/correlate_covariates.R", "content": "#' @title Plot correlation of factors with external covariates\n#' @name correlate_factors_with_covariates\n#' @description Function to correlate factor values with external covariates.\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param covariates \n#' \\itemize{\n#' \\item{\\strong{data.frame}: a data.frame where the samples are stored in the rows and the covariates are stored in the columns. \n#' Use row names for sample names and column names for covariate names. Columns values must be numeric. }\n#' \\item{\\strong{character vector}: character vector with names of columns that are present in the sample metadata (\\code{samples_metadata(model)}}\n#' }\n#' @param factors character vector with the factor name(s), or numeric vector with the index of the factor(s) to use. Default is 'all'.\n#' @param groups character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use samples from all groups.\n#' @param abs logical indicating whether to take the absolute value of the correlation coefficient (default is \\code{TRUE}).\n#' @param plot character indicating whether to plot Pearson correlation coefficients (\\code{plot=\"r\"}) or log10 adjusted p-values (\\code{plot=\"log_pval\"}).\n#' @param return_data logical indicating whether to return the correlation results instead of plotting\n#' @param transpose logical indicating whether to transpose the plot\n#' @param alpha p-value threshold\n#' @param ... extra arguments passed to \\code{\\link[corrplot]{corrplot}} (if \\code{plot==\"r\"}) or \\code{\\link[pheatmap]{pheatmap}} (if \\code{plot==\"log_pval\"}).\n#' @importFrom pheatmap pheatmap\n#' @importFrom corrplot corrplot\n#' @return A \\code{\\link[corrplot]{corrplot}} (if \\code{plot==\"r\"}) or \\code{\\link[pheatmap]{pheatmap}} (if \\code{plot==\"log_pval\"}) or the underlying data.frame if return_data is TRUE\n#' @export\ncorrelate_factors_with_covariates <- function(object, covariates, factors = \"all\", groups = \"all\", \n abs = FALSE, plot = c(\"log_pval\",\"r\"), \n alpha = 0.05, return_data = FALSE, transpose = FALSE, ...) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n groups <- .check_and_get_groups(object,groups)\n \n # Get covariates\n metadata <- samples_metadata(object)\n metadata <- metadata[metadata$group%in%groups,]\n if (is.character(covariates)) {\n stopifnot(all(covariates %in% colnames(metadata)))\n covariates <- metadata[,covariates,drop=FALSE]\n } else if (is.data.frame(covariates)) {\n samples <- metadata$sample\n if (is.null(rownames(covariates))) stop(\"The 'covariates' data.frame does not have samples names\")\n stopifnot(all(rownames(covariates) %in% samples))\n covariates <- metadata[match(rownames(covariates), metadata$sample),]\n } else {\n stop(\"covariates argument not recognised. Please read the documentation: ?correlate_factors_with_covariates\")\n }\n \n # convert character columns to factors\n cols <- which(sapply(covariates, is.character))\n if (length(cols>=1)) {\n covariates[cols] <- lapply(covariates[cols], as.factor)\n }\n \n # convert all columns to numeric\n cols <- which(!sapply(covariates,class)%in%c(\"numeric\",\"integer\"))\n if (length(cols>=1)) {\n cols.factor <- which(sapply(covariates,class)==\"factor\")\n covariates[cols] <- lapply(covariates[cols], as.numeric)\n warning(\"There are non-numeric values in the covariates data.frame, converting to numeric...\")\n covariates[cols] <- lapply(covariates[cols], as.numeric)\n }\n stopifnot(all(sapply(covariates,class)%in%c(\"numeric\",\"integer\")))\n \n # Get factors\n factors <- .check_and_get_factors(object, factors)\n Z <- get_factors(object, factors = factors, groups = groups, as.data.frame=FALSE)\n Z <- do.call(rbind, Z)\n \n # correlation\n cor <- psych::corr.test(Z, covariates, method = \"pearson\", adjust = \"BH\")\n \n # plot \n plot <- match.arg(plot)\n \n if (plot==\"r\") {\n stat <- cor$r\n if (abs) stat <- abs(stat)\n if (transpose) stat <- t(stat)\n if (return_data) return(stat)\n corrplot(stat, tl.col = \"black\", title=\"Pearson correlation coefficient\", ...)\n \n } else if (plot==\"log_pval\") {\n stat <- cor$p\n stat[stat>alpha] <- 1.0\n if (all(stat==1.0)) stop(\"All p-values are 1.0, nothing to plot\")\n stat <- -log10(stat)\n stat[is.infinite(stat)] <- 1000\n if (transpose) stat <- t(stat)\n if (return_data) return(stat)\n col <- colorRampPalette(c(\"lightgrey\", \"red\"))(n=100)\n pheatmap::pheatmap(stat, main=\"log10 adjusted p-values\", cluster_rows = FALSE, color=col, ...)\n \n } else {\n stop(\"'plot' argument not recognised. Please read the documentation: ?correlate_factors_with_covariates\")\n }\n \n}\n\n\n\n#' @title Summarise factor values using external groups\n#' @name summarise_factors\n#' @description Function to summarise factor values using a discrete grouping of samples.\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param df a data.frame with the columns \"sample\" and \"level\", where level is a factor with discrete group assignments for each sample.\n#' @param factors character vector with the factor name(s), or numeric vector with the index of the factor(s) to use. Default is 'all'.\n#' @param groups character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use samples from all groups.\n#' @param abs logical indicating whether to take the absolute value of the factors (default is \\code{FALSE}).\n#' @param return_data logical indicating whether to return the fa instead of plotting\n#' @import ggplot2\n#' @importFrom dplyr group_by summarise mutate\n#' @importFrom stats median\n#' @importFrom magrittr %>%\n#' @return A \\code{\\link{ggplot}} object or a \\code{data.frame} if return_data is TRUE\n#' @export\nsummarise_factors <- function(object, df, factors = \"all\", groups = \"all\", abs = FALSE, return_data = FALSE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(is.data.frame(df))\n stopifnot((c(\"sample\",\"level\")%in%colnames(df)))\n stopifnot(df$sample %in% unlist(samples_names(object)))\n stopifnot(length(df$level)>1)\n df$level <- as.factor(df$level)\n \n # Get factors\n factors <- .check_and_get_factors(object, factors)\n groups <- .check_and_get_groups(object, groups)\n factors_df <- get_factors(object, factors = factors, groups = groups, as.data.frame=TRUE) %>% \n group_by(factor) %>% mutate(value=value/max(abs(value),na.rm=TRUE)) # Scale factor values\n \n # Merge data.frames\n to.plot <- merge(factors_df, df, by=\"sample\") %>% \n group_by(level,factor,group) %>%\n summarise(value=median(value,na.rm=TRUE))\n \n if (abs) {\n to.plot$value <- abs(to.plot$value)\n }\n \n \n # Plot\n if (length(unique(factors_df$group))>1) {\n to.plot$group <- factor(to.plot$group, levels=groups)\n p <- ggplot(to.plot, aes(x=.data$group, y=.data$level, fill=.data$value)) +\n facet_wrap(~factor)\n } else {\n p <- ggplot(to.plot, aes(x=.data$factor, y=.data$level, fill=.data$value))\n }\n \n p <- p +\n geom_tile() +\n theme_classic() +\n labs(x=\"\", y=\"\", fill=\"Score\") +\n theme(\n axis.text.x = element_text(color=\"black\", angle=30, hjust=1),\n axis.text.y = element_text(color=\"black\")\n )\n\n if (abs) {\n p <- p + scale_fill_gradient2(low = \"white\", high = \"red\")\n } else {\n # center the color scheme at 0\n p <- p + scale_fill_distiller(type = \"div\", limit = max(abs(to.plot$value),na.rm=TRUE)*c(-1,1))\n } \n \n # Return data or plot\n if (return_data) {\n return(to.plot)\n } else {\n return(p)\n }\n}\n\n\n" }, { "path": "R/create_mofa.R", "content": "\n#' @title create a MOFA object\n#' @name create_mofa\n#' @description Method to create a \\code{\\link{MOFA}} object. Depending on the input data format, this method calls one of the following functions:\n#' \\itemize{\n#' \\item{\\strong{long data.frame}: \\code{\\link{create_mofa_from_df}}}\n#' \\item{\\strong{List of matrices}: \\code{\\link{create_mofa_from_matrix}}}\n#' \\item{\\strong{MultiAssayExperiment}: \\code{\\link{create_mofa_from_MultiAssayExperiment}}}\n#' \\item{\\strong{Seurat}: \\code{\\link{create_mofa_from_Seurat}}}\n#' \\item{\\strong{SingleCellExperiment}: \\code{\\link{create_mofa_from_SingleCellExperiment}}}\n#' }\n#' Please read the documentation of the corresponding function for more details on your specific data format.\n#' @param data one of the formats above\n#' @param groups group information, only relevant when using the multi-group framework. \n#' @param extract_metadata logical indicating whether to incorporate the sample metadata from the input object into the MOFA object (\n#' not relevant when the input is a list of matrices). Default is \\code{TRUE}.\n#' @param ... further arguments that can be passed to the function depending on the input data format.\n#' See the documentation of above functions for details.\n#' @return Returns an untrained \\code{\\link{MOFA}} object\n#' @export\n#' @examples\n#' # Using an existing simulated data with two groups and two views\n#' file <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\n#' \n#' # Load data (in long data.frame format)\n#' load(file) \n#' MOFAmodel <- create_mofa(dt)\ncreate_mofa <- function(data, groups = NULL, extract_metadata = TRUE, ...) {\n \n # Creating MOFA object from a Seurat object\n if (is(data, \"Seurat\")) {\n \n message(\"Creating MOFA object from a Seurat object...\")\n object <- create_mofa_from_Seurat(data, groups, extract_metadata = extract_metadata, ...)\n \n # Creating MOFA object from a SingleCellExperiment object\n } else if (is(data, \"SingleCellExperiment\")) {\n \n message(\"Creating MOFA object from a SingleCellExperiment object...\")\n object <- create_mofa_from_SingleCellExperiment(data, groups, extract_metadata = extract_metadata, ...)\n \n \n # Creating MOFA object from a data.frame object\n } else if (is(data, \"data.frame\")) {\n \n message(\"Creating MOFA object from a data.frame...\")\n object <- create_mofa_from_df(data, extract_metadata = extract_metadata)\n \n # Creating MOFA object from a (sparse) matrix object\n } else if (is(data, \"list\") && (length(data) > 0) && \n (all(sapply(data, function(x) is(x, \"matrix\"))) || \n all(sapply(data, function(x) is(x, \"dgCMatrix\"))) || \n all(sapply(data, function(x) is(x, \"dgTMatrix\"))))) {\n \n message(\"Creating MOFA object from a list of matrices (features as rows, sample as columns)...\\n\")\n object <- create_mofa_from_matrix(data, groups)\n \n # Creating MOFA object from MultiAssayExperiment object\n } else if(is(data, \"MultiAssayExperiment\")){\n \n object <- create_mofa_from_MultiAssayExperiment(data, groups, extract_metadata = extract_metadata, ...)\n \n } else {\n stop(\"Error: input data has to be provided as a list of matrices, a data frame or a Seurat object. Please read the documentation for more details.\")\n }\n \n return(object)\n}\n\n#' @title create a MOFA object from a MultiAssayExperiment object\n#' @name create_mofa_from_MultiAssayExperiment\n#' @description Method to create a \\code{\\link{MOFA}} object from a MultiAssayExperiment object\n#' @param mae a MultiAssayExperiment object\n#' @param groups a string specifying column name of the colData to use it as a group variable. \n#' Alternatively, a character vector with group assignment for every sample.\n#' Default is \\code{NULL} (no group structure).\n#' @param extract_metadata logical indicating whether to incorporate the metadata from the MultiAssayExperiment object into the MOFA object\n#' @return Returns an untrained \\code{\\link{MOFA}} object\n#' @export\ncreate_mofa_from_MultiAssayExperiment <- function(mae, groups = NULL, extract_metadata = FALSE) {\n \n # Sanity check\n if(!requireNamespace(\"MultiAssayExperiment\", quietly = TRUE)){\n stop(\"Package \\\"MultiAssayExperiment\\\" is required but is not installed.\", call. = FALSE)\n } else {\n \n # Re-arrange data for training in MOFA to matrices, fill in NAs\n data_list <- lapply(names(mae), function(m) {\n \n # Extract general sample names\n primary <- unique(MultiAssayExperiment::sampleMap(mae)[,\"primary\"])\n \n # Extract view\n subdata <- as.matrix(MultiAssayExperiment::assays(mae)[[m]])\n \n # Rename view-specific sample IDs with the general sample names\n stopifnot(colnames(subdata)==MultiAssayExperiment::sampleMap(mae)[MultiAssayExperiment::sampleMap(mae)[,\"assay\"]==m,\"colname\"])\n colnames(subdata) <- MultiAssayExperiment::sampleMap(mae)[MultiAssayExperiment::sampleMap(mae)[,\"assay\"]==m,\"primary\"]\n \n # Fill subdata with NAs\n subdata_filled <- .subset_augment(subdata, primary)\n return(subdata_filled)\n })\n \n # Define groups\n if (is(groups, 'character') && (length(groups) == 1)) {\n if (!(groups %in% colnames(MultiAssayExperiment::colData(mae))))\n stop(paste0(groups, \" is not found in the colData of the MultiAssayExperiment.\\n\",\n \"If you want to use groups information from MultiAssayExperiment,\\n\",\n \"please ensure to provide a column name that exists. The columns of colData are:\\n\",\n paste0(colnames(MultiAssayExperiment::colData(mae)), collapse = \", \")))\n groups <- MultiAssayExperiment::colData(mae)[,groups]\n }\n \n # If no groups provided, treat all samples as coming from one group\n if (is.null(groups)) {\n # message(\"No groups provided as argument, we assume that all samples belong to the same group.\\n\")\n groups <- rep(\"group1\", length(unique(MultiAssayExperiment::sampleMap(mae)[,\"primary\"])))\n }\n \n # Initialise MOFA object\n object <- new(\"MOFA\")\n object@status <- \"untrained\"\n object@data <- .split_data_into_groups(data_list, groups)\n \n # groups_nms <- unique(as.character(groups))\n groups_nms <- names(object@data[[1]])\n \n # Set dimensionalities\n object@dimensions[[\"M\"]] <- length(data_list)\n object@dimensions[[\"G\"]] <- length(groups_nms)\n object@dimensions[[\"D\"]] <- sapply(data_list, nrow)\n object@dimensions[[\"N\"]] <- sapply(groups_nms, function(x) sum(groups == x))\n object@dimensions[[\"K\"]] <- 0\n \n # Set view names\n views_names(object) <- names(mae)\n \n # Set samples group names\n groups_names(object) <- groups_nms\n \n # Extract metadata\n if (extract_metadata) {\n if (ncol(MultiAssayExperiment::colData(mae)) > 0) {\n object@samples_metadata <- data.frame(MultiAssayExperiment::colData(mae))\n }\n }\n\n # Create sample metadata\n object <- .create_samples_metadata(object)\n\n # Create features metadata\n object <- .create_features_metadata(object)\n\n # Rename duplicated features\n object <- .rename_duplicated_features(object)\n\n # Do quality control\n object <- .quality_control(object)\n \n return(object)\n }\n}\n\n\n#' @title create a MOFA object from a data.frame object\n#' @name create_mofa_from_df\n#' @description Method to create a \\code{\\link{MOFA}} object from a data.frame object\n#' @param df \\code{data.frame} object with at most 5 columns: \\code{sample}, \\code{group}, \\code{feature}, \\code{view}, \\code{value}. \n#' The \\code{group} column (optional) indicates the group of each sample when using the multi-group framework.\n#' The \\code{view} column (optional) indicates the view of each feature when having multi-view data.\n#' @param extract_metadata logical indicating whether to incorporate the extra columns as sample metadata into the MOFA object\n#' @return Returns an untrained \\code{\\link{MOFA}} object\n#' @export\n#' @examples\n#' # Using an existing simulated data with two groups and two views\n#' file <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\n#' \n#' # Load data (in long data.frame format)\n#' load(file) \n#' MOFAmodel <- create_mofa_from_df(dt)\ncreate_mofa_from_df <- function(df, extract_metadata = TRUE) {\n \n # Quality controls\n df <- as.data.frame(df)\n if (!\"group\" %in% colnames(df)) {\n # message('No \"group\" column found in the data.frame, we will assume a common group for all samples')\n df$group <- \"single_group\"\n }\n if (!\"view\" %in% colnames(df)) {\n # message('No \"view\" column found in the data.frame, we will assume a common view for all features')\n df$view <- \"single_view\"\n }\n stopifnot(all(c(\"sample\",\"feature\",\"value\") %in% colnames(df)))\n # stopifnot(all(colnames(df) %in% (c(\"sample\",\"feature\",\"value\",\"group\",\"view\"))))\n stopifnot(all(is.numeric(df$value)))\n \n # Convert 'sample' and 'feature' columns to factors\n if (!is.factor(df$sample))\n df$sample <- as.factor(df$sample)\n if (!is.factor(df$feature))\n df$feature <- as.factor(df$feature)\n \n # Convert 'group' columns to factors\n if (!\"group\" %in% colnames(df)) {\n df$group <- factor(\"group1\")\n } else {\n df$group <- factor(df$group)\n }\n \n # Convert 'view' columns to factors\n if (!\"view\" %in% colnames(df)) {\n df$view <- factor(\"view1\")\n } else {\n df$view <- factor(df$view)\n }\n \n data_matrix <- list()\n for (m in levels(df$view)) {\n data_matrix[[m]] <- list()\n features <- as.character( unique( df[df$view==m,\"feature\",drop=TRUE] ) )\n for (g in levels(df$group)) {\n samples <- as.character( unique( df[df$group==g,\"sample\",drop=TRUE] ) )\n Y <- df[df$view==m & df$group==g,]\n Y$sample <- factor(Y$sample, levels=samples)\n Y$feature <- factor(Y$feature, levels=features)\n if (nrow(Y)==0) {\n data_matrix[[m]][[g]] <- matrix(as.numeric(NA), ncol=length(samples), nrow=length(features))\n rownames(data_matrix[[m]][[g]]) <- features\n colnames(data_matrix[[m]][[g]]) <- samples\n } else {\n data_matrix[[m]][[g]] <- .df_to_matrix( reshape2::dcast(Y, feature~sample, value.var=\"value\", fill=NA, drop=FALSE) )\n }\n }\n }\n \n # Create MOFA object\n object <- new(\"MOFA\")\n object@status <- \"untrained\"\n object@data <- data_matrix\n \n # Set dimensionalities\n object@dimensions[[\"M\"]] <- length(levels(df$view))\n object@dimensions[[\"D\"]] <- sapply(levels(df$view), function(m) length(unique(df[df$view==m,]$feature)))\n object@dimensions[[\"G\"]] <- length(levels(df$group))\n object@dimensions[[\"N\"]] <- sapply(levels(df$group), function(g) length(unique(df[df$group==g,]$sample)))\n object@dimensions[[\"K\"]] <- 0\n \n # Set view names\n views_names(object) <- levels(df$view)\n \n # Set group names\n groups_names(object) <- levels(df$group)\n \n # save other sample-level columns to samples metadata (e.g. covariates)\n if(extract_metadata && !all(colnames(df) %in% (c(\"sample\",\"feature\",\"value\",\"group\",\"view\")))) {\n cols2keep <- df %>% group_by(sample) %>% select(-c(\"view\", \"feature\", \"value\", \"group\", \"value\")) %>%\n summarise(across(!starts_with(\"sample\"), function(x) length(unique(x)),\n .names = \"{col}\")) \n cols2keep <- colnames(cols2keep)[apply(cols2keep, 2, function(x) all(x == 1))]\n if (length(cols2keep) > 0){\n df_meta <- df[, c(\"sample\",cols2keep)] %>% distinct()\n object@samples_metadata <- df_meta %>% select(-sample)\n rownames(object@samples_metadata) <- df_meta$sample\n }\n }\n\n # Create sample metadata\n object <- .create_samples_metadata(object)\n\n # Create features metadata\n object <- .create_features_metadata(object)\n\n # Rename duplicated features\n object <- .rename_duplicated_features(object)\n\n # Do quality control\n object <- .quality_control(object)\n\n return(object)\n}\n\n\n#' @title create a MOFA object from a SingleCellExperiment object\n#' @name create_mofa_from_SingleCellExperiment\n#' @description Method to create a \\code{\\link{MOFA}} object from a SingleCellExperiment object\n#' @param sce SingleCellExperiment object\n#' @param groups a string specifying column name of the colData to use it as a group variable. \n#' Alternatively, a character vector with group assignment for every sample.\n#' Default is \\code{NULL} (no group structure).\n#' @param assay assay to use, default is \\code{logcounts}.\n#' @param extract_metadata logical indicating whether to incorporate the metadata from the SingleCellExperiment object into the MOFA object\n#' @return Returns an untrained \\code{\\link{MOFA}} object\n#' @export\ncreate_mofa_from_SingleCellExperiment <- function(sce, groups = NULL, assay = \"logcounts\", extract_metadata = FALSE) {\n \n # Check is SingleCellExperiment is installed\n if (!requireNamespace(\"SingleCellExperiment\", quietly = TRUE)) {\n stop(\"Package \\\"SingleCellExperiment\\\" is required but is not installed.\", call. = FALSE)\n }\n else if(!requireNamespace(\"SummarizedExperiment\", quietly = TRUE)){\n stop(\"Package \\\"SummarizedExperiment\\\" is required but is not installed.\", call. = FALSE)\n } else {\n stopifnot(assay%in%names(SummarizedExperiment::assays(sce)))\n \n # Define groups of cells\n if (is.null(groups)) {\n # message(\"No groups provided as argument... we assume that all samples are coming from the same group.\\n\")\n groups <- rep(\"group1\", dim(sce)[2])\n } else {\n if (is(groups,'character')) {\n if (length(groups) == 1) {\n stopifnot(groups %in% colnames(colData(sce)))\n groups <- colData(sce)[,groups]\n } else {\n stopifnot(length(groups) == ncol(sce))\n }\n } else {\n stop(\"groups wrongly specified. Please see the documentation and the examples\")\n }\n }\n \n # Extract data matrices\n data_matrices <- list( .split_sce_into_groups(sce, groups, assay) )\n names(data_matrices) <- assay\n \n # Create MOFA object\n object <- new(\"MOFA\")\n object@status <- \"untrained\"\n object@data <- data_matrices\n \n # Define dimensions\n object@dimensions[[\"M\"]] <- length(assay)\n object@dimensions[[\"D\"]] <- vapply(data_matrices, function(m) nrow(m[[1]]), 1L)\n object@dimensions[[\"G\"]] <- length(data_matrices[[1]])\n object@dimensions[[\"N\"]] <- vapply(data_matrices[[1]], function(g) ncol(g), 1L)\n object@dimensions[[\"K\"]] <- 0\n \n # Set views & groups names\n groups_names(object) <- as.character(names(data_matrices[[1]]))\n views_names(object) <- assay\n \n # Set metadata\n if (extract_metadata) {\n object@samples_metadata <- as.data.frame(colData(sce))\n # object@features_metadata <- as.data.frame(rowData(sce))\n }\n \n # Create sample metadata\n object <- .create_samples_metadata(object)\n\n # Create features metadata\n object <- .create_features_metadata(object)\n\n # Rename duplicated features\n object <- .rename_duplicated_features(object)\n\n # Do quality control\n object <- .quality_control(object)\n\n return(object)\n }\n}\n\n#' @title create a MOFA object from a Seurat object\n#' @name create_mofa_from_Seurat\n#' @description Method to create a \\code{\\link{MOFA}} object from a Seurat object\n#' @param seurat Seurat object\n#' @param groups a string specifying column name of the samples metadata to use it as a group variable. \n#' Alternatively, a character vector with group assignment for every sample.\n#' Default is \\code{NULL} (no group structure).\n#' @param assays assays to use, default is \\code{NULL}, it fetched all assays available\n#' @param layer layer to be used (default is data).\n#' @param features a list with vectors, which are used to subset features, with names corresponding to assays; a vector can be provided when only one assay is used\n#' @param extract_metadata logical indicating whether to incorporate the metadata from the Seurat object into the MOFA object\n#' @return Returns an untrained \\code{\\link{MOFA}} object\n#' @export\ncreate_mofa_from_Seurat <- function(seurat, groups = NULL, assays = NULL, layer = \"data\", features = NULL, extract_metadata = FALSE) {\n \n # Check is Seurat is installed\n if (!requireNamespace(\"Seurat\", quietly = TRUE)) {\n stop(\"Package \\\"Seurat\\\" is required but is not installed.\", call. = FALSE)\n } else {\n \n # Check Seurat version\n if (SeuratObject::Version(seurat)$major != 5) stop(\"Please install Seurat v5\")\n \n # Define assays\n if (is.null(assays)) {\n assays <- SeuratObject::Assays(seurat)\n message(paste0(\"No assays specified, using all assays by default: \", paste(assays,collapse=\" \")))\n } else {\n stopifnot(assays%in%Seurat::Assays(seurat))\n }\n \n # Define groups of cells\n if (is(groups, 'character') && (length(groups) == 1)) {\n if (!(groups %in% colnames(seurat@meta.data)))\n stop(paste0(groups, \" is not found in the Seurat@meta.data.\\n\",\n \"please ensure to provide a column name that exists. The columns of meta data are:\\n\",\n paste0(colnames(seurat@meta.data), sep = \", \")))\n groups <- seurat@meta.data[,groups]\n }\n \n # If features to subset are provided,\n # make sure they are a list with respective views (assays) names.\n # A vector is accepted if there's one assay to be used\n if (is(features, \"list\")) {\n if (!is.null(features) && !all(names(features) %in% assays)) {\n stop(\"Please make sure all the names of the features list correspond to views (assays) names being used for the model\")\n }\n } else {\n # By default select highly variable features if present in the Seurat object\n if (is.null(features)) {\n message(\"No features specified, using variable features from the Seurat object...\")\n features <- lapply(assays, function(i) seurat@assays[[i]]@var.features)\n names(features) <- assays\n if (any(sapply(features,length)==0)) stop(\"No list of features provided and variable features not detected in the Seurat object\")\n } else if (all(is(features, \"character\"))) {\n features <- list(features)\n names(features) <- assays\n } else {\n stop(\"Features not recognised. Please either provide a list of features (per assay) or calculate variable features in the Seurat object\")\n }\n }\n \n # If no groups provided, treat all samples as coming from one group\n if (is.null(groups)) {\n # message(\"No groups provided as argument... we assume that all samples are coming from the same group.\\n\")\n groups <- rep(\"group1\", dim(seurat)[2])\n }\n \n # Extract data matrices\n data_matrices <- lapply(assays, function(i) \n .split_seurat_into_groups(seurat, groups = groups, assay = i, layer = layer, features = features[[i]]))\n names(data_matrices) <- assays\n \n # Create MOFA object\n object <- new(\"MOFA\")\n object@status <- \"untrained\"\n object@data <- data_matrices\n \n # Define dimensions\n object@dimensions[[\"M\"]] <- length(assays)\n object@dimensions[[\"D\"]] <- vapply(data_matrices, function(m) nrow(m[[1]]), 1L)\n object@dimensions[[\"G\"]] <- length(data_matrices[[1]])\n object@dimensions[[\"N\"]] <- vapply(data_matrices[[1]], function(g) ncol(g), 1L)\n object@dimensions[[\"K\"]] <- 0\n \n # Set views & groups names\n groups_names(object) <- as.character(names(data_matrices[[1]]))\n views_names(object) <- assays\n \n # Set metadata\n if (extract_metadata) {\n object@samples_metadata <- seurat@meta.data\n # object@features_metadata <- do.call(rbind, lapply(assays, function(a) seurat@assays[[a]]@meta.features))\n }\n\n # Create sample metadata\n object <- .create_samples_metadata(object)\n\n # Create features metadata\n object <- .create_features_metadata(object)\n\n # Rename duplicated features\n object <- .rename_duplicated_features(object)\n\n # Do quality control\n object <- .quality_control(object)\n \n return(object)\n }\n}\n\n\n#' @title create a MOFA object from a a list of matrices\n#' @name create_mofa_from_matrix\n#' @description Method to create a \\code{\\link{MOFA}} object from a list of matrices\n#' @param data A list of matrices, where each entry corresponds to one view.\n#' Samples are stored in columns and features in rows.\n#' Missing values must be filled in prior to creating the MOFA object (see for example the CLL tutorial)\n#' @param groups A character vector with group assignment for every sample. Default is \\code{NULL}, no group structure.\n#' @return Returns an untrained \\code{\\link{MOFA}} object\n#' @export\n#' @examples \n#' m <- make_example_data()\n#' create_mofa_from_matrix(m$data)\n\ncreate_mofa_from_matrix <- function(data, groups = NULL) {\n \n # Quality control: check that the matrices are all numeric\n stopifnot(all(sapply(data, function(g) all(is.numeric(g)))) || all(sapply(data, function(x) class(x) %in% c(\"dgTMatrix\", \"dgCMatrix\"))))\n \n # Quality control: check that all matrices have the same samples\n tmp <- lapply(data, function(m) colnames(m))\n if(length(unique(sapply(tmp,length)))>1)\n stop(\"Views have different number of samples (columns)... please make sure that all views contain the same samples in the same order (see documentation)\")\n if (length(unique(tmp))>1) \n stop(\"Views have different sample names (columns)... please make sure that all views contain the same samples in the same order (see documentation)\")\n \n # Make a dgCMatrix out of dgTMatrix\n if (all(sapply(data, function(x) is(x, \"dgTMatrix\")))) {\n data <- lapply(data, function(m) as(m, \"dgCMatrix\"))\n }\n \n # Set groups names\n if (is.null(groups)) {\n # message(\"No groups provided as argument... we assume that all samples are coming from the same group.\\n\")\n groups <- rep(\"group1\", ncol(data[[1]]))\n }\n \n # Set views names\n if (is.null(names(data))) {\n default_views <- paste0(\"view_\", seq_len(length(data)))\n message(paste0(\"View names are not specified in the data, using default: \", paste(default_views, collapse=\", \"), \"\\n\"))\n names(data) <- default_views\n }\n views_names <- as.character(names(data))\n \n # Initialise MOFA object\n object <- new(\"MOFA\")\n object@status <- \"untrained\"\n object@data <- .split_data_into_groups(data, groups)\n \n # groups_names <- as.character(unique(groups))\n groups_names <- names(object@data[[1]])\n \n # Set dimensionalities\n object@dimensions[[\"M\"]] <- length(data)\n object@dimensions[[\"G\"]] <- length(groups_names)\n object@dimensions[[\"D\"]] <- sapply(data, nrow)\n object@dimensions[[\"N\"]] <- sapply(groups_names, function(x) sum(groups == x))\n object@dimensions[[\"K\"]] <- 0\n \n # Set features names\n for (m in seq_len(length(data))) {\n if (is.null(rownames(data[[m]]))) {\n warning(sprintf(\"Feature names are not specified for view %d, using default: feature1_v%d, feature2_v%d...\", m, m, m))\n for (g in seq_len(length(object@data[[m]]))) {\n rownames(object@data[[m]][[g]]) <- paste0(\"feature_\", seq_len(nrow(object@data[[m]][[g]])), \"_v\", m)\n }\n }\n }\n \n # Set samples names\n for (g in seq_len(object@dimensions[[\"G\"]])) {\n if (is.null(colnames(object@data[[1]][[g]]))) {\n warning(sprintf(\"Sample names for group %d are not specified, using default: sample1_g%d, sample2_g%d,...\", g, g, g))\n for (m in seq_len(object@dimensions[[\"M\"]])) {\n colnames(object@data[[m]][[g]]) <- paste0(\"sample_\", seq_len(ncol(object@data[[m]][[g]])), \"_g\", g)\n }\n }\n }\n \n # Set view names\n views_names(object) <- views_names\n \n # Set samples group names\n groups_names(object) <- groups_names\n\n # Create sample metadata\n object <- .create_samples_metadata(object)\n\n # Create features metadata\n object <- .create_features_metadata(object)\n\n # Rename duplicated features\n object <- .rename_duplicated_features(object)\n\n # Do quality control\n object <- .quality_control(object)\n\n return(object)\n}\n\n\n# (Hidden) function to split a list of matrices into a nested list of matrices\n.split_data_into_groups <- function(data, groups) {\n group_indices <- split(seq_along(groups), factor(groups, exclude = character(0))) # factor call avoids dropping NA\n lapply(data, function(x) {\n lapply(group_indices, function(idx) {\n x[, idx, drop = FALSE]\n })\n })\n}\n\n# (Hidden) function to split data in Seurat object into a list of matrices\n.split_seurat_into_groups <- function(seurat, groups, assay = \"RNA\", layer = \"data\", features = NULL) {\n data <- SeuratObject::GetAssayData(object = seurat, assay = assay, layer = layer)\n if(is.null(data) | any(dim(data) == 0)){\n stop(paste(\"No data present in the layer\",layer, \"of the assay\",assay ,\"in the Seurat object.\"))\n }\n if (!is.null(features)) data <- data[features, , drop=FALSE]\n .split_data_into_groups(list(data), groups)[[1]]\n}\n\n# (Hidden) function to split data in a SingleCellExperiment object into a list of matrices\n.split_sce_into_groups <- function(sce, groups, assay) {\n \n if(!requireNamespace(\"SummarizedExperiment\", quietly = TRUE)){\n stop(\"Package \\\"SummarizedExperiment\\\" is required but is not installed.\", call. = FALSE)\n } else {\n \n data <- SummarizedExperiment::assay(sce, i = assay)\n .split_data_into_groups(list(data), groups)[[1]]\n }\n}\n\n# (Hidden) function to fill NAs for missing samples\n.subset_augment<-function(mat, samp) {\n samp <- unique(samp)\n mat <- t(mat)\n aug_mat<-matrix(NA, ncol=ncol(mat), nrow=length(samp))\n aug_mat<-mat[match(samp,rownames(mat)),,drop=FALSE]\n rownames(aug_mat)<-samp\n colnames(aug_mat)<-colnames(mat)\n return(t(aug_mat))\n}\n\n.df_to_matrix <- function(x) {\n m <- as.matrix(x[,-1])\n rownames(m) <- x[[1]]\n if (ncol(m) == 1)\n colnames(m) <- colnames(x)[2:ncol(x)]\n m\n}\n\n.create_samples_metadata <- function(object) {\n # TO-DO: CHECK SAMPLE AND GROUP COLUMN IN PROVIDED METADATA\n foo <- lapply(object@data[[1]], colnames)\n tmp <- data.frame(\n sample = unname(unlist(foo)),\n group = unlist(lapply(names(foo), function(x) rep(x, length(foo[[x]])) )),\n stringsAsFactors = FALSE\n )\n if (.hasSlot(object, \"samples_metadata\") && (length(object@samples_metadata) > 0)) {\n object@samples_metadata <- cbind(tmp, object@samples_metadata[match(tmp$sample, rownames(object@samples_metadata)),, drop = FALSE])\n } else {\n object@samples_metadata <- tmp\n }\n return(object)\n}\n\n.create_features_metadata <- function(object) {\n tmp <- data.frame(\n feature = unname(unlist(lapply(object@data, function(x) rownames(x[[1]])))),\n view = unlist(lapply(seq_len(object@dimensions$M), function(x) rep(views_names(object)[[x]], object@dimensions$D[[x]]) )),\n stringsAsFactors = FALSE\n )\n if (.hasSlot(object, \"features_metadata\") && (length(object@features_metadata) > 0)) {\n object@features_metadata <- cbind(tmp, object@features_metadata[match(tmp$feature, rownames(object@features_metadata)),])\n } else {\n object@features_metadata <- tmp\n }\n return(object)\n}\n\n.rename_duplicated_features <- function(object) {\n feature_names <- unname(unlist(lapply(object@data, function(x) rownames(x[[1]]))))\n duplicated_names <- unique(feature_names[duplicated(feature_names)])\n if (length(duplicated_names)>0) \n warning(\"There are duplicated features names across different views. We will add the suffix *_view* only for those features \n Example: if you have both TP53 in mRNA and mutation data it will be renamed to TP53_mRNA, TP53_mutation\")\n # Rename data matrices\n for (m in names(object@data)) {\n for (g in names(object@data[[m]])) {\n tmp <- which(rownames(object@data[[m]][[g]]) %in% duplicated_names)\n if (length(tmp)>0) {\n rownames(object@data[[m]][[g]])[tmp] <- paste(rownames(object@data[[m]][[g]])[tmp], m, sep=\"_\")\n }\n }\n }\n \n # Rename features metadata\n tmp <- object@features_metadata[[\"feature\"]] %in% duplicated_names\n object@features_metadata[tmp,\"feature\"] <- paste(object@features_metadata[tmp,\"feature\"], object@features_metadata[tmp,\"view\"], sep=\"_\")\n return(object)\n}\n" }, { "path": "R/dimensionality_reduction.R", "content": "\n##################################################################\n## Functions to do dimensionality reduction on the MOFA factors ##\n##################################################################\n\n#' @title Run t-SNE on the MOFA factors\n#' @name run_tsne\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param factors character vector with the factor names, or numeric vector with the indices of the factors to use, or \"all\" to use all factors (default).\n#' @param groups character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use all groups (default).\n#' @param ... arguments passed to \\code{\\link{Rtsne}}\n#' @details This function calls \\code{\\link[Rtsne]{Rtsne}} to calculate a TSNE representation from the MOFA factors.\n#' Subsequently, you can plot the TSNE representation with \\code{\\link{plot_dimred}} or fetch the coordinates using \\code{plot_dimred(..., method=\"TSNE\", return_data=TRUE)}. \n#' Remember to use set.seed before the function call to get reproducible results. \n#' @return Returns a \\code{\\link{MOFA}} object with the \\code{MOFAobject@dim_red} slot filled with the t-SNE output\n#' @importFrom Rtsne Rtsne\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Run\n#' \\dontrun{ model <- run_tsne(model, perplexity = 15) }\n#' \n#' # Plot\n#' \\dontrun{ model <- plot_dimred(model, method=\"TSNE\") }\n#' \n#' # Fetch data\n#' \\dontrun{ tsne.df <- plot_dimred(model, method=\"TSNE\", return_data=TRUE) }\n#' \nrun_tsne <- function(object, factors = \"all\", groups = \"all\", ...) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Get factor values\n Z <- get_factors(object, factors=factors, groups=groups)\n \n # Concatenate groups\n Z <- do.call(rbind, Z)\n \n # Replace missing values by zero\n Z[is.na(Z)] <- 0\n \n # Run t-SNE\n tsne_embedding <- Rtsne(Z, check_duplicates = FALSE, pca = FALSE, ...)\n\n # Add sample names and enumerate latent dimensions (e.g. TSNE1 and TSNE2)\n object@dim_red$TSNE <- data.frame(rownames(Z), tsne_embedding$Y)\n colnames(object@dim_red$TSNE) <- c(\"sample\", paste0(\"TSNE\", 1:ncol(tsne_embedding$Y)))\n \n return(object)\n \n}\n\n\n\n#' @title Run UMAP on the MOFA factors\n#' @name run_umap\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param factors character vector with the factor names, or numeric vector with the indices of the factors to use, or \"all\" to use all factors (default).\n#' @param groups character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use all groups (default).\n#' @param n_neighbors number of neighbouring points used in local approximations of manifold structure. Larger values will result in more global structure being preserved at the loss of detailed local structure. In general this parameter should often be in the range 5 to 50.\n#' @param min_dist This controls how tightly the embedding is allowed compress points together. Larger values ensure embedded points are more evenly distributed, while smaller values allow the algorithm to optimise more accurately with regard to local structure. Sensible values are in the range 0.01 to 0.5\n#' @param metric choice of metric used to measure distance in the input space\n#' @param ... arguments passed to \\code{\\link[uwot]{umap}}\n#' @details This function calls \\code{\\link[uwot]{umap}} to calculate a UMAP representation from the MOFA factors\n#' For details on the hyperparameters of UMAP see the documentation of \\code{\\link[uwot]{umap}}.\n#' Subsequently, you can plot the UMAP representation with \\code{\\link{plot_dimred}} or fetch the coordinates using \\code{plot_dimred(..., method=\"UMAP\", return_data=TRUE)}. \n#' Remember to use set.seed before the function call to get reproducible results. \n#' @return Returns a \\code{\\link{MOFA}} object with the \\code{MOFAobject@dim_red} slot filled with the UMAP output\n#' @importFrom uwot umap\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Change hyperparameters passed to umap\n#' \\dontrun{ model <- run_umap(model, min_dist = 0.01, n_neighbors = 10) }\n\n#' # Plot\n#' \\dontrun{ model <- plot_dimred(model, method=\"UMAP\") }\n#' \n#' # Fetch data\n#' \\dontrun{ umap.df <- plot_dimred(model, method=\"UMAP\", return_data=TRUE) }\n#' \nrun_umap <- function(object, factors = \"all\", groups = \"all\", n_neighbors = 30, min_dist = 0.3, metric = \"cosine\", ...) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Get factor values\n Z <- get_factors(object, factors = factors, groups = groups)\n \n # Concatenate groups\n Z <- do.call(rbind, Z)\n \n # Replace missing values by zero\n Z[is.na(Z)] <- 0\n \n # Run UMAP\n umap_embedding <- umap(Z, n_neighbors=n_neighbors, min_dist=min_dist, metric=metric, ...)\n\n # Add sample names and enumerate latent dimensions (e.g. UMAP1 and UMAP2)\n object@dim_red$UMAP <- data.frame(rownames(Z), umap_embedding)\n colnames(object@dim_red$UMAP) <- c(\"sample\", paste0(\"UMAP\", 1:ncol(umap_embedding)))\n \n return(object)\n \n}\n\n\n\n#' @title Plot dimensionality reduction based on MOFA factors\n#' @name plot_dimred\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param method string indicating which method has been used for non-linear dimensionality reduction (either 'umap' or 'tsne')\n#' @param groups character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use samples from all groups.\n#' @param show_missing logical indicating whether to include samples for which \\code{shape_by} or \\code{color_by} is missing\n#' @param color_by specifies groups or values used to color the samples. This can be either:\n#' (1) a character giving the name of a feature present in the training data.\n#' (2) a character giving the same of a column present in the sample metadata.\n#' (3) a vector of the same length as the number of samples specifying discrete groups or continuous numeric values.\n#' @param shape_by specifies groups or values used to shape the samples. This can be either:\n#' (1) a character giving the name of a feature present in the training data, \n#' (2) a character giving the same of a column present in the sample metadata.\n#' (3) a vector of the same length as the number of samples specifying discrete groups.\n#' @param color_name name for color legend.\n#' @param shape_name name for shape legend.\n#' @param label logical indicating whether to label the medians of the clusters. Only if color_by is specified\n#' @param dot_size numeric indicating dot size.\n#' @param stroke numeric indicating the stroke size (the black border around the dots, default is NULL, inferred automatically).\n#' @param alpha_missing numeric indicating dot transparency of missing data.\n#' @param legend logical indicating whether to add legend.\n#' @param return_data logical indicating whether to return the long data frame to plot instead of plotting\n#' @param rasterize logical indicating whether to rasterize plot using \\code{\\link[ggrastr]{geom_point_rast}}\n#' @param ... extra arguments passed to \\code{\\link{run_umap}} or \\code{\\link{run_tsne}}.\n#' @details This function plots dimensionality reduction projections that are stored in the \\code{dim_red} slot.\n#' Typically this contains UMAP or t-SNE projections computed using \\code{\\link{run_tsne}} or \\code{\\link{run_umap}}, respectively.\n#' @return Returns a \\code{ggplot2} object or a long data.frame (if return_data is TRUE)\n#' @import ggplot2\n#' @importFrom dplyr filter\n#' @importFrom stats complete.cases\n#' @importFrom tidyr spread gather\n#' @importFrom magrittr %>% set_colnames\n#' @importFrom ggrepel geom_text_repel\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Run UMAP\n#' model <- run_umap(model)\n#' \n#' # Plot UMAP\n#' plot_dimred(model, method = \"UMAP\")\n#' \n#' # Plot UMAP, colour by Factor 1 values\n#' plot_dimred(model, method = \"UMAP\", color_by = \"Factor1\")\n#' \n#' # Plot UMAP, colour by the values of a specific feature\n#' plot_dimred(model, method = \"UMAP\", color_by = \"feature_0_view_0\")\n#' \nplot_dimred <- function(object, method = c(\"UMAP\", \"TSNE\"), groups = \"all\", show_missing = TRUE,\n color_by = NULL, shape_by = NULL, color_name = NULL, shape_name = NULL, label = FALSE,\n dot_size = 1.5, stroke = NULL, alpha_missing = 1, legend = TRUE, rasterize = FALSE, return_data = FALSE, ...) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n\n # If UMAP or TSNE is requested but were not computed, compute the requested embedding\n if ((method %in% c(\"UMAP\", \"TSNE\")) && (!.hasSlot(object, \"dim_red\") || !(method %in% names(object@dim_red)))) {\n message(paste0(method, \" embedding was not computed. Running run_\", tolower(method), \"()...\"))\n if (method == \"UMAP\") {\n object <- run_umap(object, ...)\n } else if (method == \"TSNE\") {\n object <- run_tsne(object, ...)\n }\n }\n \n # make sure the slot for the requested method exists\n method <- match.arg(method, names(object@dim_red)) \n \n # Plotting multiple features\n if (length(color_by)>1) {\n .args <- as.list(match.call()[-1])\n plist <- lapply(color_by, function(i) {\n .args[[\"color_by\"]] <- i\n do.call(plot_dimred, .args)\n })\n p <- cowplot::plot_grid(plotlist=plist)\n return(p)\n }\n \n # Remember color_name and shape_name if not provided\n if (!is.null(color_by) && (length(color_by) == 1) && is.null(color_name))\n color_name <- color_by\n if (!is.null(shape_by) && (length(shape_by) == 1) && is.null(shape_name))\n shape_name <- shape_by\n \n # Fetch latent manifold\n Z <- object@dim_red[[method]]\n latent_dimensions_names <- colnames(Z)[-1]\n Z <- gather(Z, -sample, key=\"latent_dimension\", value=\"value\")\n \n # Subset groups\n groups <- .check_and_get_groups(object, groups)\n Z <- Z[Z$sample%in%unlist(samples_names(object)[groups]),]\n \n # Set color and shape\n color_by <- .set_colorby(object, color_by)\n shape_by <- .set_shapeby(object, shape_by)\n \n # Merge factor values with color and shape information\n df <- merge(Z, color_by, by=\"sample\")\n df <- merge(df, shape_by, by=\"sample\")\n df$shape_by <- as.character(df$shape_by)\n \n # Remove missing values\n if(!show_missing) df <- filter(df, !is.na(color_by) & !is.na(shape_by))\n df$observed <- as.factor(!is.na(df$color_by))\n \n # spread over latent dimensions\n df <- spread(df, key=\"latent_dimension\", value=\"value\")\n df <- set_colnames(df, c(colnames(df)[seq_len(4)], \"x\", \"y\"))\n \n # Return data if requested instead of plotting\n if (return_data) return(df)\n\n # Set stroke\n if (is.null(stroke)) if (length(unique(df$sample))<1000) { stroke <- 0.5 } else { stroke <- 0 }\n \n # Generate plot\n p <- ggplot(df, aes(x = .data$x, y = .data$y)) + \n labs(x = latent_dimensions_names[1], y = latent_dimensions_names[2]) +\n theme_classic() +\n theme(\n axis.text = element_blank(), \n axis.title = element_blank(), \n axis.line = element_line(color = \"black\", linewidth = 0.5), \n axis.ticks = element_blank()\n )\n \n # Add dots \n if (rasterize) {\n message(\"for rasterizing the plot we use ggrastr::geom_point_rast()\")\n p <- p + ggrastr::geom_point_rast(aes(fill = .data$color_by, shape = .data$shape_by, alpha = .data$observed), size = dot_size, stroke = stroke)\n } else {\n p <- p + geom_point(aes(fill = .data$color_by, shape = .data$shape_by, alpha = .data$observed), size = dot_size, stroke = stroke)\n \n } \n \n # Add legend for alpha\n if (length(unique(df$observed))>1) { \n p <- p + scale_alpha_manual(values = c(\"TRUE\"=1.0, \"FALSE\"=alpha_missing))\n } else { \n p <- p + scale_alpha_manual(values = 1.0)\n }\n p <- p + guides(alpha=\"none\")\n \n # Label clusters\n if (label && length(unique(df$color_by)) > 1 && length(unique(df$color_by))<50) {\n groups <- unique(df$color_by)\n labels.loc <- lapply(\n X = groups,\n FUN = function(i) {\n data.use <- df[df[,\"color_by\"] == i, , drop = FALSE]\n data.medians <- as.data.frame(x = t(x = apply(X = data.use[, c(\"x\",\"y\"), drop = FALSE], MARGIN = 2, FUN = median, na.rm = TRUE)))\n data.medians[, \"color_by\"] <- i\n return(data.medians)\n }\n ) %>% do.call(\"rbind\",.)\n p <- p + geom_text_repel(aes(label=.data$color_by), data=labels.loc)\n }\n \n \n # Add legend\n p <- .add_legend(p, df, legend, color_name, shape_name)\n \n return(p)\n}\n" }, { "path": "R/enrichment.R", "content": "##########################################################\n## Functions to perform Feature Set Enrichment Analysis ##\n##########################################################\n\n#' @title Run feature set Enrichment Analysis\n#' @name run_enrichment \n#' @description Method to perform feature set enrichment analysis. Here we use a slightly modified version of the \\code{\\link[PCGSE]{pcgse}} function.\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param view a character with the view name, or a numeric vector with the index of the view to use.\n#' @param feature.sets data structure that holds feature set membership information. \n#' Must be a binary membership matrix (rows are feature sets and columns are features). See details below for some pre-built gene set matrices.\n#' @param factors character vector with the factor names, or numeric vector with the index of the factors for which to perform the enrichment.\n#' @param set.statistic the set statistic computed from the feature statistics. Must be one of the following: \"mean.diff\" (default) or \"rank.sum\".\n#' @param statistical.test the statistical test used to compute the significance of the feature set statistics under a competitive null hypothesis.\n#' Must be one of the following: \"parametric\" (default), \"cor.adj.parametric\", \"permutation\".\n#' @param sign use only \"positive\" or \"negative\" weights. Default is \"all\".\n#' @param min.size Minimum size of a feature set (default is 10).\n#' @param nperm number of permutations. Only relevant if statistical.test is set to \"permutation\". Default is 1000\n#' @param p.adj.method Method to adjust p-values factor-wise for multiple testing. Can be any method in p.adjust.methods(). Default uses Benjamini-Hochberg procedure.\n#' @param alpha FDR threshold to generate lists of significant pathways. Default is 0.1\n#' @param verbose boolean indicating whether to print messages on progress \n#' @details \n#' The aim of this function is to relate each factor to pre-defined biological pathways by performing a gene set enrichment analysis on the feature weights. \\cr\n#' This function is particularly useful when a factor is difficult to characterise based only on the genes with the highest weight. \\cr\n#' We provide a few pre-built gene set matrices in the MOFAdata package. See \\code{https://github.com/bioFAM/MOFAdata} for details. \\cr\n#' The function we implemented is based on the \\code{\\link[PCGSE]{pcgse}} function with some modifications. \n#' Please read this paper https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4543476 for details on the math.\n#' @return a list with five elements: \n#' \\item{\\strong{pval}:}{ matrices with nominal p-values. }\n#' \\item{\\strong{pval.adj}:}{ matrices with FDR-adjusted p-values. }\n#' \\item{\\strong{feature.statistics}:}{ matrices with the local (feature-wise) statistics. }\n#' \\item{\\strong{set.statistics}:}{ matrices with the global (gene set-wise) statistics. }\n#' \\item{\\strong{sigPathways}}{ list with significant pathways per factor. }\n#' @importFrom stats p.adjust var p.adjust.methods\n#' @export\n\nrun_enrichment <- function(object, view, feature.sets, factors = \"all\",\n set.statistic = c(\"mean.diff\", \"rank.sum\"),\n statistical.test = c(\"parametric\", \"cor.adj.parametric\", \"permutation\"), sign = c(\"all\",\"positive\",\"negative\"),\n min.size = 10, nperm = 1000, p.adj.method = \"BH\", alpha = 0.1, verbose = TRUE) {\n \n # Quality control\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if (!(is(feature.sets, \"matrix\") & all(feature.sets %in% c(0,1)))) stop(\"feature.sets has to be a list or a binary matrix.\")\n \n # Define views\n view <- .check_and_get_views(object, view)\n \n # Define factors\n factors <- .check_and_get_factors(object, factors)\n \n # Parse inputs\n sign <- match.arg(sign)\n set.statistic <- match.arg(set.statistic)\n statistical.test <- match.arg(statistical.test)\n \n # Collect observed data\n data <- get_data(object, views = view, as.data.frame = FALSE)[[1]]\n if(is(data, \"list\")) data <- Reduce(cbind, data) # concatenate groups\n data <- t(data)\n \n # Collect relevant expectations\n W <- get_weights(object, views=view, factors=factors, scale = TRUE)[[1]]\n Z <- get_factors(object, factors=factors)\n if(is(Z, \"list\")) Z <- Reduce(rbind, Z)\n stopifnot(rownames(data) == rownames(Z))\n \n # Remove features with no variance\n # if (statistical.test %in% c(\"cor.adj.parametric\")) {\n idx <- apply(data,2, function(x) var(x,na.rm=TRUE))==0\n if (sum(idx)>=1) {\n warning(sprintf(\"%d features were removed because they had no variance in the data.\\n\",sum(idx)))\n data <- data[,!idx]\n W <- W[!idx,]\n }\n \n # Check if some features do not intersect between the feature sets and the observed data and remove them\n features <- intersect(colnames(data),colnames(feature.sets))\n if(length(features)== 0) stop(\"Feature names in feature.sets do not match feature names in model.\")\n if(verbose) {\n message(sprintf(\"Intersecting features names in the model and the gene set annotation results in a total of %d features.\",length(features)))\n }\n data <- data[,features]\n W <- W[features,,drop=FALSE]\n feature.sets <- feature.sets[,features]\n \n # Filter feature sets with small number of features\n feature.sets <- feature.sets[rowSums(feature.sets)>=min.size,]\n \n # Subset weights by sign\n if (sign==\"positive\") {\n W[W<0] <- 0\n # W[W<0] <- NA\n } else if (sign==\"negative\") {\n W[W>0] <- 0\n # W[W>0] <- NA\n W <- abs(W)\n }\n \n # Print options\n if(verbose) {\n message(\"\\nRunning feature set Enrichment Analysis with the following options...\\n\",\n sprintf(\"View: %s \\n\", view),\n sprintf(\"Number of feature sets: %d \\n\", nrow(feature.sets)),\n sprintf(\"Set statistic: %s \\n\", set.statistic),\n sprintf(\"Statistical test: %s \\n\", statistical.test)\n )\n if (sign%in%c(\"positive\",\"negative\"))\n message(sprintf(\"Subsetting weights with %s sign\",sign))\n if (statistical.test==\"permutation\") {\n message(sprintf(\"Number of permutations: %d\", nperm))\n }\n message(\"\\n\")\n }\n \n if (nperm<100) \n warning(\"A large number of permutations (at least 1000) is required for the permutation approach!\\n\")\n \n # Non-parametric permutation test\n if (statistical.test == \"permutation\") {\n\n null_dist_tmp <- lapply(seq_len(nperm), function(i) {\n print(sprintf(\"Running permutation %d/%d...\",i,nperm))\n perm <- sample(ncol(data))\n \n # Permute rows of the weight matrix to obtain a null distribution\n W_null <- W[perm,]\n rownames(W_null) <- rownames(W)\n colnames(W_null) <- colnames(W)\n \n # Permute columns of the data matrix correspondingly (only matters for cor.adjusted test)\n data_null <- data[,perm]\n rownames(data_null) <- rownames(data)\n \n # Compute null (or background) statistic\n s.background <- .pcgse(\n data = data_null, \n prcomp.output = list(rotation=W_null, x=Z),\n pc.indexes = seq_along(factors), \n feature.sets = feature.sets,\n set.statistic = set.statistic,\n set.test = \"parametric\")$statistic\n return(abs(s.background))\n })\n null_dist <- do.call(\"rbind\", null_dist_tmp)\n colnames(null_dist) <- factors\n \n # Compute foreground statistics\n results <- .pcgse(\n data = data, \n prcomp.output = list(rotation=W, x=Z),\n pc.indexes = seq_along(factors), \n feature.sets = feature.sets,\n set.statistic = set.statistic,\n set.test = \"parametric\")\n s.foreground <- results$statistic\n \n # Calculate p-values based on fraction true statistic per factor and feature set is larger than permuted\n xx <- array(unlist(null_dist_tmp), dim = c(nrow(null_dist_tmp[[1]]), ncol(null_dist_tmp[[1]]), length(null_dist_tmp)))\n ll <- lapply(seq_len(nperm), function(i) xx[,,i] > abs(s.foreground))\n results$p.values <- Reduce(\"+\",ll)/nperm\n \n # Parametric test\n } else {\n results <- .pcgse(\n data = data,\n prcomp.output = list(rotation=W, x=Z),\n pc.indexes = seq_along(factors),\n feature.sets = feature.sets,\n set.statistic = set.statistic,\n set.test = statistical.test\n )\n }\n \n # Parse results\n pathways <- rownames(feature.sets)\n colnames(results$p.values) <- colnames(results$statistics) <- colnames(results$feature.statistics) <- factors\n rownames(results$p.values) <- rownames(results$statistics) <- pathways\n rownames(results$feature.statistics) <- colnames(data)\n \n # adjust for multiple testing\n if(!p.adj.method %in% p.adjust.methods) \n stop(\"p.adj.method needs to be an element of p.adjust.methods\")\n adj.p.values <- apply(results$p.values, 2,function(lfw) p.adjust(lfw, method = p.adj.method))\n\n # If we specify a direction, we are only interested in overrepresented pathways in the selected direction\n if (sign%in%c(\"positive\",\"negative\")) {\n results$p.values[results$statistics<0] <- 1.0\n adj.p.values[results$statistics<0] <- 1.0\n results$statistics[results$statistics<0] <- 0\n }\n \n \n # If we specify a direction, we are only interested in overrepresented pathways in the selected direction\n if (sign%in%c(\"positive\",\"negative\")) {\n results$p.values[results$statistics<0] <- 1.0\n adj.p.values[results$statistics<0] <- 1.0\n results$statistics[results$statistics<0] <- 0\n }\n \n \n # obtain list of significant pathways\n sigPathways <- lapply(factors, function(j) rownames(adj.p.values)[adj.p.values[,j] <= alpha])\n \n # prepare output\n output <- list(\n feature.sets = feature.sets, \n pval = results$p.values, \n pval.adj = adj.p.values, \n feature.statistics = results$feature.statistics,\n set.statistics = results$statistics,\n sigPathways = sigPathways\n )\n return(output)\n}\n\n\n########################\n## Plotting functions ##\n########################\n\n\n#' @title Plot output of gene set Enrichment Analysis\n#' @name plot_enrichment\n#' @description Method to plot the results of the gene set Enrichment Analysis\n#' @param enrichment.results output of \\link{run_enrichment} function\n#' @param factor a string with the factor name or an integer with the factor index\n#' @param alpha p.value threshold to filter out gene sets\n#' @param max.pathways maximum number of enriched pathways to display\n#' @param text_size text size\n#' @param dot_size dot size\n#' @details it requires \\code{\\link{run_enrichment}} to be run beforehand.\n#' @return a \\code{ggplot2} object\n#' @import ggplot2\n#' @importFrom utils head\n#' @export\nplot_enrichment <- function(enrichment.results, factor, alpha = 0.1, max.pathways = 25,\n text_size = 1.0, dot_size = 5.0) {\n \n # Sanity checks\n stopifnot(is.numeric(alpha)) \n stopifnot(length(factor)==1) \n if (is.numeric(factor)) factor <- colnames(enrichment.results$pval.adj)[factor]\n if(!factor %in% colnames(enrichment.results$pval)) \n stop(paste0(\"No gene set enrichment calculated for factor \", factor))\n \n # get p-values\n p.values <- enrichment.results$pval.adj\n \n # Get data \n tmp <- data.frame(\n pvalues = p.values[,factor, drop=TRUE], \n pathway = rownames(p.values)\n )\n \n # Filter out pathways\n tmp <- tmp[tmp$pvalue<=alpha,,drop=FALSE]\n if (nrow(tmp)==0) stop(\"No significant pathways at the specified alpha threshold\")\n \n # If there are too many pathways enriched, just keep the 'max_pathways' more significant\n if (nrow(tmp)>max.pathways) tmp <- head(tmp[order(tmp$pvalue),],n=max.pathways)\n \n # Convert pvalues to log scale\n tmp$logp <- -log10(tmp$pvalue+1e-100)\n \n #order according to significance\n tmp$pathway <- factor(tmp$pathway <- rownames(tmp), levels = tmp$pathway[order(tmp$pvalue, decreasing = TRUE)])\n tmp$start <- 0\n \n p <- ggplot(tmp, aes(x=.data$pathway, y=.data$logp)) +\n geom_point(size=dot_size) +\n geom_hline(yintercept=-log10(alpha), linetype=\"longdash\") +\n scale_color_manual(values=c(\"black\",\"red\")) +\n geom_segment(aes(xend=.data$pathway, yend=.data$start)) +\n ylab(\"-log pvalue\") +\n coord_flip() +\n theme(\n axis.text.y = element_text(size=rel(text_size), hjust=1, color='black'),\n axis.text.x = element_text(size=rel(1.2), vjust=0.5, color='black'),\n axis.title.y=element_blank(),\n legend.position='none',\n panel.background = element_blank()\n )\n \n return(p)\n}\n\n#' @title Heatmap of Feature Set Enrichment Analysis results\n#' @name plot_enrichment_heatmap\n#' @description This method generates a heatmap with the adjusted p.values that\n#' result from the the feature set enrichment analysis. Rows are feature sets and columns are factors.\n#' @param enrichment.results output of \\link{run_enrichment} function\n#' @param alpha FDR threshold to filter out unsignificant feature sets which are\n#' not represented in the heatmap. Default is 0.10.\n#' @param cap cap p-values below this threshold\n#' @param log_scale logical indicating whether to plot the -log of the p.values.\n#' @param ... extra arguments to be passed to the \\link{pheatmap} function\n#' @return produces a heatmap\n#' @importFrom pheatmap pheatmap\n#' @importFrom grDevices colorRampPalette\n#' @export\nplot_enrichment_heatmap <- function(enrichment.results, alpha = 0.1, cap = 1e-50, log_scale = TRUE, ...) {\n \n # get p-values\n p.values <- enrichment.results$pval.adj\n \n # remove factors that are full of NAs\n p.values <- p.values[,colMeans(is.na(p.values))<1]\n \n # cap p-values \n p.values[p.valuesmax.pathways)\n baz <- head(baz[order(baz$pvalue),],n=max.pathways)\n }\n \n # order pathways according to significance\n baz$pathway <- factor(baz$pathway, levels = baz$pathway[order(baz$pvalue, decreasing = TRUE)])\n \n # Merge\n foobar <- merge(foo, bar, by=\"feature\")\n tmp <- merge(foobar, baz, by=\"pathway\")\n \n # Select the top N features with the largest feature.statistic (per pathway)\n tmp_filt <- top_n(group_by(tmp, pathway), n=max.genes, abs(feature.statistic))\n \n # Add number of features and p-value per pathway\n pathways <- unique(tmp_filt$pathway)\n \n # Add Ngenes and p-values to the pathway name\n df <- data.frame(pathway=pathways, nfeatures=rowSums(feature.sets,na.rm=TRUE)[pathways])\n df <- merge(df, baz, by=\"pathway\")\n df$pathway_long_name <- sprintf(\"%s\\n (Ngenes = %d) \\n (p-val = %0.2g)\",df$pathway, df$nfeatures, df$pvalue)\n tmp <- merge(tmp, df[,c(\"pathway\",\"pathway_long_name\")], by=\"pathway\")\n tmp_filt <- merge(tmp_filt, df[,c(\"pathway\",\"pathway_long_name\")], by=\"pathway\")\n \n # sort pathways by p-value\n order_pathways <- df$pathway_long_name[order(df$pvalue,decreasing=TRUE) ]\n tmp$pathway_long_name <- factor(tmp$pathway_long_name, levels=order_pathways)\n tmp_filt$pathway_long_name <- factor(tmp_filt$pathway_long_name, levels=order_pathways)\n \n p <- ggplot(tmp, aes(x=.data[[\"pathway_long_name\"]], y=.data[[\"feature.statistic\"]])) +\n geom_text_repel(aes(x=.data[[\"pathway_long_name\"]], y=.data[[\"feature.statistic\"]], label=.data$feature), size=text_size, color=\"black\", force=1, data=tmp_filt) +\n geom_point(size=0.5, color=\"lightgrey\") +\n geom_point(aes(x=.data[[\"pathway_long_name\"]], y=.data[[\"feature.statistic\"]]), size=1, color=\"black\", data=tmp_filt) +\n labs(x=\"\", y=\"Weight (scaled)\", title=\"\") +\n coord_flip() +\n theme(\n axis.line = element_line(color=\"black\"),\n axis.text.y = element_text(size=rel(0.75), hjust=1, color='black'),\n axis.text.x = element_text(size=rel(1.0), vjust=0.5, color='black'),\n axis.title.y=element_blank(),\n legend.position='none',\n panel.background = element_blank()\n )\n \n return(p)\n}\n\n\n\n#############################################################\n## Internal methods for enrichment analysis (not exported) ##\n#############################################################\n\n# This is a modified version of the PCGSE module\n.pcgse = function(data, prcomp.output, feature.sets, pc.indexes, \n set.statistic, set.test) {\n \n # Sanity checks\n if (is.null(feature.sets))\n stop(\"'feature.sets' must be specified!\")\n if (!(set.statistic %in% c(\"mean.diff\", \"rank.sum\")))\n stop(\"set.statistic must be 'mean.diff' or 'rank.sum'\")\n if (!(set.test %in% c(\"parametric\", \"cor.adj.parametric\", \"permutation\")))\n stop(\"set.test must be one of 'parametric', 'cor.adj.parametric', 'permutation'\")\n \n \n # Turn the feature set matrix into list form\n set.indexes <- feature.sets \n if (is.matrix(feature.sets)) {\n set.indexes <- .createVarGroupList(var.groups=feature.sets) \n }\n \n # Compute the feature statistics.\n feature.statistics <- matrix(0, nrow=ncol(data), ncol=length(pc.indexes))\n for (i in seq_along(pc.indexes)) {\n feature.statistics[,i] <- .compute_feature_statistics(\n data = data,\n prcomp.output = prcomp.output,\n pc.index = pc.indexes[i]\n )\n }\n \n # Compute the set statistics.\n if (set.test == \"parametric\" || set.test == \"cor.adj.parametric\") {\n if (set.statistic == \"mean.diff\") {\n results <- .pcgse_ttest(\n data = data, \n prcomp.output = prcomp.output,\n pc.indexes = pc.indexes,\n set.indexes = set.indexes,\n feature.statistics = feature.statistics,\n cor.adjustment = (set.test == \"cor.adj.parametric\")\n )\n } else if (set.statistic == \"rank.sum\") {\n results <- .pcgse_wmw(\n data = data, \n prcomp.output = prcomp.output,\n pc.indexes = pc.indexes,\n set.indexes = set.indexes,\n feature.statistics = feature.statistics,\n cor.adjustment = (set.test == \"cor.adj.parametric\")\n )\n }\n }\n \n # Add feature.statistics to the results\n results$feature.statistics <- feature.statistics\n \n return (results) \n}\n\n\n\n\n# Turn the annotation matrix into a list of var group indexes for the valid sized var groups\n.createVarGroupList <- function(var.groups) {\n var.group.indexes <- list() \n for (i in seq_len(nrow(var.groups))) {\n member.indexes <- which(var.groups[i,]==1)\n var.group.indexes[[i]] <- member.indexes \n }\n names(var.group.indexes) <- rownames(var.groups) \n return (var.group.indexes)\n}\n\n# Computes the feature-level statistics\n.compute_feature_statistics <- function(data, prcomp.output, pc.index) {\n feature.statistics <- prcomp.output$rotation[,pc.index]\n feature.statistics <- vapply(feature.statistics, abs, numeric(1))\n return (feature.statistics)\n}\n\n# Compute enrichment via t-test\n#' @importFrom stats pt var\n.pcgse_ttest <- function(data, prcomp.output, pc.indexes,\n set.indexes, feature.statistics, cor.adjustment) {\n \n num.feature.sets <- length(set.indexes)\n \n # Create matrix for p-values\n p.values <- matrix(0, nrow=num.feature.sets, ncol=length(pc.indexes)) \n rownames(p.values) <- names(set.indexes)\n \n # Create matrix for set statistics\n set.statistics <- matrix(TRUE, nrow=num.feature.sets, ncol=length(pc.indexes)) \n rownames(set.statistics) <- names(set.indexes) \n \n for (i in seq_len(num.feature.sets)) {\n indexes.for.feature.set <- set.indexes[[i]]\n m1 <- length(indexes.for.feature.set)\n not.set.indexes <- which(!(seq_len(ncol(data)) %in% indexes.for.feature.set))\n m2 <- length(not.set.indexes)\n \n if (cor.adjustment) { \n # compute sample correlation matrix for members of feature set\n cor.mat <- cor(data[,indexes.for.feature.set], use = \"complete.obs\")\n # compute the mean pair-wise correlation \n mean.cor <- (sum(cor.mat) - m1)/(m1*(m1-1)) \n # compute the VIF, using CAMERA formula from Wu et al., based on Barry et al.\n vif <- 1 + (m1 -1)*mean.cor\n }\n \n for (j in seq_along(pc.indexes)) {\n # get the feature statistics for this PC\n pc.feature.stats <- feature.statistics[,j]\n # compute the mean difference of the feature-level statistics\n mean.diff <- mean(pc.feature.stats[indexes.for.feature.set],na.rm=TRUE) - mean(pc.feature.stats[not.set.indexes], na.rm=TRUE)\n # compute the pooled standard deviation\n pooled.sd <- sqrt(((m1-1)*var(pc.feature.stats[indexes.for.feature.set], na.rm=TRUE) + (m2-1)*var(pc.feature.stats[not.set.indexes], na.rm=TRUE))/(m1+m2-2))\n\n # compute the t-statistic\n if (cor.adjustment) {\n t.stat <- mean.diff/(pooled.sd*sqrt(vif/m1 + 1/m2))\n df <- nrow(data)-2\n } else {\n t.stat <- mean.diff/(pooled.sd*sqrt(1/m1 + 1/m2))\n df <- m1+m2-2\n }\n set.statistics[i,j] <- t.stat \n # compute the p-value via a two-sided test\n lower.p <- pt(t.stat, df=df, lower.tail=TRUE)\n upper.p <- pt(t.stat, df=df, lower.tail=FALSE) \n p.values[i,j] <- 2*min(lower.p, upper.p) \n }\n } \n \n # Build the result list\n results <- list()\n results$p.values <- p.values\n results$statistics <- set.statistics \n \n return (results)\n}\n\n# Compute enrichment via Wilcoxon Mann Whitney \n#' @importFrom stats wilcox.test pnorm\n.pcgse_wmw <- function(data, prcomp.output, pc.indexes,\n set.indexes, feature.statistics, cor.adjustment) {\n \n num.feature.sets <- length(set.indexes)\n \n # Create matrix for p-values\n p.values <- matrix(0, nrow=num.feature.sets, ncol=length(pc.indexes)) \n rownames(p.values) <- names(set.indexes)\n \n # Create matrix for set statistics\n set.statistics <- matrix(TRUE, nrow=num.feature.sets, ncol=length(pc.indexes)) \n rownames(set.statistics) <- names(set.indexes) \n \n for (i in seq_len(num.feature.sets)) {\n indexes.for.feature.set <- set.indexes[[i]]\n m1 <- length(indexes.for.feature.set)\n not.set.indexes <- which(!(seq_len(ncol(data)) %in% indexes.for.feature.set))\n m2 <- length(not.set.indexes)\n \n if (cor.adjustment) { \n # compute sample correlation matrix for members of feature set\n cor.mat <- cor(data[,indexes.for.feature.set], use=\"complete.obs\")\n # compute the mean pair-wise correlation \n mean.cor <- (sum(cor.mat) - m1)/(m1*(m1-1)) \n }\n \n for (j in seq_along(pc.indexes)) {\n # get the feature-level statistics for this PC\n pc.feature.stats <- feature.statistics[,j]\n # compute the rank sum statistic feature-level statistics\n wilcox.results <- wilcox.test(x=pc.feature.stats[indexes.for.feature.set],\n y=pc.feature.stats[not.set.indexes],\n alternative=\"two.sided\", exact=FALSE, correct=FALSE)\n rank.sum = wilcox.results$statistic \n if (cor.adjustment) {\n # Using correlation-adjusted formula from Wu et al.\n var.rank.sum <- ((m1*m2)/(2*pi))*\n (asin(1) + (m2 - 1)*asin(.5) + (m1-1)*(m2-1)*asin(mean.cor/2) +(m1-1)*asin((mean.cor+1)/2))\n } else { \n var.rank.sum <- m1*m2*(m1+m2+1)/12\n }\n z.stat <- (rank.sum - (m1*m2)/2)/sqrt(var.rank.sum)\n set.statistics[i,j] <- z.stat\n \n # compute the p-value via a two-sided z-test\n lower.p <- pnorm(z.stat, lower.tail=TRUE)\n upper.p <- pnorm(z.stat, lower.tail=FALSE) \n p.values[i,j] <- 2*min(lower.p, upper.p)\n }\n } \n \n # Build the result list\n results <- list()\n results$p.values <- p.values\n results$statistics <- set.statistics \n \n return (results)\n}\n" }, { "path": "R/get_methods.R", "content": "\n################################################\n## Get functions to fetch data from the model ##\n################################################\n\n#' @title Get dimensions\n#' @name get_dimensions\n#' @description Extract dimensionalities from the model. \n#' @details K indicates the number of factors, M indicates the number of views, D indicates the number of features (per view), \n#' N indicates the number of samples (per group) and C indicates the number of covariates.\n#' @param object a \\code{\\link{MOFA}} object.\n#' @return list containing the dimensionalities of the model\n#' @export\n#' @examples\n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' dims <- get_dimensions(model)\n\nget_dimensions <- function(object) {\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n return(object@dimensions)\n}\n\n#' @title Get ELBO\n#' @name get_elbo\n#' @description Extract the value of the ELBO statistics after model training. This can be useful for model selection.\n#' @details This can be useful for model selection.\n#' @param object a \\code{\\link{MOFA}} object.\n#' @return Value of the ELBO\n#' @export\n#' @examples\n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' elbo <- get_elbo(model)\n\nget_elbo <- function(object) {\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n return(max(object@training_stats$elbo, na.rm=TRUE))\n}\n\n#' @title Get lengthscales\n#' @name get_lengthscales\n#' @description Extract the inferred lengthscale for each factor after model training. \n#' @details This can be used only if covariates are passed to the MOFAobject upon creation and GP_factors is set to True.\n#' @param object a \\code{\\link{MOFA}} object.\n#' @return A numeric vector containing the lengthscale for each factor.\n#' @export\n#' @examples \n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' ls <- get_lengthscales(model)\nget_lengthscales <- function(object) {\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if(!.hasSlot(object, \"covariates\") || is.null(object@covariates)) stop(\"No covariates specified in 'object'\")\n if(is.null(object@training_stats$length_scales)) stop(\"No lengthscales saved in 'object' \\n Make sure you specify the covariates and train setting the option 'GP_factors' to TRUE.\")\n tmp <- object@training_stats$length_scales\n return(tmp)\n}\n\n\n#' @title Get scales\n#' @name get_scales\n#' @description Extract the inferred scale for each factor after model training. \n#' @details This can be used only if covariates are passed to the MOFAobject upon creation and GP_factors is set to True.\n#' @param object a \\code{\\link{MOFA}} object.\n#' @return A numeric vector containing the scale for each factor.\n#' @export\n#' @examples \n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' s <- get_scales(model)\nget_scales <- function(object) {\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if(!.hasSlot(object, \"covariates\") || is.null(object@covariates)) stop(\"No covariates specified in 'object'\")\n if(is.null(object@training_stats$scales)) stop(\"No scales saved in 'object' \\n Make sure you specify the covariates and train setting the option 'GP_factors' to TRUE.\")\n tmp <- object@training_stats$scales\n return(tmp)\n}\n\n#' @title Get group covariance matrix\n#' @name get_group_kernel\n#' @description Extract the inferred group-group covariance matrix per factor\n#' @details This can be used only if covariates are passed to the MOFAobject upon creation and GP_factors is set to True.\n#' @param object a \\code{\\link{MOFA}} object.\n#' @return A list of group-group correlation matrices per factor\n#' @export\nget_group_kernel <- function(object) {\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if(is.null(object@covariates)) stop(\"No covariates specified in 'object'\")\n if (is.null(object@mefisto_options)) stop(\"'object' does have MEFISTO training options.\")\n \n if(!object@mefisto_options$model_groups || object@dimensions$G == 1) {\n tmp <- lapply(seq_len(dim(object@training_stats$Kg)[3]), function(x) {\n mat <- matrix(1, nrow = object@dimensions$G, ncol = object@dimensions$G)\n rownames(mat) <- colnames(mat) <- groups_names(object)\n mat\n })\n } else {\n if(is.null(object@training_stats$Kg)) stop(\"No group kernel saved in 'object' \\n Make sure you specify the covariates and train setting the option 'model_groups' to TRUE.\")\n tmp <- lapply(seq_len(dim(object@training_stats$Kg)[3]), function(x) {\n mat <- object@training_stats$Kg[ , , x]\n rownames(mat) <- colnames(mat) <- groups_names(object)\n mat\n })\n }\n names(tmp) <- factors_names(object)\n return(tmp)\n}\n\n#' @title Get interpolated factor values\n#' @name get_interpolated_factors\n#' @description Extract the interpolated factor values\n#' @details This can be used only if covariates are passed to the object upon creation, GP_factors is set to True and new covariates were passed for interpolation.\n#' @param object a \\code{\\link{MOFA}} object\n#' @param as.data.frame logical indicating whether to return data as a data.frame\n#' @param only_mean logical indicating whether include only mean or also uncertainties\n#' @return By default, a nested list containing for each group a list with a matrix with the interpolated factor values (\"mean\"),\n#' their variance (\"variance\") and the values of the covariate at which interpolation took place (\"new_values\"). \n#' Alternatively, if \\code{as.data.frame} is \\code{TRUE}, returns a long-formatted data frame with columns containing the covariates \n#' and (factor, group, mean and variance).\n#' @import dplyr\n#' @import reshape2\n#' @export\nget_interpolated_factors <- function(object, as.data.frame = FALSE, only_mean = FALSE) {\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if(is.null(object@interpolated_Z)) stop(\"No interpolated factors present in 'object'\")\n if(length(object@interpolated_Z) == 0) stop(\"No interpolated factors present in 'object'\")\n \n if(!as.data.frame){\n return(object@interpolated_Z)\n } else {\n type <- NULL\n preds <- lapply(object@interpolated_Z, function(l) l[names(l)[names(l) != \"new_values\"]])\n df_interpol <- reshape2::melt(preds, varnames = c(\"factor\", \"sample_id\"))\n df_interpol <- dplyr::rename(df_interpol, group = L1, type = L2)\n if(only_mean){\n df_interpol <- filter(df_interpol, type == \"mean\")\n }\n \n if(\"new_values\" %in% names(object@interpolated_Z[[1]])) {\n new_vals <- lapply(object@interpolated_Z, function(l) l[names(l)[names(l) == \"new_values\"]])\n new_vals <- reshape2::melt(new_vals, varnames = c(\"covariate\",\"sample_id\"))\n new_vals <- mutate(new_vals, covariate = covariates_names(object))\n new_vals <- rename(new_vals, group = L1, covariate_value = value)\n new_vals <- spread(new_vals, key = covariate, value = covariate_value)\n new_vals <- select(new_vals, -L2)\n df_interpol <- left_join(df_interpol, new_vals, by = c(\"group\", \"sample_id\"))\n df_interpol <- select(df_interpol, -sample_id)\n } else { # compatibility to older objects\n df_interpol <- rename(df_interpol, covariate_value = sample_id)\n df_interpol <- mutate(df_interpol, covariate = covariates_names(object))\n }\n df_interpol <- mutate(df_interpol, factor = factors_names(object)[factor])\n df_interpol <- spread(df_interpol, key = type, value = value)\n return(df_interpol)\n }\n}\n\n\n#' @title Get factors\n#' @name get_factors\n#' @description Extract the latent factors from the model.\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param factors character vector with the factor name(s), or numeric vector with the factor index(es).\n#' Default is \"all\".\n#' @param groups character vector with the group name(s), or numeric vector with the group index(es).\n#' Default is \"all\".\n#' @param scale logical indicating whether to scale factor values.\n#' @param as.data.frame logical indicating whether to return a long data frame instead of a matrix.\n#' Default is \\code{FALSE}.\n#' @return By default it returns the latent factor matrix of dimensionality (N,K), where N is number of samples and K is number of factors. \\cr\n#' Alternatively, if \\code{as.data.frame} is \\code{TRUE}, returns a long-formatted data frame with columns (sample,factor,value).\n#' @export\n#' \n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#'\n#' # Fetch factors in matrix format (a list, one matrix per group)\n#' factors <- get_factors(model)\n#'\n#' # Concatenate groups\n#' factors <- do.call(\"rbind\",factors)\n#'\n#' # Fetch factors in data.frame format instead of matrix format\n#' factors <- get_factors(model, as.data.frame = TRUE)\nget_factors <- function(object, groups = \"all\", factors = \"all\", scale = FALSE, as.data.frame = FALSE) {\n\n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Get groups\n groups <- .check_and_get_groups(object, groups)\n # Get factors\n factors <- .check_and_get_factors(object, factors)\n \n # Collect factors\n Z <- get_expectations(object, \"Z\", as.data.frame)\n if (as.data.frame) {\n Z <- Z[Z$factor%in%factors & Z$group%in%groups,]\n if (scale) Z$value <- Z$value/max(abs(Z$value),na.rm=TRUE)\n } else {\n Z <- lapply(Z[groups], function(z) z[,factors, drop=FALSE])\n if (scale) Z <- lapply(Z, function(x) x/max(abs(x)) )\n names(Z) <- groups\n }\n\n return(Z)\n}\n\n\n#' @title Get weights\n#' @name get_weights\n#' @description Extract the weights from the model.\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param views character vector with the view name(s), or numeric vector with the view index(es). \n#' Default is \"all\".\n#' @param factors character vector with the factor name(s) or numeric vector with the factor index(es). \\cr\n#' Default is \"all\".\n#' @param abs logical indicating whether to take the absolute value of the weights.\n#' @param scale logical indicating whether to scale all weights from -1 to 1 (or from 0 to 1 if \\code{abs=TRUE}).\n#' @param as.data.frame logical indicating whether to return a long data frame instead of a list of matrices. \n#' Default is \\code{FALSE}.\n#' @return By default it returns a list where each element is a loading matrix with dimensionality (D,K), \n#' where D is the number of features and K is the number of factors. \\cr\n#' Alternatively, if \\code{as.data.frame} is \\code{TRUE}, returns a long-formatted data frame with columns (view,feature,factor,value).\n#' @export\n#' \n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#'\n#' # Fetch weights in matrix format (a list, one matrix per view)\n#' weights <- get_weights(model)\n#'\n#' # Fetch weights for factor 1 and 2 and view 1\n#' weights <- get_weights(model, views = 1, factors = c(1,2))\n#'\n#' # Fetch weights in data.frame format\n#' weights <- get_weights(model, as.data.frame = TRUE)\n\nget_weights <- function(object, views = \"all\", factors = \"all\", abs = FALSE, scale = FALSE, as.data.frame = FALSE) {\n\n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Get views\n views <- .check_and_get_views(object, views)\n factors <- .check_and_get_factors(object, factors)\n \n # Fetch weights\n weights <- get_expectations(object, \"W\", as.data.frame)\n \n if (as.data.frame) {\n weights <- weights[weights$view %in% views & weights$factor %in% factors, ]\n if (abs) weights$value <- abs(weights$value)\n if (scale) weights$value <- weights$value/max(abs(weights$value))\n } else {\n weights <- lapply(weights[views], function(x) x[,factors,drop=FALSE])\n if (abs) weights <- lapply(weights, abs)\n if (scale) weights <- lapply(weights, function(x) x/max(abs(x)) )\n names(weights) <- views\n }\n \n return(weights)\n}\n\n\n#' @title Get data\n#' @name get_data\n#' @description Fetch the input data\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param views character vector with the view name(s), or numeric vector with the view index(es). \n#' Default is \"all\".\n#' @param groups character vector with the group name(s), or numeric vector with the group index(es). \n#' Default is \"all\".\n#' @param features a *named* list of character vectors. Example: list(\"view1\"=c(\"feature_1\",\"feature_2\"), \"view2\"=c(\"feature_3\",\"feature_4\"))\n#' Default is \"all\".\n#' @param as.data.frame logical indicating whether to return a long data frame instead of a list of matrices. Default is \\code{FALSE}.\n#' @param add_intercept logical indicating whether to add feature intercepts to the data. Default is \\code{TRUE}.\n#' @param denoise logical indicating whether to return the denoised data (i.e. the model predictions). Default is \\code{FALSE}.\n#' @param na.rm remove NAs from the data.frame (only if as.data.frame is \\code{TRUE}).\n#' @details By default this function returns a list where each element is a data matrix with dimensionality (D,N) \n#' where D is the number of features and N is the number of samples. \\cr\n#' Alternatively, if \\code{as.data.frame} is \\code{TRUE}, the function returns a long-formatted data frame with columns (view,feature,sample,value).\n#' Missing values are not included in the the long data.frame format by default. To include them use the argument \\code{na.rm=FALSE}.\n#' @return A list of data matrices with dimensionality (D,N) or a \\code{data.frame} (if \\code{as.data.frame} is TRUE)\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#'\n#' # Fetch data\n#' data <- get_data(model)\n#'\n#' # Fetch a specific view\n#' data <- get_data(model, views = \"view_0\")\n#'\n#' # Fetch data in data.frame format instead of matrix format\n#' data <- get_data(model, as.data.frame = TRUE)\n#'\n#' # Fetch centered data (do not add the feature intercepts)\n#' data <- get_data(model, as.data.frame = FALSE)\n#' \n#' # Fetch denoised data (do not add the feature intercepts)\n#' data <- get_data(model, denoise = TRUE)\nget_data <- function(object, views = \"all\", groups = \"all\", features = \"all\", as.data.frame = FALSE, add_intercept = TRUE, denoise = FALSE, na.rm = TRUE) {\n\n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Get views and groups\n views <- .check_and_get_views(object, views)\n groups <- .check_and_get_groups(object, groups)\n \n # Get features\n if (is(features, \"list\")) {\n if (is.null(names(features))) stop(\"features has to be a *named* list of character vectors. Please see the documentation\")\n if (!(names(features)%in%views_names(object))) stop(\"Views not recognised\")\n if (!all(sapply(names(features), function(i) all(features[[i]] %in% features_names(object)[[i]]) ))) stop(\"features not recognised\")\n if (any(sapply(features,length)<1)) stop(\"features not recognised, please read the documentation\")\n views <- names(features)\n } else {\n if (paste0(features, collapse=\"\") == \"all\") { \n features <- features_names(object)[views]\n } else {\n stop(\"features not recognised, please read the documentation\")\n }\n }\n\n # Fetch data\n if (denoise) {\n data <- predict(object, views=views, groups=groups)\n } else {\n data <- lapply(object@data[views], function(x) x[groups])\n }\n data <- lapply(views, function(m) lapply(seq_len(length(data[[1]])), function(p) data[[m]][[p]][as.character(features[[m]]),,drop=FALSE]))\n data <- .name_views_and_groups(data, views, groups)\n \n # Add feature intercepts (only for gaussian likelihoods)\n tryCatch( {\n \n if (add_intercept & length(object@intercepts[[1]])>0) {\n intercepts <- lapply(object@intercepts[views], function(x) x[groups])\n intercepts <- lapply(seq_len(length(intercepts)), function(m) lapply(seq_len(length(intercepts[[1]])), function(p) intercepts[[m]][[p]][as.character(features[[m]])]))\n intercepts <- .name_views_and_groups(intercepts, views, groups)\n \n for (m in names(data)) {\n if (object@model_options$likelihoods[[m]]==\"gaussian\") {\n for (g in names(data[[m]])) {\n data[[m]][[g]] <- data[[m]][[g]] + intercepts[[m]][[g]][as.character(features[[m]])]\n }\n }\n }\n } }, error = function(e) { NULL })\n\n # Convert to long data frame\n if (as.data.frame) {\n tmp <- lapply(views, function(m) { \n lapply(groups, function(p) { \n tmp <- reshape2::melt(data[[m]][[p]], na.rm=na.rm)\n if(nrow(tmp) >0 & !is.null(tmp)) {\n colnames(tmp) <- c(\"feature\", \"sample\", \"value\")\n tmp <- cbind(view = m, group = p, tmp)\n return(tmp) \n } \n })\n })\n data <- do.call(rbind, do.call(rbind, tmp))\n factor.cols <- c(\"view\",\"group\",\"feature\",\"sample\")\n data[factor.cols] <- lapply(data[factor.cols], factor)\n \n }\n \n return(data)\n}\n\n\n#' @title Get imputed data\n#' @name get_imputed_data\n#' @description Function to get the imputed data. It requires the previous use of the \\code{\\link{impute}} method.\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param views character vector with the view name(s), or numeric vector with the view index(es). \n#' Default is \"all\".\n#' @param groups character vector with the group name(s), or numeric vector with the group index(es).\n#' Default is \"all\".\n#' @param features list of character vectors with the feature names or list of numeric vectors with the feature indices. \n#' Default is \"all\".\n#' @param as.data.frame logical indicating whether to return a long-formatted data frame instead of a list of matrices. \n#' Default is \\code{FALSE}.\n#' @details Data is imputed from the generative model of MOFA.\n#' @return A list containing the imputed valued or a data.frame if as.data.frame is TRUE\n#' @export\n#' @examples\n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' model <- impute(model)\n#' imputed <- get_imputed_data(model)\n\nget_imputed_data <- function(object, views = \"all\", groups = \"all\", features = \"all\", as.data.frame = FALSE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if (length(object@imputed_data)==0) stop(\"imputed data not found, did you run: 'object <- impute(object)'?\")\n \n # Get views and groups\n views <- .check_and_get_views(object, views)\n groups <- .check_and_get_groups(object, groups)\n\n # Get features\n if (is(features, \"list\")) {\n stopifnot(all(sapply(seq_len(length(features)), function(i) all(features[[i]] %in% features_names(object)[[views[i]]]))))\n stopifnot(length(features)==length(views))\n if (is.null(names(features))) names(features) <- views\n } else {\n if (paste0(features, collapse=\"\") == \"all\") { \n features <- features_names(object)[views]\n } else {\n stop(\"features not recognised, please read the documentation\")\n }\n }\n \n # Fetch mean\n imputed_data <- lapply(object@imputed_data[views], function(x) x[groups] )\n imputed_data <- lapply(seq_len(length(imputed_data)), function(m) lapply(seq_len(length(imputed_data[[1]])), function(p) imputed_data[[m]][[p]][as.character(features[[m]]),,drop=FALSE]))\n imputed_data <- .name_views_and_groups(imputed_data, views, groups)\n \n# Add feature intercepts\n# tryCatch( {\n#\n# if (add_intercept & length(object@intercepts[[1]])>0) {\n# intercepts <- lapply(object@intercepts[views], function(x) x[groups])\n# intercepts <- .name_views_and_groups(intercepts, views, groups)\n#\n# for (m in names(imputed_data)) {\n# for (g in names(imputed_data[[m]])) {\n# imputed_data[[m]][[g]] <- imputed_data[[m]][[g]] + intercepts[[m]][[g]][as.character(features[[m]])]\n# }\n# }\n# } }, error = function(e) { NULL })\n\n # Convert to long data frame\n if (isTRUE(as.data.frame)) {\n \n imputed_data <- lapply(views, function(m) { \n lapply(groups, function(g) { \n tmp <- reshape2::melt(imputed_data[[m]][[g]])\n colnames(tmp) <- c(\"feature\", \"sample\", \"value\")\n tmp <- cbind(view = m, group = g, tmp)\n return(tmp) \n })\n })\n imputed_data <- do.call(rbind, do.call(rbind, imputed_data))\n \n\n factor.cols <- c(\"view\",\"group\",\"feature\",\"sample\")\n imputed_data[factor.cols] <- lapply(imputed_data[factor.cols], factor)\n }\n return(imputed_data)\n}\n\n\n#' @title Get expectations\n#' @name get_expectations\n#' @description Function to extract the expectations from the (variational) posterior distributions of a trained \\code{\\link{MOFA}} object.\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param variable variable name: 'Z' for factors and 'W' for weights.\n#' @param as.data.frame logical indicating whether to output the result as a long data frame, default is \\code{FALSE}.\n#' @details Technical note: MOFA is a Bayesian model where each variable has a prior distribution and a posterior distribution. \n#' In particular, to achieve scalability we used the variational inference framework, thus true posterior distributions are replaced by approximated variational distributions.\n#' This function extracts the expectations of the variational distributions, which can be used as final point estimates to analyse the results of the model. \\cr \n#' The priors and variational distributions of each variable are extensively described in the supplementary methods of the original paper.\n#' @return the output varies depending on the variable of interest: \\cr\n#' \\itemize{\n#' \\item{\\strong{\"Z\"}: a matrix with dimensions (samples,factors). If \\code{as.data.frame} is \\code{TRUE}, a long-formatted data frame with columns (sample,factor,value)}\n#' \\item{\\strong{\"W\"}: a list of length (views) where each element is a matrix with dimensions (features,factors). If \\code{as.data.frame} is \\code{TRUE}, a long-formatted data frame with columns (view,feature,factor,value)}\n#' }\n#' @export\n#' @examples\n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' factors <- get_expectations(model, \"Z\")\n#' weights <- get_expectations(model, \"W\")\n\nget_expectations <- function(object, variable, as.data.frame = FALSE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(variable %in% names(object@expectations))\n \n # Get expectations in single matrix or list of matrices (for multi-view nodes)\n exp <- object@expectations[[variable]]\n\n # unlist single view nodes - single Sigma node across all groups using time warping\n if(variable == \"Sigma\")\n exp <- exp[[1]]\n \n # For memory and space efficiency, Y expectations are not saved to the model file when using only gaussian likelihoods.\n if (variable == \"Y\") {\n if ((length(object@expectations$Y) == 0) && all(object@model_options$likelihood == \"gaussian\")) {\n # message(\"Using training data slot as Y expectations since all the likelihoods are gaussian.\")\n exp <- object@data\n }\n }\n \n # Convert to long data frame\n if (as.data.frame) {\n \n # Z node\n if (variable==\"Z\") {\n tmp <- reshape2::melt(exp, na.rm=TRUE)\n colnames(tmp) <- c(\"sample\", \"factor\", \"value\", \"group\")\n tmp$sample <- as.character(tmp$sample)\n factor.cols <- c(\"sample\", \"factor\", \"group\")\n factor.cols[factor.cols] <- lapply(factor.cols[factor.cols], factor)\n }\n \n # W node\n else if (variable==\"W\") {\n tmp <- lapply(names(exp), function(m) { \n tmp <- reshape2::melt(exp[[m]], na.rm=TRUE)\n colnames(tmp) <- c(\"feature\",\"factor\",\"value\")\n tmp$view <- m\n factor.cols <- c(\"view\", \"feature\", \"factor\")\n tmp[factor.cols] <- lapply(tmp[factor.cols], factor)\n return(tmp)\n })\n tmp <- do.call(rbind.data.frame,tmp)\n }\n \n # Y node\n else if (variable==\"Y\") {\n tmp <- lapply(names(exp), function(m) {\n tmp <- lapply(names(exp[[m]]), function(g) {\n tmp <- reshape2::melt(exp[[m]][[g]], na.rm=TRUE)\n colnames(tmp) <- c(\"sample\", \"feature\", \"value\")\n tmp$view <- m\n tmp$group <- g\n factor.cols <- c(\"view\", \"group\", \"feature\", \"factor\")\n tmp[factor.cols] <- lapply(tmp[factor.cols], factor)\n return(tmp)\n })\n })\n tmp <- do.call(rbind, tmp)\n }\n \n exp <- tmp\n }\n return(exp)\n}\n\n\n#' @title Get variance explained values\n#' @name get_variance_explained\n#' @description Extract the latent factors from the model.\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param factors character vector with the factor name(s), or numeric vector with the factor index(es).\n#' Default is \"all\".\n#' @param groups character vector with the group name(s), or numeric vector with the group index(es).\n#' Default is \"all\".\n#' @param views character vector with the view name(s), or numeric vector with the view index(es).\n#' Default is \"all\".\n#' @param as.data.frame logical indicating whether to return a long data frame instead of a matrix.\n#' Default is \\code{FALSE}.\n#' @return A list of data matrices with variance explained per group or a \\code{data.frame} (if \\code{as.data.frame} is TRUE)\n#' @export\n#'\n#' @examples\n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#'\n#' # Fetch variance explained values (in matrix format)\n#' r2 <- get_variance_explained(model)\n#'\n#' # Fetch variance explained values (in data.frame format)\n#' r2 <- get_variance_explained(model, as.data.frame = TRUE)\n#'\nget_variance_explained <- function(object, groups = \"all\", views = \"all\", factors = \"all\", \n as.data.frame = FALSE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Get factors and groups\n groups <- .check_and_get_groups(object, groups)\n views <- .check_and_get_views(object, views)\n factors <- .check_and_get_factors(object, factors)\n \n # Fetch R2\n if (.hasSlot(object, \"cache\") && (\"variance_explained\" %in% names(object@cache))) {\n r2_list <- object@cache$variance_explained\n } else {\n r2_list <- calculate_variance_explained(object, factors = factors, views = views, groups = groups)\n }\n \n # Convert to data.frame format\n if (as.data.frame) {\n \n # total R2\n r2_total <- reshape2::melt( do.call(\"rbind\",r2_list[[\"r2_total\"]]) )\n colnames(r2_total) <- c(\"group\", \"view\", \"value\")\n \n # R2 per factor\n r2_per_factor <- lapply(names(r2_list[[\"r2_per_factor\"]]), function(g) {\n x <- reshape2::melt( r2_list[[\"r2_per_factor\"]][[g]] )\n colnames(x) <- c(\"factor\", \"view\", \"value\")\n x$factor <- as.factor(x$factor)\n x$group <- g\n return(x)\n })\n r2_per_factor <- do.call(\"rbind\",r2_per_factor)[,c(\"group\",\"view\",\"factor\",\"value\")]\n r2 <- list(\"r2_per_factor\"=r2_per_factor, \"r2_total\"=r2_total)\n \n } else {\n r2 <- r2_list\n }\n \n return(r2)\n}" }, { "path": "R/imports.R", "content": "#' Re-exporting the pipe operator\n#' See \\code{magrittr::\\link[magrittr]{\\%>\\%}} for details.\n#'\n#' @name %>%\n#' @rdname pipe\n#' @param lhs see \\code{magrittr::\\link[magrittr]{\\%>\\%}}\n#' @param rhs see \\code{magrittr::\\link[magrittr]{\\%>\\%}}\n#' @export\n#' @importFrom magrittr %>%\n#' @usage lhs \\%>\\% rhs\n#' @return depending on lhs and rhs\nNULL" }, { "path": "R/impute.R", "content": "\n#######################################################\n## Functions to perform imputation of missing values ##\n#######################################################\n\n#' @title Impute missing values from a fitted MOFA\n#' @name impute\n#' @description This function uses the latent factors and the loadings to impute missing values.\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param views character vector with the view name(s), or numeric vector with view index(es).\n#' @param groups character vector with the group name(s), or numeric vector with group index(es).\n#' @param factors character vector with the factor names, or numeric vector with the factor index(es).\n#' @param add_intercept add feature intercepts to the imputation (default is TRUE).\n#' @details MOFA generates a denoised and condensed low-dimensional representation of the data that captures the main sources of heterogeneity of the data.\n#' This representation can be used to reconstruct the data, simply using the equation \\code{Y = WX}. \n#' For more details read the supplementary methods of the manuscript. \\cr\n#' Note that with \\code{\\link{impute}} you can only generate the point estimates (the means of the posterior distributions). \n#' If you want to add uncertainty estimates (the variance) you need to set \\code{impute=TRUE} in the training options.\n#' See \\code{\\link{get_default_training_options}}.\n#' @return This method fills the \\code{imputed_data} slot by replacing the missing values in the input data with the model predictions.\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Impute missing values in all data modalities\n#' imputed_data <- impute(model, views = \"all\")\n#' \n#' # Impute missing values in all data modalities using factors 1:3\n#' imputed_data <- impute(model, views = \"all\", factors = 1:3)\nimpute <- function(object, views = \"all\", groups = \"all\", factors = \"all\", \n add_intercept = TRUE) {\n\n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if (length(object@imputed_data)>0) warning(\"imputed_data slot is already filled. It will be replaced and the variance estimates will be lost...\")\n \n # Get views and groups\n views <- .check_and_get_views(object, views, non_gaussian=FALSE)\n groups <- .check_and_get_groups(object, groups)\n\n\n # Do predictions\n pred <- predict(object, views=views, factors=factors, add_intercept=add_intercept)\n\n # Replace NAs with predicted values\n imputed <- get_data(object, views=views, groups=groups, add_intercept = add_intercept)\n for (m in views) {\n for (g in groups) {\n imputed[[m]][[g]] <- imputed[[m]][[g]]\n non_observed <- is.na(imputed[[m]][[g]])\n imputed[[m]][[g]][non_observed] <- pred[[m]][[g]][non_observed]\n }\n }\n \n # Save imputed data in the corresponding slot\n object@imputed_data <- imputed\n\n return(object)\n}\n\n" }, { "path": "R/load_model.R", "content": "\n############################################\n## Functions to load a trained MOFA model ##\n############################################\n\n#' @title Load a trained MOFA\n#' @name load_model\n#' @description Method to load a trained MOFA \\cr\n#' The training of mofa is done using a Python framework, and the model output is saved as an .hdf5 file, which has to be loaded in the R package.\n#' @param file an hdf5 file saved by the mofa Python framework\n#' @param sort_factors logical indicating whether factors should be sorted by variance explained (default is TRUE)\n#' @param on_disk logical indicating whether to work from memory (FALSE) or disk (TRUE). \\cr\n#' This should be set to TRUE when the training data is so big that cannot fit into memory. \\cr\n#' On-disk operations are performed using the \\code{\\link{HDF5Array}} and \\code{\\link{DelayedArray}} framework.\n#' @param load_data logical indicating whether to load the training data (default is TRUE, it can be memory expensive)\n#' @param remove_outliers logical indicating whether to mask outlier values.\n#' @param remove_inactive_factors logical indicating whether to remove inactive factors from the model.\n# #' @param remove_intercept_factors logical indicating whether to remove intercept factors for non-Gaussian views.\n#' @param verbose logical indicating whether to print verbose output (default is FALSE)\n#' @param load_interpol_Z (MEFISTO) logical indicating whether to load predictions for factor values based on latent processed (only\n#' relevant for models trained with covariates and Gaussian processes, where prediction was enabled)\n#' @return a \\code{\\link{MOFA}} model\n#' @importFrom rhdf5 h5read h5ls\n#' @importFrom HDF5Array HDF5ArraySeed\n#' @importFrom DelayedArray DelayedArray\n#' @importFrom dplyr bind_rows\n#' @export\n#' @examples\n#' #' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n\nload_model <- function(file, sort_factors = TRUE, on_disk = FALSE, load_data = TRUE,\n remove_outliers = FALSE, remove_inactive_factors = TRUE, verbose = FALSE,\n load_interpol_Z = FALSE) {\n\n # Create new MOFAodel object\n object <- new(\"MOFA\")\n object@status <- \"trained\"\n \n # Set on_disk option\n if (on_disk) { \n object@on_disk <- TRUE \n } else { \n object@on_disk <- FALSE \n }\n \n # Get groups and data set names from the hdf5 file object\n h5ls.out <- h5ls(file, datasetinfo = FALSE)\n \n ########################\n ## Load training data ##\n ########################\n\n # Load names\n if (\"views\" %in% h5ls.out$name) {\n view_names <- as.character( h5read(file, \"views\")[[1]] )\n group_names <- as.character( h5read(file, \"groups\")[[1]] )\n feature_names <- h5read(file, \"features\")[view_names]\n sample_names <- h5read(file, \"samples\")[group_names] \n } else { # for old models\n feature_names <- h5read(file, \"features\")\n sample_names <- h5read(file, \"samples\")\n view_names <- names(feature_names)\n group_names <- names(sample_names)\n h5ls.out <- h5ls.out[grep(\"variance_explained\", h5ls.out$name, invert = TRUE),]\n }\n if(\"covariates\" %in% h5ls.out$name){\n covariate_names <- as.character( h5read(file, \"covariates\")[[1]])\n } else {\n covariate_names <- NULL\n }\n\n # Load training data (as nested list of matrices)\n data <- list(); intercepts <- list()\n if (load_data && \"data\"%in%h5ls.out$name) {\n \n object@data_options[[\"loaded\"]] <- TRUE\n if (verbose) message(\"Loading data...\")\n \n for (m in view_names) {\n data[[m]] <- list()\n intercepts[[m]] <- list()\n for (g in group_names) {\n if (on_disk) {\n # as DelayedArrays\n data[[m]][[g]] <- DelayedArray::DelayedArray( HDF5ArraySeed(file, name = sprintf(\"data/%s/%s\", m, g) ) )\n } else {\n # as matrices\n data[[m]][[g]] <- h5read(file, sprintf(\"data/%s/%s\", m, g) )\n tryCatch(intercepts[[m]][[g]] <- as.numeric( h5read(file, sprintf(\"intercepts/%s/%s\", m, g) ) ), error = function(e) { NULL })\n }\n # Replace NaN by NA\n data[[m]][[g]][is.nan(data[[m]][[g]])] <- NA # this realised into memory, TO FIX\n }\n }\n \n # Create empty training data (as nested list of empty matrices, with the correct dimensions)\n } else {\n \n object@data_options[[\"loaded\"]] <- FALSE\n \n for (m in view_names) {\n data[[m]] <- list()\n for (g in group_names) {\n data[[m]][[g]] <- .create_matrix_placeholder(rownames = feature_names[[m]], colnames = sample_names[[g]])\n }\n }\n }\n\n object@data <- data\n object@intercepts <- intercepts\n\n\n # Load metadata if any\n if (\"samples_metadata\" %in% h5ls.out$name) {\n object@samples_metadata <- bind_rows(lapply(group_names, function(g) as.data.frame(h5read(file, sprintf(\"samples_metadata/%s\", g)))))\n }\n if (\"features_metadata\" %in% h5ls.out$name) {\n object@features_metadata <- bind_rows(lapply(view_names, function(m) as.data.frame(h5read(file, sprintf(\"features_metadata/%s\", m)))))\n }\n \n ############################\n ## Load sample covariates ##\n ############################\n \n if (any(grepl(\"cov_samples\", h5ls.out$group))){\n covariates <- list()\n for (g in group_names) {\n if (on_disk) {\n # as DelayedArrays\n covariates[[g]] <- DelayedArray::DelayedArray( HDF5ArraySeed(file, name = sprintf(\"cov_samples/%s\", g) ) )\n } else {\n # as matrices\n covariates[[g]] <- h5read(file, sprintf(\"cov_samples/%s\", g) )\n } \n }\n } else covariates <- NULL\n object@covariates <- covariates\n\n if (any(grepl(\"cov_samples_transformed\", h5ls.out$group))){\n covariates_warped <- list()\n for (g in group_names) {\n if (on_disk) {\n # as DelayedArrays\n covariates_warped[[g]] <- DelayedArray::DelayedArray( HDF5ArraySeed(file, name = sprintf(\"cov_samples_transformed/%s\", g) ) )\n } else {\n # as matrices\n covariates_warped[[g]] <- h5read(file, sprintf(\"cov_samples_transformed/%s\", g) )\n } \n }\n } else covariates_warped <- NULL\n object@covariates_warped <- covariates_warped\n \n #######################\n ## Load interpolated factor values ##\n #######################\n \n interpolated_Z <- list()\n if (isTRUE(load_interpol_Z)) {\n \n if (isTRUE(verbose)) message(\"Loading interpolated factor values...\")\n \n for (g in group_names) {\n interpolated_Z[[g]] <- list()\n if (on_disk) {\n # as DelayedArrays\n # interpolated_Z[[g]] <- DelayedArray::DelayedArray( HDF5ArraySeed(file, name = sprintf(\"Z_predictions/%s\", g) ) )\n } else {\n # as matrices\n tryCatch( {\n interpolated_Z[[g]][[\"mean\"]] <- h5read(file, sprintf(\"Z_predictions/%s/mean\", g) )\n }, error = function(x) { print(\"Predictions of Z not found, not loading it...\") })\n tryCatch( {\n interpolated_Z[[g]][[\"variance\"]] <- h5read(file, sprintf(\"Z_predictions/%s/variance\", g) )\n }, error = function(x) { print(\"Variance of predictions of Z not found, not loading it...\") })\n tryCatch( {\n interpolated_Z[[g]][[\"new_values\"]] <- h5read(file, \"Z_predictions/new_values\")\n }, error = function(x) { print(\"New values of Z not found, not loading it...\") })\n }\n }\n }\n object@interpolated_Z <- interpolated_Z\n \n #######################\n ## Load expectations ##\n #######################\n\n expectations <- list()\n node_names <- h5ls.out[h5ls.out$group==\"/expectations\",\"name\"]\n\n if (verbose) message(paste0(\"Loading expectations for \", length(node_names), \" nodes...\"))\n\n if (\"AlphaW\" %in% node_names)\n expectations[[\"AlphaW\"]] <- h5read(file, \"expectations/AlphaW\")[view_names]\n if (\"AlphaZ\" %in% node_names)\n expectations[[\"AlphaZ\"]] <- h5read(file, \"expectations/AlphaZ\")[group_names]\n if (\"Sigma\" %in% node_names)\n expectations[[\"Sigma\"]] <- h5read(file, \"expectations/Sigma\")\n if (\"Z\" %in% node_names)\n expectations[[\"Z\"]] <- h5read(file, \"expectations/Z\")[group_names]\n if (\"W\" %in% node_names)\n expectations[[\"W\"]] <- h5read(file, \"expectations/W\")[view_names]\n if (\"ThetaW\" %in% node_names)\n expectations[[\"ThetaW\"]] <- h5read(file, \"expectations/ThetaW\")[view_names]\n if (\"ThetaZ\" %in% node_names)\n expectations[[\"ThetaZ\"]] <- h5read(file, \"expectations/ThetaZ\")[group_names]\n # if (\"Tau\" %in% node_names)\n # expectations[[\"Tau\"]] <- h5read(file, \"expectations/Tau\")\n \n object@expectations <- expectations\n\n \n ########################\n ## Load model options ##\n ########################\n\n if (verbose) message(\"Loading model options...\")\n\n tryCatch( {\n object@model_options <- as.list(h5read(file, 'model_options', read.attributes = TRUE))\n }, error = function(x) { print(\"Model options not found, not loading it...\") })\n\n # Convert True/False strings to logical values\n for (i in names(object@model_options)) {\n if (object@model_options[i] == \"False\" || object@model_options[i] == \"True\") {\n object@model_options[i] <- as.logical(object@model_options[i])\n } else {\n object@model_options[i] <- object@model_options[i]\n }\n }\n\n ##########################################\n ## Load training options and statistics ##\n ##########################################\n\n if (verbose) message(\"Loading training options and statistics...\")\n\n # Load training options\n if (length(object@training_options) == 0) {\n tryCatch( {\n object@training_options <- as.list(h5read(file, 'training_opts', read.attributes = TRUE))\n }, error = function(x) { print(\"Training opts not found, not loading it...\") })\n }\n\n # Load training statistics\n tryCatch( {\n object@training_stats <- h5read(file, 'training_stats', read.attributes = TRUE)\n object@training_stats <- h5read(file, 'training_stats', read.attributes = TRUE)\n }, error = function(x) { print(\"Training stats not found, not loading it...\") })\n\n #############################\n ## Load covariates options ##\n #############################\n \n if (any(grepl(\"cov_samples\", h5ls.out$group))) { \n if (isTRUE(verbose)) message(\"Loading covariates options...\")\n tryCatch( {\n object@mefisto_options <- as.list(h5read(file, 'smooth_opts', read.attributes = TRUE))\n }, error = function(x) { print(\"Covariates options not found, not loading it...\") })\n \n # Convert True/False strings to logical values\n for (i in names(object@mefisto_options)) {\n if (object@mefisto_options[i] == \"False\" | object@mefisto_options[i] == \"True\") {\n object@mefisto_options[i] <- as.logical(object@mefisto_options[i])\n } else {\n object@mefisto_options[i] <- object@mefisto_options[i]\n }\n }\n \n }\n \n \n \n #######################################\n ## Load variance explained estimates ##\n #######################################\n \n if (\"variance_explained\" %in% h5ls.out$name) {\n r2_list <- list(\n r2_total = h5read(file, \"variance_explained/r2_total\")[group_names],\n r2_per_factor = h5read(file, \"variance_explained/r2_per_factor\")[group_names]\n )\n object@cache[[\"variance_explained\"]] <- r2_list\n }\n \n # Hack to fix the problems where variance explained values range from 0 to 1 (%)\n if (max(sapply(object@cache$variance_explained$r2_total,max,na.rm=TRUE),na.rm=TRUE)<1) {\n for (m in 1:length(view_names)) {\n for (g in 1:length(group_names)) {\n object@cache$variance_explained$r2_total[[g]][[m]] <- 100 * object@cache$variance_explained$r2_total[[g]][[m]]\n object@cache$variance_explained$r2_per_factor[[g]][,m] <- 100 * object@cache$variance_explained$r2_per_factor[[g]][,m]\n }\n }\n }\n \n ##############################\n ## Specify dimensionalities ##\n ##############################\n \n # Specify dimensionality of the data\n object@dimensions[[\"M\"]] <- length(data) # number of views\n object@dimensions[[\"G\"]] <- length(data[[1]]) # number of groups\n object@dimensions[[\"N\"]] <- sapply(data[[1]], ncol) # number of samples (per group)\n object@dimensions[[\"D\"]] <- sapply(data, function(e) nrow(e[[1]])) # number of features (per view)\n object@dimensions[[\"C\"]] <- nrow(covariates[[1]]) # number of covariates\n object@dimensions[[\"K\"]] <- ncol(object@expectations$Z[[1]]) # number of factors\n \n # Assign sample and feature names (slow for large matrices)\n if (verbose) message(\"Assigning names to the different dimensions...\")\n\n # Create default features names if they are null\n if (is.null(feature_names)) {\n print(\"Features names not found, generating default: feature1_view1, ..., featureD_viewM\")\n feature_names <- lapply(seq_len(object@dimensions[[\"M\"]]),\n function(m) sprintf(\"feature%d_view_&d\", as.character(seq_len(object@dimensions[[\"D\"]][m])), m))\n } else {\n # Check duplicated features names\n all_names <- unname(unlist(feature_names))\n duplicated_names <- unique(all_names[duplicated(all_names)])\n if (length(duplicated_names)>0) \n warning(\"There are duplicated features names across different views. We will add the suffix *_view* only for those features \n Example: if you have both TP53 in mRNA and mutation data it will be renamed to TP53_mRNA, TP53_mutation\")\n for (m in names(feature_names)) {\n tmp <- which(feature_names[[m]] %in% duplicated_names)\n if (length(tmp)>0) feature_names[[m]][tmp] <- paste(feature_names[[m]][tmp], m, sep=\"_\")\n }\n }\n features_names(object) <- feature_names\n \n # Create default samples names if they are null\n if (is.null(sample_names)) {\n print(\"Samples names not found, generating default: sample1, ..., sampleN\")\n sample_names <- lapply(object@dimensions[[\"N\"]], function(n) paste0(\"sample\", as.character(seq_len(n))))\n }\n samples_names(object) <- sample_names\n\n # Add covariates names\n if(!is.null(object@covariates)){\n # Create default covariates names if they are null\n if (is.null(covariate_names)) {\n print(\"Covariate names not found, generating default: covariate1, ..., covariateC\")\n covariate_names <- paste0(\"sample\", as.character(seq_len(object@dimensions[[\"C\"]])))\n }\n covariates_names(object) <- covariate_names\n }\n \n # Set views names\n if (is.null(names(object@data))) {\n print(\"Views names not found, generating default: view1, ..., viewM\")\n view_names <- paste0(\"view\", as.character(seq_len(object@dimensions[[\"M\"]])))\n }\n views_names(object) <- view_names\n \n # Set groups names\n if (is.null(names(object@data[[1]]))) {\n print(\"Groups names not found, generating default: group1, ..., groupG\")\n group_names <- paste0(\"group\", as.character(seq_len(object@dimensions[[\"G\"]])))\n }\n groups_names(object) <- group_names\n \n # Set factors names\n factors_names(object) <- paste0(\"Factor\", as.character(seq_len(object@dimensions[[\"K\"]])))\n \n ###################\n ## Parse factors ##\n ###################\n \n # Calculate variance explained estimates per factor\n if (is.null(object@cache[[\"variance_explained\"]])) {\n object@cache[[\"variance_explained\"]] <- calculate_variance_explained(object)\n } \n \n # Remove inactive factors\n if (remove_inactive_factors) {\n r2 <- rowSums(do.call('cbind', lapply(object@cache[[\"variance_explained\"]]$r2_per_factor, rowSums, na.rm=TRUE)))\n var.threshold <- 0.0001\n if (all(r2 < var.threshold)) {\n warning(sprintf(\"All %s factors were found to explain little or no variance so remove_inactive_factors option has been disabled.\", length(r2)))\n } else if (any(r2 < var.threshold)) {\n object <- subset_factors(object, which(r2>=var.threshold), recalculate_variance_explained=FALSE)\n message(sprintf(\"%s factors were found to explain no variance and they were removed for downstream analysis. You can disable this option by setting load_model(..., remove_inactive_factors = FALSE)\", sum(r2 < var.threshold)))\n }\n }\n \n # [Done in mofapy2] Sort factors by total variance explained\n if (sort_factors && object@dimensions$K>1) {\n\n # Sanity checks\n if (verbose) message(\"Re-ordering factors by their variance explained...\")\n\n # Calculate variance explained per factor across all views\n r2 <- rowSums(sapply(object@cache[[\"variance_explained\"]]$r2_per_factor, function(e) rowSums(e, na.rm = TRUE)))\n order_factors <- c(names(r2)[order(r2, decreasing = TRUE)])\n\n # re-order factors\n object <- subset_factors(object, order_factors)\n }\n\n # Mask outliers\n if (remove_outliers) {\n if (verbose) message(\"Removing outliers...\")\n object <- .detect_outliers(object)\n }\n \n # Mask intercepts for non-Gaussian data\n if (any(object@model_options$likelihoods!=\"gaussian\")) {\n for (m in names(which(object@model_options$likelihoods!=\"gaussian\"))) {\n for (g in names(object@intercepts[[m]])) {\n object@intercepts[[m]][[g]] <- NA\n }\n }\n }\n\n ######################\n ## Quality controls ##\n ######################\n\n if (verbose) message(\"Doing quality control...\")\n object <- .quality_control(object, verbose = verbose)\n \n return(object)\n}\n" }, { "path": "R/make_example_data.R", "content": "\n#' @title Simulate a data set using the generative model of MOFA\n#' @name make_example_data\n#' @description Function to simulate an example multi-view multi-group data set according to the generative model of MOFA2.\n#' @param n_views number of views\n#' @param n_features number of features in each view \n#' @param n_samples number of samples in each group\n#' @param n_groups number of groups\n#' @param n_factors number of factors\n#' @param likelihood likelihood for each view, one of \"gaussian\" (default), \"bernoulli\", \"poisson\",\n#' or a character vector of length n_views\n#' @param lscales vector of lengthscales, needs to be of length n_factors (default is 0 - no smooth factors)\n#' @param sample_cov (only for use with MEFISTO) matrix of sample covariates for one group with covariates in rows and samples in columns \n#' or \"equidistant\" for sequential ordering, default is NULL (no smooth factors)\n#' @param as.data.frame return data and covariates as long dataframe \n#' @return Returns a list containing the simulated data and simulation parameters.\n#' @importFrom stats rnorm rbinom rpois\n#' @importFrom dplyr left_join\n#' @importFrom stats dist\n#' @export\n#' @examples\n#' # Generate a simulated data set\n#' MOFAexample <- make_example_data()\n\n\nmake_example_data <- function(n_views=3, n_features=100, n_samples = 50, n_groups = 1,\n n_factors = 5, likelihood = \"gaussian\",\n lscales = 1, sample_cov = NULL, as.data.frame = FALSE) {\n \n # Sanity checks\n if (!all(likelihood %in% c(\"gaussian\", \"bernoulli\", \"poisson\")))\n stop(\"Likelihood not implemented: Use either gaussian, bernoulli or poisson\")\n \n if(length(lscales) == 1)\n lscales = rep(lscales, n_factors)\n if(!length(lscales) == n_factors)\n stop(\"Lengthscales lscales need to be of length n_factors\")\n if(all(lscales == 0)){\n sample_cov <- NULL\n }\n \n if (length(likelihood)==1) likelihood <- rep(likelihood, n_views) \n if (!length(likelihood) == n_views) \n stop(\"Likelihood needs to be a single string or matching the number of views!\")\n \n if(!is.null(sample_cov)){\n if(sample_cov[1] == \"equidistant\") {\n sample_cov <- seq_len(n_samples)\n }\n if(is.null(dim(sample_cov))) sample_cov <- matrix(sample_cov, nrow = 1)\n if(ncol(sample_cov) != n_samples){\n stop(\"Number of columns in sample_cov must match number of samples n_samples.\")\n }\n \n # Simulate covariance for factors\n Sigma = lapply(lscales, function(ls) {\n if(ls == 0) diag(1, n_samples)\n else (1) * exp(-as.matrix(stats::dist(t(sample_cov)))^2/(2*ls^2))\n # else (1-0.001) * exp(-as.matrix(stats::dist(t(sample_cov)))^2/(2*ls^2)) + diag(0.001, n_samples)\n })\n \n # simulate factors\n alpha_z <- NULL\n S_z <- lapply(seq_len(n_groups), function(vw) matrix(1, nrow=n_samples, ncol=n_factors))\n Z <- vapply(seq_len(n_factors), function(fc) mvtnorm::rmvnorm(1, rep(0, n_samples), Sigma[[fc]]), numeric(n_samples))\n colnames(Z) <- paste0(\"simulated_factor_\", 1:ncol(Z))\n Z <- lapply(seq_len(n_groups), function(gr) Z)\n sample_cov <- Reduce(cbind, lapply(seq_len(n_groups), function(gr) sample_cov))\n } else {\n # set sparsity for factors\n theta_z <- 0.5\n \n # set ARD prior for factors, each factor being active in at least one group\n alpha_z <- vapply(seq_len(n_factors), function(fc) {\n active_gw <- sample(seq_len(n_groups), 1)\n alpha_fc <- sample(c(1, 1000), n_groups, replace = TRUE)\n if(all(alpha_fc==1000)) alpha_fc[active_gw] <- 1\n alpha_fc\n }, numeric(n_groups))\n alpha_z <- matrix(alpha_z, nrow=n_factors, ncol=n_groups, byrow=TRUE)\n \n # simulate factors \n S_z <- lapply(seq_len(n_groups), function(vw) matrix(rbinom(n_samples * n_factors, 1, theta_z),\n nrow=n_samples, ncol=n_factors))\n Z <- lapply(seq_len(n_groups), function(vw) vapply(seq_len(n_factors), function(fc) rnorm(n_samples, 0, sqrt(1/alpha_z[fc,vw])), numeric(n_samples)))\n }\n \n # set sparsity for weights\n theta_w <- 0.5\n \n # set ARD prior, each factor being active in at least one view\n alpha_w <- vapply(seq_len(n_factors), function(fc) {\n active_vw <- sample(seq_len(n_views), 1)\n alpha_fc <- sample(c(1, 1000), n_views, replace = TRUE)\n if(all(alpha_fc==1000)) alpha_fc[active_vw] <- 1\n alpha_fc\n }, numeric(n_views))\n alpha_w <- matrix(alpha_w, nrow=n_factors, ncol=n_views, byrow=TRUE)\n \n # simulate weights \n S_w <- lapply(seq_len(n_views), function(vw) matrix(rbinom(n_features*n_factors, 1, theta_w),\n nrow=n_features, ncol=n_factors))\n W <- lapply(seq_len(n_views), function(vw) vapply(seq_len(n_factors), function(fc) rnorm(n_features, 0, sqrt(1/alpha_w[fc,vw])), numeric(n_features)))\n \n # set noise level (for gaussian likelihood)\n tau <- 10\n \n # pre-compute linear term and rbind groups\n mu <- lapply(seq_len(n_views), function(vw) lapply(seq_len(n_groups), function(gw) (S_z[[gw]]*Z[[gw]]) %*% t(S_w[[vw]]*W[[vw]])))\n mu <- lapply(mu, function(l) Reduce(rbind, l))\n groups <- rep(paste(\"group\",seq_len(n_groups), sep = \"_\"), each = n_samples)\n \n # simulate data according to the likelihood\n data <- lapply(seq_len(n_views), function(vw){\n lk <- likelihood[vw]\n if (lk == \"gaussian\"){\n dd <- t(mu[[vw]] + rnorm(length(mu[[vw]]),0,sqrt(1/tau)))\n }\n else if (lk == \"poisson\"){\n term <- log(1+exp(mu[[vw]]))\n dd <- t(apply(term, 2, function(tt) rpois(length(tt),tt)))\n }\n else if (lk == \"bernoulli\") {\n term <- 1/(1+exp(-mu[[vw]]))\n dd <- t(apply(term, 2, function(tt) rbinom(length(tt),1,tt)))\n }\n colnames(dd) <- paste0(\"sample_\", seq_len(ncol(dd)))\n rownames(dd) <- paste0(\"feature_\", seq_len(nrow(dd)),\"_view\", vw)\n dd\n })\n\n if(!is.null(sample_cov)) {\n colnames(sample_cov) <- colnames(data[[1]])\n rownames(sample_cov) <- paste0(\"covariate_\", seq_len(nrow(sample_cov)))\n }\n \n names(data) <- paste0(\"view_\", seq_len(n_views))\n \n if(as.data.frame){\n gr_df <- data.frame(group = groups, sample = colnames(data[[1]]))\n dat <- lapply(names(data), function(vw){\n tmp <- data[[vw]]\n df <- melt(tmp, varnames = c(\"feature\", \"sample\"))\n df$view <- vw\n df\n })\n data <- bind_rows(dat)\n data <- dplyr::left_join(data, gr_df, by = \"sample\")\n \n sample_cov <- melt(sample_cov, varnames = c(\"covariate\", \"sample\"))\n }\n return(list(data = data, groups = groups, alpha_w=alpha_w, alpha_z =alpha_z,\n lscales = lscales, sample_cov = sample_cov, Z = Z))\n}\n" }, { "path": "R/mefisto.R", "content": "##########################################################################\n## Functions to use continuous covariates, as part of the MEFISTO framework ##\n##########################################################################\n\n#' @title Add covariates to a MOFA model\n#' @name set_covariates\n#' @description Function to add continuous covariate(s) to a \\code{\\link{MOFA}} object for training with MEFISTO\n#' @param object an untrained \\code{\\link{MOFA}}\n#' @param covariates Sample-covariates to be passed to the model.\n#' This can be either:\n#' \\itemize{\n#' \\item{a character, specifying columns already present in the samples_metadata of the object}\n#' \\item{a data.frame with columns \"sample\", \"covariate\", \"value\". Sample names need to match those present in the data}\n#' \\item{a matrix with samples in columns and covariate(s) in row(s)}\n#' }\n#' Note that the covariate should be numeric and continuous.\n#' @return Returns an untrained \\code{\\link{MOFA}} with covariates filled in the corresponding slots\n#' @details To activate the functional MEFISTO framework, specify mefisto_options when preparing the training using \\code{prepare_mofa} \n#' @export\n#' @examples\n#' #' # Simulate data\n#' dd <- make_example_data(sample_cov = seq(0,1,length.out = 100), n_samples = 100, n_factors = 4)\n#' \n#' # Create MOFA object\n#' sm <- create_mofa(data = dd$data)\n#' \n#' # Add a covariate\n#' sm <- set_covariates(sm, covariates = dd$sample_cov)\n#' sm\n\nset_covariates <- function(object, covariates) {\n\n # Sanity checks\n if (!is(object, \"MOFA\")) \n stop(\"'object' has to be an instance of MOFA\")\n if (object@status==\"trained\") \n stop(\"The model is already trained! Covariates must be added before training\")\n \n # get sample names\n samples_data <- lapply(object@data[[1]], colnames)\n # samples <- unlist(samples_data)\n samples_data_vec <- unlist(samples_names(object))\n \n # covariates passed as characters: extract from the metadata as dataframe\n if (is(covariates, \"character\")) {\n if (!all(covariates %in% colnames(samples_metadata(object)))) {\n stop(\"Columns specified in covariates do not exist in the MOFA object metadata slot.\")\n }\n covariates <- samples_metadata(object)[,c(\"sample\",covariates),drop=FALSE]\n\n covariates <- gather(covariates, key = \"covariate\", value = \"value\", -sample)\n if(!is.numeric(covariates$value)){\n stop(\"Covariates need to be numeric\")\n }\n # TO-DO: Check that they continuous\n \n # covariates passed in data.frame format\n }\n \n if (any(class(covariates) %in% c(\"data.frame\", \"tibble\", \"Data.Frame\"))) { # TO-DO: USE is()\n if (!all(c(\"sample\", \"covariate\", \"value\") %in% colnames(covariates)))\n stop(\"If covariates is provided as data.frame it needs to contain the columns: sample, covariate, value\")\n if (!is.numeric(covariates$value)) {\n stop(\"Values in covariates need to be numeric\")\n }\n samples <- covariates$sample\n # covariates <- covariates[!duplicated(covariates), ]\n covariates <- reshape2::acast(covariates, covariate ~ sample)\n \n # covariates passed in matrix format\n # TO-DO: CHECK THIS\n } else if (all(is.numeric(covariates)) || class(covariates) %in% c(\"dgTMatrix\", \"dgCMatrix\")) {\n samples <- colnames(covariates)\n if (!is.null(samples)) {\n if(!(all(samples %in% samples_data_vec) && all(samples_data_vec %in% samples)))\n stop(\"Sample names of the data and the sample covariates do not match.\")\n covariates <- covariates[ , samples_data_vec, drop = FALSE]\n } else {\n # warnings and checks if no matching sample names\n if(sum(object@dimensions[['N']]) != ncol(covariates))\n stop(\"Number of columns in sample covariates does not match the number of samples\")\n if(!is.null(samples_data) && length(samples_data_vec) > 0) {\n warning(\"No sample names in covariates - we will use the sample names in data. Please ensure that the order matches.\")\n colnames(covariates) <- samples\n } else {\n stop(\"No sample names found!\")\n }\n }\n \n # covariates format not recognised\n } else {\n stop(\"covariates needs to be a character vector, a dataframe, a matrix or NULL.\")\n }\n \n # Set covariate dimensionality\n object@dimensions[[\"C\"]] <- nrow(covariates)\n \n # Set covariate names\n if (is.null(rownames(covariates))) {\n message(\"No covariates names provided - using generic: covariate1, covariate2, ...\")\n rownames(covariates) <- paste0(\"covariate\", seq_len(nrow(covariates)))\n }\n \n # split covariates by groups\n covariates <- lapply(samples_names(object), function(i) covariates[, i, drop = FALSE])\n names(covariates) <- groups_names(object)\n \n # Sanity checks\n stopifnot(all(sapply(covariates, ncol) == object@dimensions[[\"N\"]]))\n \n # add covariates to the MOFA object\n object@covariates <- covariates\n \n return(object)\n}\n\n\n#' @title Get sample covariates\n#' @name get_covariates\n#' @description Function to extract the covariates from a \\code{\\link{MOFA}} object using MEFISTO.\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param covariates character vector with the covariate name(s), or numeric vector with the covariate index(es). \n#' @param as.data.frame logical indicating whether to output the result as a long data frame, default is \\code{FALSE}.\n#' @param warped logical indicating whether to extract the aligned covariates\n#' @return a matrix with dimensions (samples,covariates). If \\code{as.data.frame} is \\code{TRUE}, a long-formatted data frame with columns (sample,factor,value)\n#' @export\n#' @examples \n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' covariates <- get_covariates(model)\n\nget_covariates <- function(object, covariates = \"all\", as.data.frame = FALSE, warped = FALSE) {\n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Get and check covariate names\n covariates <- .check_and_get_covariates(object, covariates)\n \n # Get covariates\n if(warped){\n sample_cov <- lapply(object@covariates_warped, function(cmat) cmat[covariates,,drop=FALSE])\n } else {\n sample_cov <- lapply(object@covariates, function(cmat) cmat[covariates,,drop=FALSE])\n \n }\n \n if (as.data.frame) {\n if(!is.null(rownames(sample_cov[[1]]))){\n nms <- rownames(sample_cov[[1]]) \n } else {\n nms <- paste0(\"covariate_\", seq_along(covariates))\n }\n sample_cov <- Reduce(cbind, sample_cov) # remove group info\n sample_cov <- melt(sample_cov, varnames = c(\"covariate\", \"sample\"))\n }\n \n return(sample_cov)\n}\n\n\n#' @title Get default options for MEFISTO covariates\n#' @name get_default_mefisto_options\n#' @description Function to obtain the default options for the usage of MEFISTO covariates with MEFISTO\n#' @param object an untrained \\code{\\link{MOFA}} object\n#' @details The options are the following: \\cr\n#' \\itemize{\n#' \\item{\\strong{scale_cov}:} logical: Scale covariates?\n#' \\item{\\strong{start_opt}:} integer: First iteration to start the optimisation of GP hyperparameters\n#' \\item{\\strong{n_grid}:} integer: Number of points for the grid search in the optimisation of GP hyperparameters\n#' \\item{\\strong{opt_freq}:} integer: Frequency of optimisation of GP hyperparameters\n#' \\item{\\strong{sparseGP}:} logical: Use sparse GPs to speed up the optimisation of the GP parameters?\n#' \\item{\\strong{frac_inducing}:} numeric between 0 and 1: Fraction of samples to use as inducing points (only relevant if sparseGP is \\code{TRUE})\n#' \\item{\\strong{warping}:} logical: Activate warping functionality to align covariates between groups (requires a multi-group design)\n#' \\item{\\strong{warping_freq}:} numeric: frequency of the warping (only relevant if warping is \\code{TRUE})\n#' \\item{\\strong{warping_ref}:} A character specifying the reference group for warping (only relevant if warping is \\code{TRUE})\n#' \\item{\\strong{warping_open_begin}:} logical: Warping: Allow for open beginning? (only relevant warping is \\code{TRUE})\n#' \\item{\\strong{warping_open_end}:} logical: Warping: Allow for open end? (only relevant warping is \\code{TRUE})\n#' \\item{\\strong{warping_groups}:} Assignment of groups to classes used for alignment (advanced option). \n#' Needs to be a vector of length number of samples, e.g. a column of samples_metadata, which needs to have the same value within each group.\n#' By default groups are used specified in `create_mofa`.\n#' \\item{\\strong{model_groups}:} logical: Model covariance structure across groups (for more than one group, otherwise FALSE)? If FALSE, we assume the same patterns in all groups. \n#' \\item{\\strong{new_values}:} Values for which to predict the factor values (for interpolation / extrapolation). \n#' This should be numeric matrix in the same format with covariate(s) in rows and new values in columns.\n#' Default is NULL, leading to no interpolation.\n#' }\n#' @return Returns a list with default options for the MEFISTO covariate(s) functionality.\n#' @importFrom utils modifyList\n#' @export\n#' @examples \n#' # generate example data\n#' dd <- make_example_data(sample_cov = seq(0,1,length.out = 200), n_samples = 200,\n#' n_factors = 4, n_features = 200, n_views = 4, lscales = c(0.5, 0.2, 0, 0))\n#' # input data\n#' data <- dd$data\n#' # covariate matrix with samples in columns\n#' time <- dd$sample_cov\n#' rownames(time) <- \"time\"\n#' \n#' # create mofa and set covariates\n#' sm <- create_mofa(data = dd$data)\n#' sm <- set_covariates(sm, covariates = time)\n#' \n#' MEFISTO_opt <- get_default_mefisto_options(sm)\n\nget_default_mefisto_options <- function(object) {\n \n mefisto_options <- list(\n \n # Standard options\n scale_cov = FALSE, # (logical) Scale covariates?\n start_opt = 20, # (integer) First iteration to start the optimisation of GP hyperparameters\n n_grid = 20, # (integer) Number of points for the grid search in the optimisation of GP hyperparameters\n opt_freq = 10, # (integer) Frequency of optimisation of GP hyperparameters\n model_groups = TRUE, # (logical) model covariance structure across groups\n \n # sparse GP options\n sparseGP = FALSE, # (logical) Use sparse GPs to speed up the optimisation of the GP parameters?\n frac_inducing = 0.75, # (numeric) Fraction of samples to use as inducing points\n \n # warping\n warping = FALSE, # (logical) Activate warping functionality to align covariates between groups (requires a multi-group design)\n warping_freq = 20, # (numeric) Warping: frequency of the optimisation\n warping_ref = groups_names(object)[[1]], # (character) Warping: reference group\n warping_open_begin = TRUE, # (logical) Warping: Allow for open beginning?\n warping_open_end = TRUE, # (logical) Warping: Allow for open ending?\n warping_groups = NULL,\n \n new_values = NULL # new values if interpolation/extrapolation is wanted\n \n )\n \n # model_groups is set to FALSE if only one group present\n if (object@dimensions$G == 1)\n mefisto_options$model_groups <- FALSE\n \n # if mefisto_options already exist, replace the default values but keep the additional ones\n if (length(object@mefisto_options)>0)\n mefisto_options <- modifyList(mefisto_options, object@mefisto_options)\n \n return(mefisto_options)\n}\n\n\n\n#' @title Heatmap plot showing the group-group correlations per factor\n#' @name plot_group_kernel\n#' @description Heatmap plot showing the group-group correlations inferred by the model per factor\n#' @param object a trained \\code{\\link{MOFA}} object using MEFISTO.\n#' @param factors character vector with the factors names, or numeric vector indicating the indices of the factors to use\n#' @param groups character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use samples from all groups.\n#' @param ... additional parameters that can be passed to \\code{pheatmap} \n#' @details The heatmap gives insight into the clustering of the patterns that factors display along the covariate in each group. \n#' A correlation of 1 indicates that the module captured by a factor shows identical patterns across groups, a correlation of zero that it shows distinct patterns,\n#' a negative correlation that the patterns go in opposite directions.\n#' @return Returns a \\code{ggplot,gg} object containing the heatmaps\n#' @import pheatmap \n#' @import cowplot\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' plot_group_kernel(model)\nplot_group_kernel <- function(object, factors = \"all\", groups = \"all\", ...) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Define factors\n factors <- .check_and_get_factors(object, factors)\n\n # Define groups\n groups <- .check_and_get_groups(object, groups)\n \n # Get group kernels\n Kg <- get_group_kernel(object)\n \n hmlist <- lapply(factors, function(f){\n tmp <- Kg[[f]][groups,groups]\n # set breaks for heatmaps\n ncols <- 100\n seq_breaks <- c(seq(-1, 0, 1/ncols * 2), seq(0, 1, 1/ncols * 2)[-1])\n \n p <- pheatmap::pheatmap(tmp, color = rev(colorRampPalette((RColorBrewer::brewer.pal(n = 7, name =\"RdBu\")))(ncols)), breaks = seq_breaks, silent = TRUE,...)\n \n p$gtable\n })\n # subset to groups\n \n p <- cowplot::plot_grid(plotlist = hmlist)\n\n return(p)\n}\n\n\n\n#' @title Barplot showing the smoothness per factor\n#' @name plot_smoothness\n#' @description Barplot indicating a smoothness score (between 0 (non-smooth) and 1 (smooth)) per factor\n#' @param object a trained \\code{\\link{MOFA}} object using MEFISTO.\n#' @param factors character vector with the factors names, or numeric vector indicating the indices of the factors to use\n#' @param color for the smooth part of the bar\n#' @details The smoothness score is given by the scale parameter for the underlying Gaussian process of each factor.\n#' @return Returns a \\code{ggplot2} object\n#' @import ggplot2\n#' @importFrom tidyr gather\n#' @export\n#' @examples \n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' smoothness_bars <- plot_smoothness(model)\n\nplot_smoothness <- function(object, factors = \"all\", color = \"cadetblue\") {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Define factors\n factors <- .check_and_get_factors(object, factors)\n \n # Get scale parameters\n ss <- get_scales(object)[factors]\n df <- data.frame(factor = names(ss), smooth = ss, non_smooth = 1- ss)\n df$factor <- factor(df$factor, levels=factors)\n df <- gather(df, -factor, key = \"smoothness\", value = \"value\")\n gg_bar <- ggplot(df, aes(x= 1, y = value, fill = smoothness)) +\n geom_bar(stat=\"identity\") +\n facet_wrap(~factor, nrow = 1) +\n theme_void() + coord_flip() +\n guides(fill=FALSE) + scale_fill_manual(values = c(\"non_smooth\" = \"gray\", \"smooth\" = color)) +\n geom_text(x=1, y = 0.5, label = \"smoothness\", size = 3)\n\n return(gg_bar)\n}\n\n\n#' @title Barplot showing the sharedness per factor\n#' @name plot_sharedness\n#' @description Barplot indicating a sharedness score (between 0 (non-shared) and 1 (shared)) per factor\n#' @param object a trained \\code{\\link{MOFA}} object using MEFISTO.\n#' @param factors character vector with the factors names, or numeric vector indicating the indices of the factors to use\n#' @param color for the shared part of the bar\n#' @details The sharedness score is calculated as the distance of the learnt group correlation matrix to the identity matrix\n#' in terms of the mean absolute distance on the off-diagonal elements.\n#' @return Returns a \\code{ggplot2} object\n#' @import ggplot2\n#' @export\n\nplot_sharedness <- function(object, factors = \"all\", color = \"#B8CF87\") {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if (object@dimensions$G == 1) stop(\"'object' has only one group, more than one group are required to determine sharedness.\")\n \n # Define factors\n factors <- .check_and_get_factors(object, factors)\n \n # Get group kernels\n Kgs <- get_group_kernel(object)[factors]\n \n # Calculate distance\n idmat <- diag(1, ncol(Kgs[[1]]))\n gr <- sapply(Kgs, function(k) mean(abs(k - idmat)[lower.tri(idmat)]))\n \n # make plot\n df <- data.frame(factor = names(gr), group = gr, non_group = 1-gr)\n df$factor <- factor(df$factor, levels=factors)\n df <- gather(df, -factor, key = \"sharedness\", value = \"value\")\n df <- mutate(df, sharedness = factor(sharedness, levels = rev(c(\"group\", \"non_group\"))))\n gg_bar <- ggplot(df, aes(x= 1, y=value, fill = sharedness)) + geom_bar(stat=\"identity\") +\n facet_wrap(~factor, nrow = 1) +\n theme_void() + coord_flip() +\n guides(fill=FALSE) + scale_fill_manual(values = c(\"non_group\" = \"gray\", \"group\" = color)) +\n geom_text(x=1, y = 0.5, label = \"sharedness\", size = 3)\n \n return(gg_bar)\n}\n\n#' @title Plot interpolated factors versus covariate (1-dimensional)\n#' @name plot_interpolation_vs_covariate\n#' @description make a plot of interpolated covariates versus covariate\n#' @param object a trained \\code{\\link{MOFA}} object using MEFISTO.\n#' @param covariate covariate to use for plotting\n#' @param factors character or numeric specifying the factor(s) to plot, default is \"all\"\n#' @param only_mean show only mean or include uncertainties?\n#' @param show_observed include observed factor values as dots on the plot\n#' @details to be filled\n#' @return Returns a \\code{ggplot2} object\n#' @import ggplot2\n#' @export\n#' @examples \n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' model <- interpolate_factors(model, new_values = seq(0,1.1,0.1))\n#' plot_interpolation_vs_covariate(model, covariate = \"time\", factors = 1)\n\nplot_interpolation_vs_covariate <- function(object, covariate = 1, factors = \"all\", only_mean = TRUE, show_observed = TRUE){\n\n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n\n # get and check covariate\n covariate <- .check_and_get_covariates(object, covariate)\n \n # get and check factor\n factors <- .check_and_get_factors(object, factors)\n \n # get interpolated factor\n df <- get_interpolated_factors(object, as.data.frame = TRUE, only_mean = only_mean)\n df <- filter(df, factor %in% factors)\n df$factor <- factor(df$factor, levels = factors)\n # calculate ribbon borders\n if(!only_mean) {\n df <- df %>% mutate(sd = sqrt(variance), ymin = mean -1.96 * sd, ymax = mean + 1.96 * sd)\n }\n\n if(show_observed) {\n # add the factor values of the observed time point to the plot\n df_observed <- plot_factors_vs_cov(object, covariates = covariate, return_data = TRUE)\n df_observed <- filter(df_observed, factor %in% factors)\n df_observed$factor <- factor(df_observed$factor, levels = factors)\n }\n\n gg_interpol <- ggplot(df, aes(x=.data[[covariate]], y = .data$mean, col = .data$group)) +\n geom_line(aes(y=mean, col = group)) +\n facet_wrap(~ factor) + theme_classic() + ylab(\"factor value\")\n\n if(show_observed) {\n gg_interpol <- gg_interpol + geom_point(data = df_observed, aes(x= value.covariate,\n y = value.factor, col = group), size = 1)\n }\n if(!only_mean) {\n gg_interpol <- gg_interpol + geom_ribbon(aes(ymin=ymin, ymax = ymax, fill = group),\n alpha = .2, col = \"gray\", size = 0.1)\n }\n\n gg_interpol\n}\n\n\n\n\n#' @title Scatterplots of feature values against sample covariates\n#' @name plot_data_vs_cov\n#' @description Function to do a scatterplot of features against sample covariate values.\n#' @param object a \\code{\\link{MOFA}} object using MEFISTO.\n#' @param covariate string with the covariate name or a samples_metadata column, or an integer with the index of the covariate\n#' @param warped logical indicating whether to show the aligned covariate (default: TRUE), \n#' only relevant if warping has been used to align multiple sample groups\n#' @param factor string with the factor name, or an integer with the index of the factor to take top features from\n#' @param view string with the view name, or an integer with the index of the view. Default is the first view.\n#' @param groups groups to plot. Default is \"all\".\n#' @param features if an integer (default), the total number of features to plot (given by highest weights). If a character vector, a set of manually-defined features.\n#' @param sign can be 'positive', 'negative' or 'all' (default) to show only features with highest positive, negative or all weights, respectively.\n#' @param color_by specifies groups or values (either discrete or continuous) used to color the dots (samples). This can be either: \n#' \\itemize{\n#' \\item the string \"group\": dots are coloured with respect to their predefined groups.\n#' \\item a character giving the name of a feature that is present in the input data \n#' \\item a character giving the same of a column in the sample metadata slot\n#' \\item a vector of the same length as the number of samples specifying the value for each sample. \n#' \\item a dataframe with two columns: \"sample\" and \"color\"\n#' }\n#' @param shape_by specifies groups or values (only discrete) used to shape the dots (samples). This can be either: \n#' \\itemize{\n#' \\item the string \"group\": dots are shaped with respect to their predefined groups.\n#' \\item a character giving the name of a feature that is present in the input data \n#' \\item a character giving the same of a column in the sample metadata slot\n#' \\item a vector of the same length as the number of samples specifying the value for each sample. \n#' \\item a dataframe with two columns: \"sample\" and \"shape\"\n#' }\n#' @param legend logical indicating whether to add a legend\n#' @param dot_size numeric indicating dot size (default is 5).\n#' @param text_size numeric indicating text size (default is 5).\n#' @param stroke numeric indicating the stroke size (the black border around the dots, default is NULL, inferred automatically).\n#' @param alpha numeric indicating dot transparency (default is 1).\n#' @param add_lm logical indicating whether to add a linear regression line for each plot\n#' @param lm_per_group logical indicating whether to add a linear regression line separately for each group\n#' @param imputed logical indicating whether to include imputed measurements\n#' @param return_data logical indicating whether to return a data frame instead of a plot\n#' @details One of the first steps for the annotation of factors is to visualise the weights using \\code{\\link{plot_weights}} or \\code{\\link{plot_top_weights}}\n#' and inspect the relationship of the factor to the covariate(s) using \\code{\\link{plot_factors_vs_cov}}.\n#' However, one might also be interested in visualising the direct relationship between features and covariate(s), rather than looking at \"abstract\" weights and\n#' possibly look at the interpolated and extrapolated values by setting imputed to True.\n#' @import ggplot2\n# #' @importFrom ggpubr stat_cor\n#' @importFrom dplyr left_join\n#' @importFrom utils tail\n#' @importFrom stats quantile\n#' @return Returns a \\code{ggplot2} object or the underlying dataframe if return_data is set to \\code{TRUE}.\n#' @export\n#' @examples \n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' plot_data_vs_cov(model, factor = 3, features = 2)\n\nplot_data_vs_cov <- function(object, covariate = 1, warped = TRUE, factor = 1, view = 1, groups = \"all\", features = 10, sign = \"all\",\n color_by = \"group\", legend = TRUE, alpha = 1, shape_by = NULL, stroke = NULL,\n dot_size = 2.5, text_size = NULL, add_lm = FALSE, lm_per_group = FALSE, imputed = FALSE, return_data = FALSE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(length(factor)==1)\n stopifnot(length(covariate)==1)\n stopifnot(length(view)==1)\n if (lm_per_group) add_lm = TRUE\n \n # Define views, factors and groups\n groups <- .check_and_get_groups(object, groups)\n factor <- .check_and_get_factors(object, factor)\n view <- .check_and_get_views(object, view)\n \n # Check and fetch covariates\n df1 <- get_covariates(object, covariate, as.data.frame = TRUE, warped = warped) \n covariate_name <- unique(df1$covariate)\n if(!warped){\n covariate_name <- paste(covariate_name, \"(unaligned)\")\n }\n \n # Collect relevant data\n N <- get_dimensions(object)[[\"N\"]]\n W <- get_weights(object)[[view]][,factor]\n \n # Get features\n if (sign==\"all\") {\n W <- abs(W)\n } else if (sign==\"positive\") {\n W <- W[W>0]\n } else if (sign==\"negative\") {\n W <- W[W<0]\n }\n \n if (is(features, \"numeric\")) {\n if (length(features) == 1) {\n features <- names(tail(sort(abs(W)), n=features))\n } else {\n features <- names(sort(-abs(W))[features])\n }\n stopifnot(all(features %in% features_names(object)[[view]])) \n } else if (is(features, \"character\")) {\n stopifnot(all(features %in% features_names(object)[[view]]))\n } else {\n stop(\"Features need to be either a numeric or character vector\")\n }\n\n # Set group/color/shape\n if (length(color_by)==1 && is.character(color_by)) color_name <- color_by\n if (length(shape_by)==1 && is.character(shape_by)) shape_name <- shape_by\n color_by <- .set_colorby(object, color_by)\n shape_by <- .set_shapeby(object, shape_by)\n \n # Merge factor values with color and shape information\n df1 <- merge(df1, color_by, by=\"sample\")\n df1 <- merge(df1, shape_by, by=\"sample\")\n \n # Create data frame \n foo <- list(features); names(foo) <- view\n if (imputed) {\n df2 <- get_imputed_data(object, groups = groups, views = view, features = foo, as.data.frame = TRUE)\n } else {\n df2 <- get_data(object, groups = groups, features = foo, as.data.frame = TRUE)\n }\n \n df2$sample <- as.character(df2$sample)\n df <- left_join(df1, df2, by = \"sample\", suffix = c(\".covariate\",\".data\"))\n \n # (Q) Remove samples with missing values in Factor values\n df <- df[!is.na(df$value.covariate) & !is.na(df$value.data) ,]\n \n if(return_data){\n return(df)\n }\n \n # Set stroke\n if (is.null(stroke)) {\n stroke <- .select_stroke(N=length(unique(df$sample)))\n }\n \n # Set Pearson text size\n if (add_lm && is.null(text_size)) {\n text_size <- .select_pearson_text_size(N=length(unique(df$feature)))\n }\n \n # Set axis text size\n axis.text.size <- .select_axis.text.size(N=length(unique(df$feature)))\n \n # Generate plot\n p <- ggplot(df, aes(x = .data[[\"value.covariate\"]], y = .data[[\"value.data\"]])) + \n geom_point(aes(fill = .data$color_by, shape = .data$shape_by), colour = \"black\", size = dot_size, stroke = stroke, alpha = alpha) +\n labs(x=covariate_name, y=\"\") +\n facet_wrap(~feature, scales=\"free_y\") +\n theme_classic() + \n theme(\n axis.text = element_text(size = rel(axis.text.size), color = \"black\"), \n axis.title = element_text(size = rel(1.0), color=\"black\")\n )\n \n # Add linear regression line\n if (add_lm) {\n if (lm_per_group && length(groups)>1) {\n p <- p +\n stat_smooth(formula=y~x, aes(color=.data$group), method=\"lm\", alpha=0.4) +\n ggpubr::stat_cor(aes(color=.data$group, label = .data[[\"..r.label..\"]]), method = \"pearson\", label.sep=\"\\n\", output.type = \"latex\", size = text_size)# +\n # guides(color = FALSE)\n } else {\n p <- p +\n stat_smooth(formula=y~x, method=\"lm\", color=\"grey\", fill=\"grey\", alpha=0.4) +\n ggpubr::stat_cor(method = \"pearson\", label.sep=\"\\n\", output.type = \"latex\", size = text_size, color = \"black\")\n }\n }\n \n # Add legend\n p <- .add_legend(p, df, legend, color_name, shape_name)\n \n return(p)\n}\n\n\n#' @title Scatterplots of a factor's values against the sample covariates\n#' @name plot_factors_vs_cov\n#' @description Scatterplots of a factor's values against the sample covariates\n#' @param object a trained \\code{\\link{MOFA}} object using MEFISTO.\n#' @param factors character or numeric specifying the factor(s) to plot, default is \"all\"\n#' @param covariates specifies sample covariate(s) to plot against:\n#' (1) a character giving the name of a column present in the sample covariates or sample metadata.\n#' (2) a character giving the name of a feature present in the training data.\n#' (3) a vector of the same length as the number of samples specifying continuous numeric values per sample.\n#' Default is the first sample covariates in covariates slot\n#' @param warped logical indicating whether to show the aligned covariate (default: TRUE), \n#' only relevant if warping has been used to align multiple sample groups\n#' @param scale logical indicating whether to scale factor values.\n#' @param show_missing (for 1-dim covariates) logical indicating whether to include samples for which \\code{shape_by} or \\code{color_by} is missing\n#' @param color_by (for 1-dim covariates) specifies groups or values used to color the samples. This can be either:\n#' (1) a character giving the name of a feature present in the training data.\n#' (2) a character giving the same of a column present in the sample metadata.\n#' (3) a vector of the same length as the number of samples specifying discrete groups or continuous numeric values.\n#' @param shape_by (for 1-dim covariates) specifies groups or values used to shape the samples. This can be either:\n#' (1) a character giving the name of a feature present in the training data, \n#' (2) a character giving the same of a column present in the sample metadata.\n#' (3) a vector of the same length as the number of samples specifying discrete groups.\n#' @param color_name (for 1-dim covariates) name for color legend.\n#' @param shape_name (for 1-dim covariates) name for shape legend.\n#' @param dot_size (for 1-dim covariates) numeric indicating dot size.\n#' @param alpha (for 1-dim covariates) numeric indicating dot transparency.\n#' @param stroke (for 1-dim covariates) numeric indicating the stroke size\n#' @param legend (for 1-dim covariates) logical indicating whether to add legend.\n#' @param rotate_x (for spatial, 2-dim covariates) Rotate covariate on x-axis \n#' @param rotate_y (for spatial, 2-dim covariates) Rotate covariate on y-axis\n#' @param return_data logical indicating whether to return the data frame to plot instead of plotting\n#' @param show_variance (for 1-dim covariates) logical indicating whether to show the marginal variance of inferred factor values \n#' (only relevant for 1-dimensional covariates)\n#' @details To investigate the factors pattern along the covariates (such as time or a spatial coordinate) \n#' this function an be used to plot a scatterplot of the factor against the values of each covariate\n#' @return Returns a \\code{ggplot2} object\n#' @import ggplot2 dplyr\n#' @importFrom stats complete.cases\n#' @importFrom tidyr spread\n#' @importFrom magrittr %>% set_colnames\n#' @export\n#' @examples \n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' plot_factors_vs_cov(model)\n\nplot_factors_vs_cov <- function(object, factors = \"all\", covariates = NULL, warped = TRUE, show_missing = TRUE, scale = FALSE,\n color_by = NULL, shape_by = NULL, color_name = NULL, shape_name = NULL,\n dot_size = 1.5, alpha = 1, stroke = NULL, legend = TRUE,\n rotate_x = FALSE, rotate_y = FALSE, return_data = FALSE, show_variance = FALSE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Define covariates\n if (is.null(covariates)) {\n if (!.hasSlot(object, \"covariates\") || any(object@dimensions[[\"C\"]] < 1, is.null(object@covariates))) \n stop(\"No covariates found in object. Please specify one.\")\n covariates <- covariates_names(object)\n }\n \n # Get factors\n factors <- .check_and_get_factors(object, factors)\n Z <- get_factors(object, factors=factors, as.data.frame=TRUE)\n \n # Remove samples with missing values\n Z <- Z[complete.cases(Z),]\n \n # Get covariates\n df <- get_covariates(object, covariates, as.data.frame = TRUE, warped = warped) %>%\n merge(Z, by=\"sample\", suffixes = c(\".covariate\",\".factor\"))\n \n # Remember color_name and shape_name if not provided\n if (!is.null(color_by) && (length(color_by) == 1) && is.null(color_name))\n color_name <- color_by\n if (!is.null(shape_by) && (length(shape_by) == 1) && is.null(shape_name))\n shape_name <- shape_by\n \n # Set color and shape\n color_by <- .set_colorby(object, color_by)\n shape_by <- .set_shapeby(object, shape_by )\n \n # Merge factor values with color and shape information\n df <- df %>%\n merge(color_by, by=\"sample\") %>%\n merge(shape_by, by=\"sample\") %>%\n mutate(shape_by = as.character(shape_by))\n \n # Remove missing values\n if (!show_missing) df <- filter(df, !is.na(color_by) && !is.na(shape_by))\n \n # Return data if requested instead of plotting\n if (return_data) return(df)\n \n # Set stroke\n if (is.null(stroke)) stroke <- .select_stroke(N=length(unique(df$sample)))\n \n # Select 1D or 2D plots\n if (length(covariates) == 1) {\n \n # Include marginal variance\n if (show_variance) {\n if(\"E2\" %in% names(object@expectations$Z)){\n ZZ = object@expectations$Z$E2\n ZZ <- reshape2::melt(ZZ, na.rm=TRUE)\n colnames(ZZ) <- c(\"sample\", \"factor\", \"E2\")\n df <- left_join(df, ZZ, by = c(\"sample\", \"factor\"))\n df <- mutate(df, var = E2 - value^2)\n } else {\n show_variance <- FALSE\n warning(\"No second moments saved in the trained model - variance can not be shown.\")\n }\n }\n p <- .plot_factors_vs_cov_1d(df,\n color_name = color_name,\n shape_name = shape_name,\n scale = scale, \n dot_size = dot_size, \n alpha = alpha, \n stroke = stroke,\n show_variance = show_variance,\n legend = legend,\n warped = warped\n ) \n } else if (length(covariates) == 2) {\n p <- .plot_factors_vs_cov_2d(df,\n scale = scale, \n rotate_x = rotate_x,\n rotate_y = rotate_y\n )\n } else {\n stop(\"too many covariates provided\")\n }\n \n return(p)\n}\n\n\n.plot_factors_vs_cov_1d <- function(df, color_name = \"\", shape_name = \"\", scale = FALSE, dot_size = 1.5, alpha = 1, stroke = 1, show_variance = FALSE, legend = TRUE, warped = TRUE) {\n \n # Sanity checks\n stopifnot(length(unique(df$covariate))==1)\n \n covariate_name <- unique(df$covariate)\n if(!warped){\n covariate_name <- paste(covariate_name, \"(unaligned)\")\n }\n \n \n # Scale values from 0 to 1\n if (scale) {\n df <- df %>% \n group_by(factor) %>%\n mutate(value_scaled = value.factor/max(abs(value.factor)))\n if(show_variance) df <- mutate(df, var = var/(max(abs(value.factor))^2))\n df <- df %>% \n mutate(value.factor = value_scaled) %>%\n select(-value_scaled) %>%\n ungroup\n }\n \n # Generate plot\n p <- ggplot(df, aes(x=value.covariate, y=value.factor)) + \n geom_point(aes(fill = .data$color_by, shape = .data$shape_by), colour=\"black\", stroke = stroke, size=dot_size, alpha=alpha) +\n facet_wrap(~ factor) +\n theme_classic() +\n theme(\n axis.text = element_text(size = rel(0.9), color = \"black\"), \n axis.title = element_text(size = rel(1.2), color = \"black\"), \n axis.line = element_line(color = \"black\", linewidth = 0.5), \n axis.ticks = element_line(color = \"black\", linewidth = 0.5)\n ) + xlab(covariate_name) + ylab(\"factor value\")\n \n if (show_variance){\n p <- p + geom_errorbar(aes(ymin = value - sqrt(var)*1.96, ymax =value + sqrt(var)*1.96), col = \"red\", alpha = 0.7)\n }\n \n p <- .add_legend(p, df, legend, color_name, shape_name)\n \n return(p)\n}\n\n.plot_factors_vs_cov_2d <- function(df, scale = FALSE,\n rotate_x = FALSE, rotate_y= FALSE) {\n \n # Sanity checks\n stopifnot(length(unique(df$covariate))==2)\n \n # pivot covariate values\n covariates_dt <- df %>%\n tidyr::pivot_wider(names_from=\"covariate\", values_from=\"value.covariate\") \n \n covariates.names <- c(colnames(covariates_dt)[ncol(covariates_dt)-1], colnames(covariates_dt)[ncol(covariates_dt)])\n \n # Scale factor values from 0 to 1\n if (scale) {\n covariates_dt <- covariates_dt %>%\n group_by(factor) %>%\n mutate(value.factor = value.factor/max(abs(value.factor))) %>%\n ungroup\n }\n \n covariates_dt <- mutate(covariates_dt, color_by = value.factor) # for compatibility with .add_legend\n\n p <- ggplot(covariates_dt, aes(x=.data[[covariates.names[1]]],\n y=.data[[covariates.names[2]]],\n col = .data$color_by)) +\n geom_point() +\n scale_color_gradient2() + \n geom_point(col = \"gray\", alpha =0.05) +\n facet_wrap( ~ factor) + coord_fixed() + \n theme_bw() +\n theme(\n axis.text = element_text(size = rel(0.9), color = \"black\"),\n axis.title = element_text(size = rel(1.0), color = \"black\"),\n axis.line = element_line(color = \"black\", linewidth = 0.5),\n axis.ticks = element_line(color = \"black\", linewidth = 0.5)\n ) + guides(col = guide_colorbar(title = \"Factor value\"))\n \n if(rotate_x){\n p <- p + scale_x_reverse()\n }\n if(rotate_y){\n p <- p + scale_y_reverse()\n }\n return(p)\n}\n\n\n#' @title Interpolate factors in MEFISTO based on new covariate values\n#' @name interpolate_factors\n#' @description Function to interpolate factors in MEFISTO based on new covariate values.\n#' @param object a \\code{\\link{MOFA}} object trained with MEFISTO options and a covariate\n#' @param new_values a matrix containing the new covariate values to inter/extrapolate to. Should be\n#' in the same format as the covariates used for training.\n#' @return Returns the \\code{\\link{MOFA}} with interpolated factor values filled in the corresponding slot (interpolatedZ)\n#' @details This function requires the functional MEFISTO framework to be used in training. \n#' Use \\code{set_covariates} and specify mefisto_options when preparing the training using \\code{prepare_mofa}. \n#' Currently, only the mean of the interpolation is provided from R.\n#' @export\n#' @examples\n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' model <- interpolate_factors(model, new_values = seq(0,1.1,0.01))\n\ninterpolate_factors <- function(object, new_values) {\n \n # TODO check this function\n # message(\"We recommend doing interpolation from python where additionally uncertainties are provided for the interpolation.\")\n \n if(length(object@interpolated_Z) != 0){\n warning(\"Object already contains interpolated factor values, overwriting it.\")\n }\n # sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if (is.null(object@covariates)) stop(\"'object' does not contain any covariates.\")\n if (is.null(object@mefisto_options)) stop(\"'object' does have MEFISTO training options.\")\n if (is.null(object@expectations$Sigma)) stop(\"'object' does not have any expectations of Sigma.\")\n if (!is.numeric(new_values)) stop(\"'new_values' should be numeric.\")\n \n # restructure 1d covariate\n if(is.null(dim(new_values))){\n new_values <- matrix(new_values, nrow = 1)\n }\n # get kernel parameters\n ls <- get_lengthscales(object)\n Kgs <- get_group_kernel(object)\n s <- get_scales(object)\n Sigma <- object@expectations$Sigma$E\n Sigma_inv <- lapply(seq_along(factors_names(object)), function(k) solve(Sigma[k,,]))\n \n # all covariates\n if (!all(sapply(nrow(object@covariates_warped), function(c) nrow(c) == nrow(new_values)))) {\n stop(\"Number of covariates in new_values does not match covariates in model\")\n } \n \n # get covariates of old and new values\n if(object@mefisto_options$warping){\n old_covariates <- samples_metadata(object)[, paste(covariates_names(object), \"warped\", sep = \"_\"), drop = FALSE] %>% t()\n } else{\n old_covariates <- samples_metadata(object)[, covariates_names(object), drop = FALSE] %>% t()\n \n }\n all_covariates <- cbind(new_values, old_covariates) %>% unique.matrix(., MARGIN = 2) \n\n old_groups <- as.character(samples_metadata(object)$group)\n old <- rbind(old_groups, old_covariates)\n all <- rbind(rep(groups_names(object), each = ncol(all_covariates)),\n t(apply(all_covariates, 1,function(x) rep(x, object@dimensions$G))))\n new <- rbind(rep(groups_names(object), each = ncol(new_values)),\n t(apply(new_values, 1,function(x) rep(x, object@dimensions$G))))\n \n oldidx <- match(data.frame(old), data.frame(all))\n newidx <- match(data.frame(new), data.frame(all))\n\n # get factor values\n Z <- get_factors(object) %>% Reduce(rbind,.)\n \n means <- sapply(seq_along(factors_names(object)), function(k) {\n if(ls[k] == 0 || s[k] == 0){\n means <- matrix( rep(NA, length(new_values) * object@dimensions$G), ncol = 1)\n } else {\n Kc_new <- exp(- as.matrix(dist(t(all_covariates))) ^ 2 / (2 * ls[k]^2))\n K_new_k <- s[k] * Kgs[[k]] %x% Kc_new\n mean <- K_new_k[newidx, oldidx] %*% Sigma_inv[[k]] %*% Z[,k]\n }\n }) %>% t()\n \n res <- lapply(groups_names(object), function(g){\n list(mean = means[,new[1,] == g], new_values = new_values,\n variance = rep(NA, nrow = object@dimensions$K, # variances only provided from python\n ncol = length(new_values))) \n })\n\n \n names(res) <- groups_names(object)\n \n object@interpolated_Z <- res\n \n return(object)\n}\n\n\n#' @title Plot covariate alignment across groups\n#' @name plot_alignment\n#' @description Function to plot the alignment learnt by MEFISTO for the \n#' covariate values between different groups\n#' @param object a \\code{\\link{MOFA}} object using MEFISTO with warping\n#' @return ggplot object showing the alignment\n#' @details This function requires the functional MEFISTO framework to be used in training. \n#' Use \\code{set_covariates} and specify mefisto_options when preparing the training using \\code{prepare_mofa}. \n#' @export\n#' \nplot_alignment <- function(object){\n # sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if (is.null(object@covariates)) stop(\"'object' does not contain any covariates.\")\n if (is.null(object@mefisto_options)) stop(\"'object' does have MEFISTO training options.\")\n if (!object@mefisto_options$warping) stop(\"No warping applied in this MOFA object\")\n df_w <- get_covariates(object, 1, as.data.frame = TRUE, warped = TRUE)\n df_nw <- get_covariates(object, 1, as.data.frame = TRUE, warped = FALSE)\n \n df <- left_join(df_w, df_nw, by = c(\"sample\"), suffix = c(\".warped\", \".unaligned\"))\n df <- left_join(df, select(samples_metadata(object), group, sample), by = \"sample\")\n \n yname <- object@mefisto_options$warping_ref\n if(!yname %in% groups_names(object)){\n yname <- \"reference_value\"\n }\n\n ggplot(df, aes(y = value.warped, x = value.unaligned)) +\n geom_point() + facet_wrap(~group) + theme_bw() + ylab(yname)\n}\n\n\n#' @title Plot variance explained by the smooth components of the model\n#' @description This function plots the variance explained by the smooth components (Gaussian processes) underlying the factors in MEFISTO across different views and groups, as specified by the user.\n#' @name plot_variance_explained_by_covariates\n#' @param object a \\code{\\link{MOFA}} object\n#' @param x character specifying the dimension for the x-axis (\"view\", \"factor\", or \"group\").\n#' @param y character specifying the dimension for the y-axis (\"view\", \"factor\", or \"group\").\n#' @param split_by character specifying the dimension to be faceted (\"view\", \"factor\", or \"group\").\n#' @param factors character vector with a factor name(s), or numeric vector with the index(es) of the factor(s). Default is \"all\".\n#' @param min_r2 minimum variance explained for the color scheme (default is 0).\n#' @param max_r2 maximum variance explained for the color scheme.\n#' @param compare_total plot corresponding variance explained in total in addition\n#' @param legend logical indicating whether to add a legend to the plot (default is TRUE).\n#' @import ggplot2\n#' @importFrom cowplot plot_grid\n#' @importFrom reshape2 melt\n#' @details Note that this function requires the use of MEFISTO. \n#' To activate the functional MEFISTO framework, specify mefisto_options when preparing the training using \\code{prepare_mofa} \n#' @return A list of \\code{\\link{ggplot}} objects (if \\code{compare_total} is TRUE) or a single \\code{\\link{ggplot}} object. \n#' Consider using cowplot::plot_grid(plotlist = ...) to combine the multiple plots that this function generates.\n#' @export\n#' @examples\n#' # load_model\n#' file <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' plot_variance_explained_by_covariates(model)\n#' \n#' # compare to total variance explained\n#' plist <- plot_variance_explained_by_covariates(model, compare_total = TRUE)\n#' cowplot::plot_grid(plotlist = plist)\n\nplot_variance_explained_by_covariates <- function(object, factors = \"all\",\n x = \"view\", y = \"factor\", split_by = NA,\n min_r2 = 0, max_r2 = NULL, compare_total = FALSE,\n legend = TRUE){\n \n # Sanity checks \n if (length(unique(c(x, y, split_by))) != 3) { \n stop(paste0(\"Please ensure x, y, and split_by arguments are different.\\n\",\n \" Possible values are `view`, `group`, and `factor`.\"))\n }\n \n # Automatically fill split_by in\n if (is.na(split_by)) split_by <- setdiff(c(\"view\", \"factor\", \"group\"), c(x, y, split_by))\n \n views <- .check_and_get_views(object, \"all\")\n groups <- .check_and_get_groups(object, \"all\")\n factors <- .check_and_get_factors(object, factors)\n \n # Collect relevant expectations\n W <- get_weights(object, views=views, factors=factors)\n Z <- get_factors(object, groups=groups, factors=factors)\n Z_interpol <- lapply(groups, function(g) {\n if(all(object@covariates_warped[[g]] %in% object@interpolated_Z[[g]]$new_values)){\n idx <- match(object@covariates_warped[[g]], object@interpolated_Z[[g]]$new_values)\n mat <- t(get_interpolated_factors(object, only_mean = TRUE)[[g]]$mean)[idx,]\n } else {\n message(\"No interpolations found in object, recalculating them...\")\n mm_tmp <- object\n mm_tmp@interpolated_Z <- list()\n mm_tmp <- interpolate_factors(mm_tmp, mm_tmp@covariates_warped[[g]])\n mat <- t(get_interpolated_factors(mm_tmp, only_mean = TRUE)[[g]]$mean)\n rm(mm_tmp)\n }\n mat[is.na(mat)] <- 0\n colnames(mat) <- factors_names(object)\n rownames(mat) <- samples_names(object)[[g]]\n mat[, factors]\n })\n names(Z_interpol) <- groups\n Y <- lapply(get_data(object, add_intercept = FALSE)[views], function(view) view[groups])\n Y <- lapply(Y, function(x) lapply(x,t))\n \n r2_GP <- lapply(groups, function(g) {\n tmp_Z <- sapply(views, function(m) { sapply(factors, function(k) {\n a <- sum((as.matrix(Y[[m]][[g]]) - tcrossprod(Z[[g]][,k], W[[m]][,k]))**2, na.rm = TRUE)\n b <- sum(Y[[m]][[g]]**2, na.rm = TRUE)\n return(1 - a/b)\n })\n })\n tmp_Z <- matrix(tmp_Z, ncol = length(views), nrow = length(factors))\n colnames(tmp_Z) <- views\n rownames(tmp_Z) <- factors\n \n tmp_GP <- sapply(views, function(m) { sapply(factors, function(k) {\n a <- sum((as.matrix(Y[[m]][[g]]) - tcrossprod(Z_interpol[[g]][,k], W[[m]][,k]))**2, na.rm = TRUE)\n b <- sum(Y[[m]][[g]]**2, na.rm = TRUE)\n return(1 - a/b)\n })\n })\n tmp_GP <- matrix(tmp_GP, ncol = length(views), nrow = length(factors))\n colnames(tmp_GP) <- views\n rownames(tmp_GP) <- factors\n \n return(tmp_GP * 100)\n # return(pmax(tmp_GP - tmp_Z,0))\n })\n names(r2_GP) <- groups\n \n r2_GP_df <- melt(\n lapply(r2_GP, function(x)\n melt(as.matrix(x), varnames = c(\"factor\", \"view\"))\n ), id.vars=c(\"factor\", \"view\", \"value\")\n )\n colnames(r2_GP_df)[ncol(r2_GP_df)] <- \"group\"\n r2_GP_df$factor <- factor(r2_GP_df$factor, levels = factors)\n r2_GP_df$group <- factor(r2_GP_df$group, levels = groups)\n r2_GP_df$view <- factor(r2_GP_df$view, levels = views)\n \n \n # Set R2 limits\n r2_Z <- calculate_variance_explained(object)\n if (!is.null(min_r2)) r2_GP_df$value[r2_GP_df$valuemax_r2] <- max_r2\n } else {\n max_r2 = max(max(Reduce(c,r2_Z$r2_per_factor)), max(r2_GP_df$value))\n }\n \n p1 <- ggplot(r2_GP_df, aes(x=.data[[x]], y=.data[[y]])) + \n geom_tile(aes(fill=.data$value), color=\"black\") +\n facet_wrap(as.formula(sprintf('~%s',split_by)), nrow=1) +\n labs(x=\"\", y=\"\", title=\"\") +\n scale_fill_gradientn(colors=c(\"gray97\",\"darkblue\"), guide=\"colorbar\", limits=c(min_r2,max_r2)) +\n guides(fill=guide_colorbar(\"Var. (%)\")) +\n theme(\n axis.text.x = element_text(size=rel(1.0), color=\"black\"),\n axis.text.y = element_text(size=rel(1.1), color=\"black\"),\n axis.line = element_blank(),\n axis.ticks = element_blank(),\n panel.background = element_blank(),\n strip.background = element_blank(),\n strip.text = element_text(size=rel(1.0))\n )\n \n if (!legend) p1 <- p1 + theme(legend.position = \"none\")\n \n # remove facet title\n if (length(unique(r2_GP_df[,split_by]))==1) p1 <- p1 + theme(strip.text = element_blank())\n \n if(!compare_total){\n return(p1)\n } else{\n list(p1 + ggtitle(\"smooth part\"),\n plot_variance_explained(object, min_r2 = min_r2, max_r2 = max_r2,\n x= x, y=y, split_by=split_by, factors = factors) + ggtitle(\"total\"))\n }\n}\n" }, { "path": "R/plot_data.R", "content": "###########################################\n## Functions to visualise the input data ##\n###########################################\n\n\n\n#' @title Plot heatmap of relevant features\n#' @name plot_data_heatmap\n#' @description Function to plot a heatmap of the data for relevant features, typically the ones with high weights.\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param factor a string with the factor name, or an integer with the index of the factor.\n#' @param view a string with the view name, or an integer with the index of the view. Default is the first view.\n#' @param groups groups to plot. Default is \"all\".\n#' @param features if an integer (default), the total number of features to plot based on the absolute value of the weights.\n#' If a character vector, a set of manually defined features.\n#' @param annotation_samples annotation metadata for samples (columns). \n#' Either a character vector specifying columns in the sample metadata, or a data.frame that will be passed to \\code{\\link[pheatmap]{pheatmap}} as \\code{annotation_row}\n#' @param annotation_features annotation metadata for features (rows). \n#' Either a character vector specifying columns in the feature metadata, or a data.frame that will be passed to \\code{\\link[pheatmap]{pheatmap}} as \\code{annotation_col}\n#' @param transpose logical indicating whether to transpose the heatmap. \n#' Default corresponds to features as rows and samples as columns.\n#' @param imputed logical indicating whether to plot the imputed data instead of the original data. Default is FALSE.\n#' @param denoise logical indicating whether to plot a denoised version of the data reconstructed using the MOFA factors. \n#' @param max.value numeric indicating the maximum value to display in the heatmap (i.e. the matrix values will be capped at \\code{max.value} ).\n#' @param min.value numeric indicating the minimum value to display in the heatmap (i.e. the matrix values will be capped at \\code{min.value} ).\n#' See \\code{\\link{predict}}. Default is FALSE.\n#' @param ... further arguments that can be passed to \\code{\\link[pheatmap]{pheatmap}}\n#' @details One of the first steps for the annotation of a given factor is to visualise the corresponding weights, \n#' using for example \\code{\\link{plot_weights}} or \\code{\\link{plot_top_weights}}. \\cr\n#' However, one might also be interested in visualising the direct relationship between features and factors, rather than looking at \"abstract\" weights. \\cr\n#' This function generates a heatmap for selected features, which should reveal the underlying pattern that is captured by the latent factor. \\cr\n#' A similar function for doing scatterplots rather than heatmaps is \\code{\\link{plot_data_scatter}}.\n#' @return A \\code{\\link[pheatmap]{pheatmap}} object\n#' @importFrom pheatmap pheatmap\n#' @importFrom utils tail\n#' @export\n#' @examples\n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' plot_data_heatmap(model, factor = 1, show_rownames = FALSE, show_colnames = FALSE)\n\nplot_data_heatmap <- function(object, factor, view = 1, groups = \"all\", features = 50, \n annotation_features = NULL, annotation_samples = NULL, transpose = FALSE, \n imputed = FALSE, denoise = FALSE, max.value = NULL, min.value = NULL, ...) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(length(factor)==1)\n stopifnot(length(view)==1)\n \n # Define views, factors and groups\n groups <- .check_and_get_groups(object, groups)\n factor <- .check_and_get_factors(object, factor)\n view <- .check_and_get_views(object, view)\n \n # Get weights\n W <- do.call(rbind, get_weights(object, views=view, factors=factor, as.data.frame = FALSE))\n \n # NOTE: By default concatenate all the groups\n Z <- lapply(get_factors(object)[groups], function(z) as.matrix(z[,factor]))\n Z <- do.call(rbind, Z)[,1]\n Z <- Z[!is.na(Z)]\n \n\n # Get data\n if (isTRUE(denoise)) {\n data <- predict(object, views=view, groups=groups)[[1]]\n } else {\n if (isTRUE(imputed)) {\n data <- get_imputed_data(object, view, groups)[[1]]\n } else {\n data <- get_data(object, views=view, groups=groups)[[1]]\n }\n }\n\n # Concatenate groups\n if (is(data, \"list\")) {\n data <- do.call(cbind, data)\n }\n \n # Subset features\n if (is(features, \"numeric\")) {\n if (length(features)==1) {\n features <- rownames(W)[tail(order(abs(W)), n=features)]\n } else {\n features <- rownames(W)[order(-abs(W))[features]]\n }\n # Sort features according to the weights\n features <- names(W[features,])[order(W[features,])]\n } else if (is(features, \"character\")) {\n stopifnot(all(features %in% features_names(object)[[view]]))\n } else {\n stop(\"Features need to be either a numeric or character vector\")\n }\n data <- data[features,]\n \n\n # Select respective samples\n data <- data[,names(Z)]\n \n # Ignore samples with full missing views\n data <- data[, apply(data, 2, function(x) !all(is.na(x)))]\n \n # By default, sort samples according to the factor values\n order_samples <- names(sort(Z, decreasing = TRUE))\n order_samples <- order_samples[order_samples %in% colnames(data)]\n data <- data[,order_samples]\n \n # Add sample annotations\n if (!is.null(annotation_samples)) {\n \n # Predefined data.frame\n if (is.data.frame(annotation_samples)) {\n message(\"'annotation_samples' provided as a data.frame, please make sure that the rownames match the sample names\")\n if (any(!colnames(data)%in%rownames(annotation_samples))) {\n stop(\"There are rownames in annotation_samples that do not correspond to sample names in the model\")\n }\n annotation_samples <- annotation_samples[colnames(data), , drop = FALSE]\n \n # Extract metadata from the sample metadata \n } else if (is.character(annotation_samples)) {\n stopifnot(annotation_samples%in%colnames(object@samples_metadata))\n # tmp <- tibble::column_to_rownames(object@samples_metadata,\"sample\")[order_samples,,drop=F]\n tmp <- object@samples_metadata\n rownames(tmp) <- tmp$sample\n tmp$sample <- NULL\n tmp <- tmp[order_samples,,drop=FALSE]\n annotation_samples <- tmp[,annotation_samples, drop=FALSE]\n rownames(annotation_samples) <- rownames(tmp)\n } else {\n stop(\"Input format for 'annotation_samples' not recognised \")\n }\n \n # Convert character columns to factors\n foo <- sapply(annotation_samples, function(x) is.logical(x) || is.character(x))\n if (any(foo)) annotation_samples[,which(foo)] <- lapply(annotation_samples[,which(foo),drop=FALSE], as.factor)\n }\n\n \n # Add feature annotations\n if (!is.null(annotation_features)) {\n stop(\"'annotation_features' is currently not implemented\")\n }\n \n # Transpose the data\n if (transpose) {\n data <- t(data)\n if (!is.null(annotation_samples)) {\n annotation_features <- annotation_samples\n annotation_samples <- NULL\n }\n if (!is.null(annotation_features)) {\n annotation_samples <- annotation_features\n annotation_features <- NULL\n }\n }\n \n # Cap values\n if (!is.null(max.value)) data[data>=max.value] <- max.value\n if (!is.null(min.value)) data[data<=min.value] <- min.value\n \n # Plot heatmap\n pheatmap(data, \n annotation_row = annotation_features, \n annotation_col = annotation_samples, \n ...\n )\n \n}\n\n\n\n#' @title Scatterplots of feature values against latent factors\n#' @name plot_data_scatter\n#' @description Function to do a scatterplot of features against factor values.\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param factor string with the factor name, or an integer with the index of the factor.\n#' @param view string with the view name, or an integer with the index of the view. Default is the first view.\n#' @param groups groups to plot. Default is \"all\".\n#' @param features if an integer (default), the total number of features to plot. If a character vector, a set of manually-defined features.\n#' @param sign can be 'positive', 'negative' or 'all' (default) to show only positive, negative or all weights, respectively.\n#' @param color_by specifies groups or values (either discrete or continuous) used to color the dots (samples). This can be either: \n#' \\itemize{\n#' \\item the string \"group\": dots are coloured with respect to their predefined groups.\n#' \\item a character giving the name of a feature that is present in the input data \n#' \\item a character giving the same of a column in the sample metadata slot\n#' \\item a vector of the same length as the number of samples specifying the value for each sample. \n#' \\item a dataframe with two columns: \"sample\" and \"color\"\n#' }\n#' @param shape_by specifies groups or values (only discrete) used to shape the dots (samples). This can be either: \n#' \\itemize{\n#' \\item the string \"group\": dots are shaped with respect to their predefined groups.\n#' \\item a character giving the name of a feature that is present in the input data \n#' \\item a character giving the same of a column in the sample metadata slot\n#' \\item a vector of the same length as the number of samples specifying the value for each sample. \n#' \\item a dataframe with two columns: \"sample\" and \"shape\"\n#' }\n#' @param legend logical indicating whether to add a legend\n#' @param dot_size numeric indicating dot size (default is 5).\n#' @param text_size numeric indicating text size (default is 5).\n#' @param stroke numeric indicating the stroke size (the black border around the dots, default is NULL, inferred automatically).\n#' @param alpha numeric indicating dot transparency (default is 1).\n#' @param add_lm logical indicating whether to add a linear regression line for each plot\n#' @param lm_per_group logical indicating whether to add a linear regression line separately for each group\n#' @param imputed logical indicating whether to include imputed measurements\n#' @details One of the first steps for the annotation of factors is to visualise the weights using \\code{\\link{plot_weights}} or \\code{\\link{plot_top_weights}}.\n#' However, one might also be interested in visualising the direct relationship between features and factors, rather than looking at \"abstract\" weights. \\cr\n#' A similar function for doing heatmaps rather than scatterplots is \\code{\\link{plot_data_heatmap}}.\n#' @import ggplot2\n# #' @importFrom ggpubr stat_cor\n#' @importFrom dplyr left_join\n#' @importFrom utils tail\n#' @importFrom stats quantile\n#' @return A \\code{\\link{ggplot}} object\n#' @export\n#' @examples\n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' plot_data_scatter(model)\n\nplot_data_scatter <- function(object, factor = 1, view = 1, groups = \"all\", features = 10, sign = \"all\",\n color_by = \"group\", legend = TRUE, alpha = 1, shape_by = NULL, stroke = NULL,\n dot_size = 2.5, text_size = NULL, add_lm = TRUE, lm_per_group = TRUE, imputed = FALSE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(length(factor)==1)\n stopifnot(length(view)==1)\n if (lm_per_group) add_lm = TRUE\n \n # Define views, factors and groups\n groups <- .check_and_get_groups(object, groups)\n factor <- .check_and_get_factors(object, factor)\n view <- .check_and_get_views(object, view)\n\n # Collect relevant data\n N <- get_dimensions(object)[[\"N\"]]\n W <- get_weights(object)[[view]][,factor]\n \n if (imputed) {\n Y <- do.call(cbind, object@imputed_data[[view]][groups])\n } else {\n Y <- do.call(cbind, object@data[[view]][groups])\n }\n \n # Fetch factors\n Z <- get_factors(object, factors = factor, groups = groups, as.data.frame = TRUE)\n Z <- Z[,c(\"sample\",\"value\")]\n colnames(Z) <- c(\"sample\",\"x\")\n \n # Get features\n if (sign==\"all\") {\n W <- abs(W)\n } else if (sign==\"positive\") {\n W <- W[W>0]\n } else if (sign==\"negative\") {\n W <- W[W<0]\n }\n \n if (is(features, \"numeric\")) {\n if (length(features) == 1) {\n features <- names(tail(sort(abs(W)), n=features))\n } else {\n features <- names(sort(-abs(W))[features])\n }\n stopifnot(all(features %in% features_names(object)[[view]])) \n } else if (is(features, \"character\")) {\n stopifnot(all(features %in% features_names(object)[[view]]))\n } else {\n stop(\"Features need to be either a numeric or character vector\")\n }\n W <- W[features]\n\n # Set group/color/shape\n if (length(color_by)==1 & is.character(color_by)) color_name <- color_by\n if (length(shape_by)==1 & is.character(shape_by)) shape_name <- shape_by\n color_by <- .set_colorby(object, color_by)\n shape_by <- .set_shapeby(object, shape_by)\n \n # Merge factor values with color and shape information\n df1 <- merge(Z, color_by, by=\"sample\")\n df1 <- merge(df1, shape_by, by=\"sample\")\n \n # Create data frame \n foo <- list(features); names(foo) <- view\n if (isTRUE(imputed)) {\n df2 <- get_imputed_data(object, groups = groups, views = view, features = foo, as.data.frame = TRUE)\n } else {\n df2 <- get_data(object, groups = groups, features = foo, as.data.frame = TRUE)\n }\n df2$sample <- as.character(df2$sample)\n df <- dplyr::left_join(df1, df2, by = \"sample\")\n \n # (Q) Remove samples with missing values in Factor values\n df <- df[!is.na(df$value),]\n \n # Set stroke\n if (is.null(stroke)) {\n stroke <- .select_stroke(N=length(unique(df$sample)))\n }\n \n # Set Pearson text size\n if (add_lm && is.null(text_size)) {\n text_size <- .select_pearson_text_size(N=length(unique(df$feature)))\n }\n \n # Set axis text size\n axis.text.size <- .select_axis.text.size(N=length(unique(df$feature)))\n \n # Generate plot\n p <- ggplot(df, aes(x = .data$x, y = .data$value)) + \n geom_point(aes(fill = .data$color_by, shape = .data$shape_by), colour = \"black\", size = dot_size, stroke = stroke, alpha = alpha) +\n labs(x=\"Factor values\", y=\"\") +\n facet_wrap(~feature, scales=\"free_y\") +\n theme_classic() + \n theme(\n axis.text = element_text(size = rel(axis.text.size), color = \"black\"), \n axis.title = element_text(size = rel(1.0), color=\"black\")\n )\n\n # Add linear regression line\n if (add_lm) {\n if (lm_per_group && length(groups)>1) {\n p <- p +\n stat_smooth(formula=y~x, aes(color=.data$group), method=\"lm\", alpha=0.4) +\n ggpubr::stat_cor(aes(color=.data$group, label = .data[[\"..r.label..\"]]), method = \"pearson\", label.sep=\"\\n\", output.type = \"latex\", size = text_size)# +\n # guides(color = \"none\")\n } else {\n p <- p +\n stat_smooth(formula=y~x, method=\"lm\", color=\"grey\", fill=\"grey\", alpha=0.4) +\n ggpubr::stat_cor(method = \"pearson\", label.sep=\"\\n\", output.type = \"latex\", size = text_size, color = \"black\")\n }\n }\n \n # Add legend\n p <- .add_legend(p, df, legend, color_name, shape_name)\n \n return(p)\n}\n\n\n#' @title Overview of the input data\n#' @name plot_data_overview\n#' @description Function to do a tile plot showing the missing value structure of the input data\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param covariate (only for MEFISTO) specifies sample covariate to order samples by in the plot. This should be\n#' a character or a numeric index giving the name or position of a column present in the covariates slot of the object.\n#' Default is the first sample covariate in covariates slot. \\code{NULL} does not order by covariate\n#' @param colors a vector specifying the colors per view (see example for details).\n#' @param show_covariate (only for MEFISTO) boolean specifying whether to include the covariate in the plot\n#' @param show_dimensions logical indicating whether to plot the dimensions of the data (default is TRUE).\n#' @details This function is helpful to get an overview of the structure of the data. \n#' It shows the model dimensionalities (number of samples, groups, views and features) \n#' and it indicates which measurements are missing.\n#' @import ggplot2\n#' @importFrom reshape2 melt\n# #' @importFrom rlang .data\n#' @importFrom dplyr mutate left_join\n#' @return A \\code{\\link{ggplot}} object\n#' @export\n#' @examples\n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' plot_data_overview(model)\n\nplot_data_overview <- function(object, covariate = 1, colors = NULL, show_covariate = FALSE, show_dimensions = TRUE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if(sum(get_dimensions(object)[[\"N\"]]) > 1e4) warning(\"This function is inefficient with large number of cells...\")\n if (length(object@data)==0) stop(\"Data not found\")\n M <- get_dimensions(object)[[\"M\"]]\n G <- get_dimensions(object)[[\"G\"]]\n if (M==1 & G==1) warning(\"This function is not useful when there is just one view and one group\")\n \n # Collect MEFISTO covariates\n if(!.hasSlot(object, \"covariates\") || any(object@dimensions[[\"C\"]] < 1, is.null(object@covariates))) \n covariate <- NULL\n if (!is.null(covariate)) {\n if(is.numeric(covariate)){\n if(covariate > object@dimensions[[\"C\"]]) stop(\"Covariate index out of range\")\n covariate <- covariates_names(object)[covariate]\n }\n if(!is.character(covariate) | !covariate %in% covariates_names(object)) \n stop(\"Covariate misspecified. Please read the documentation\")\n covari <- .set_xax(object, covariate)\n }\n \n \n # Define colors \n if (is.null(colors)) {\n palette <- c(\"#FF7F50\", \"#D95F02\", \"#377EB8\", \"#E6AB02\", \"#31A354\", \"#7570B3\", \"#E7298A\", \n \"#66A61E\", \"#A6761D\", \"#666666\", \"#E41A1C\", \"#4DAF4A\", \"#984EA3\", \"#FF7F00\", \n \"#FFFF33\", \"#A65628\", \"#F781BF\", \"#1B9E77\")\n if (M < 18) colors <- palette[seq_len(M)] else colors <- rainbow(M)\n names(colors) <- views_names(object)\n } else {\n if (length(colors) != M) stop(\"Length of 'colors' does not match the number of views\")\n if(is.null(names(colors))) {\n names(colors) <- views_names(object)\n } else {\n stopifnot(sort(names(colors))==sort(views_names(object)))\n }\n }\n\n # Define availability binary matrix to indicate whether assay j is profiled in sample i\n tmp <- lapply(object@data, function(m) sapply(m, function(g) apply(g, 2, function(x) !all(is.na(x)))))\n ovw <- do.call(cbind, lapply(seq_len(M), function(m) {\n do.call(rbind, lapply(tmp[[m]], as.data.frame))\n }))\n rownames(ovw) <- object@samples_metadata$sample\n colnames(ovw) <- views_names(object)\n\n ovw$sample <- object@samples_metadata$sample\n ovw$group <- object@samples_metadata$group\n\n # Melt to data.frame\n to.plot <- reshape2::melt(ovw, id.vars = c(\"sample\", \"group\"), var=c(\"view\"))\n if(!is.null(covariate)) {\n to.plot <- left_join(to.plot, covari, by= \"sample\")\n to.plot$sample <- factor(to.plot$sample, levels = unique(to.plot$sample[order(to.plot$covariate_value)]))\n } else {\n to.plot$sample <- factor(to.plot$sample, levels = rownames(ovw))\n }\n\n n <- length(unique(to.plot$sample))\n \n # Add number of samples and features per view/group\n to.plot$combi <- ifelse(to.plot$value, as.character(to.plot$view), \"missing\")\n if (show_dimensions) {\n to.plot$ntotal <- paste(\"N=\", sapply(object@data[[1]], function(e) ncol(e))[ as.character(to.plot$group) ], sep=\"\")\n to.plot$ptotal <- paste(\"D=\", sapply(object@data, function(e) nrow(e[[1]]))[ as.character(to.plot$view) ], sep=\"\")\n if (length(unique(to.plot$group))==1) { \n to.plot <- mutate(to.plot, view_label = paste(view, ptotal, sep=\"\\n\"), group_label = ntotal)\n } else {\n to.plot <- mutate(to.plot, view_label = paste(view, ptotal, sep=\"\\n\"), group_label = paste(group, ntotal, sep=\"\\n\"))\n }\n } else {\n to.plot <- mutate(to.plot, view_label = view, group_label = group)\n }\n \n # Order groups \n to.plot$group_label <- factor(to.plot$group_label, levels=unique(to.plot$group_label))\n \n # Plot\n p <- ggplot(to.plot, aes(x=.data$sample, y=.data$view_label, fill=.data$combi)) +\n geom_tile() +\n scale_fill_manual(values = c(\"missing\"=\"grey\", colors)) +\n # xlab(paste0(\"Samples (N=\", n, \")\")) + ylab(\"\") +\n guides(fill = \"none\") + \n # facet_wrap(~group_label, scales=\"free_x\", nrow=length(unique(to.plot$view_label))) +\n facet_wrap(vars(group_label), scales=\"free_x\", nrow=length(unique(to.plot$view_label))) +\n theme(\n panel.background = element_rect(fill=\"white\"),\n text = element_text(size=14),\n axis.line = element_blank(),\n axis.ticks = element_blank(),\n axis.title = element_blank(),\n axis.text.x = element_blank(),\n axis.text.y = element_text(color=\"black\"),\n strip.background = element_blank(),\n panel.grid = element_blank()\n )\n \n if(show_covariate){\n p2 <- ggplot(to.plot, aes(x=.data$sample, y=.data$covariate_value)) +\n geom_point(size = 0.5) + theme_bw() +theme(\n text = element_text(size=10),\n axis.ticks.x = element_blank(),\n axis.title.x = element_blank(),\n axis.text.x = element_blank(),\n strip.background = element_blank(),\n strip.text = element_blank()\n ) + ylab(covariate) + facet_wrap(~group_label, ncol =1, scales=\"free_x\")\n \n if(object@dimensions[\"G\"] == 1) {\n p <- cowplot::plot_grid(p, p2, align = \"v\", ncol = 1, rel_heights = c(1,0.2) )\n } else{\n p <- cowplot::plot_grid(p, p2, align = \"h\", nrow = 1, rel_widths = c(1,1) )\n }\n }\n \n return(p)\n}\n\n#' @title Visualize the structure of the data in the terminal\n#' @name plot_ascii_data\n#' @description A Fancy printing method\n#' @param object a \\code{\\link{MOFA}} object\n#' @param nonzero a logical value specifying whether to calculate the fraction of non-zero values (non-NA values by default)\n#' @details This function is helpful to get an overview of the structure of the data as a text output\n#' @return None\n#' @export\n#' @examples\n#' # Using an existing trained model\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' plot_ascii_data(model)\n\nplot_ascii_data <- function(object, nonzero = FALSE) {\n stopifnot(is(object, \"MOFA\"))\n\n if (!.hasSlot(object, \"dimensions\") || length(object@dimensions) == 0)\n stop(\"Error: dimensions not defined\")\n if (!.hasSlot(object, \"status\") || length(object@status) == 0)\n stop(\"Error: status not defined\")\n\n vis_lines <- \"\"\n\n lpad <- max(sapply(views_names(object), function(v) nchar(v)))\n wlim <- max(sapply(groups_names(object), function(v) nchar(v)))\n igr_sp <- .rep_string(5, \" \")\n s <- 8 # extra lpadding shift\n w <- max(8, wlim) # width of one block (minus 2 walls)\n hat <- paste0(\" \", .rep_string(w, \"_\"), \" \")\n walls <- paste0(\"|\", .rep_string(w, \" \"), \"|\")\n ground <- paste0(\"|\", .rep_string(w, \"_\"), \"|\")\n\n groups_line <- .pad_left(lpad + s, .cpaste(groups_names(object), w+2, collapse = igr_sp))\n nsamples_line <- .pad_left(lpad + s, .cpaste(get_dimensions(object)$N, w+2, collapse = igr_sp))\n vis_lines <- c(vis_lines, groups_line, nsamples_line) \n\n # Calculate percentage of missing values in every view and every group\n if (nonzero) {\n content_pct <- lapply(object@data, function(view) sapply(view, function(group) sum(group == 0)))\n } else {\n content_pct <- lapply(object@data, function(view) sapply(view, function(group) sum(is.na(group))))\n }\n content_pct <- lapply(seq_len(length(content_pct)), function(m) {\n paste0(as.character(round(100 - content_pct[[m]] / object@dimensions$N / object@dimensions$D[m] * 100)), sep = \"%\")\n })\n\n for (m in seq_len(length(views_names(object)))) {\n # browser()\n toprect_line <- .pad_left(lpad + s, paste(.rep_string(get_dimensions(object)$G, hat, collapse = igr_sp)))\n midrect_line <- .pad_left(lpad + s, paste(.rep_string(get_dimensions(object)$G, walls, collapse = igr_sp)))\n dfeatures_line <- .pad_left_with(lpad + s, \n paste(.insert_inside(content_pct[[m]], rep(walls, get_dimensions(object)$G)), collapse = igr_sp), \n with = paste(c(views_names(object)[m], .cpaste(get_dimensions(object)$D[m], s)), collapse = \"\"))\n botrect_line <- .pad_left(lpad + s, paste(.rep_string(get_dimensions(object)$G, ground, collapse = igr_sp)))\n\n vis_lines <- c(vis_lines, toprect_line, midrect_line, dfeatures_line, botrect_line) \n }\n\n cat(paste(vis_lines, collapse = \"\\n\"))\n\n cat(\"\\n\\n\") \n}\n\n.rep_string <- function(times, string, collapse = \"\") {\n paste(replicate(times, string), collapse = collapse)\n}\n\n.pad_left_with <- function(len, string, with = \"\") {\n wlen <- nchar(with)\n len <- max(len - wlen, 0)\n paste0(with, paste(replicate(len, \" \"), collapse = \"\"), string)\n}\n\n.pad_left <- function(len, string) {\n .pad_left_with(len, string, with = \"\")\n}\n\n.insert_inside <- function(values, boxes) {\n sapply(seq_len(length(boxes)), function(i) {\n box <- boxes[i]\n v <- values[i]\n paste0(substr(box, 1, 1), .cpaste(v, nchar(box) - 2), substr(box, length(box), length(box)))\n })\n}\n\n# Center and paste\n.cpaste <- function(vals, cwidth, collapse = \"\") {\n vals <- sapply(vals, function(e) {\n e <- toString(e)\n lendiff <- cwidth - nchar(e)\n if (lendiff > 1) {\n paste0(.rep_string(ceiling(lendiff / 2), \" \"),\n e,\n .rep_string(floor(lendiff / 2), \" \"))\n } else {\n e\n }\n })\n paste(vals, collapse = collapse)\n}\n\n\n# Function to define the axis text size for plot_data_scatter\n.select_axis.text.size <- function(N) {\n if (N>=4) {\n return(0.5)\n } else if (N>=2 & N<4) {\n return(0.6)\n } else if (N==1) {\n return(0.8)\n }\n}\n\n# Function to define the text size for the pearson correlation coefficient\n.select_pearson_text_size <- function(N) {\n if (N>=4) {\n return(3)\n } else if (N>=2 & N<4) {\n return(4)\n } else if (N==1) {\n return(5)\n }\n}\n" }, { "path": "R/plot_factors.R", "content": "\n###########################################\n## Functions to visualise latent factors ##\n###########################################\n\n#' @title Beeswarm plot of factor values\n#' @name plot_factor\n#' @description Beeswarm plot of the latent factor values.\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param factors character vector with the factor names, or numeric vector with the indices of the factors to use, or \"all\" to plot all factors.\n#' @param groups character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use samples from all groups.\n#' @param scale logical indicating whether to scale factor values.\n#' @param group_by specifies grouping of samples:\n#' \\itemize{\n#' \\item (default) the string \"group\": in this case, the plot will color samples with respect to their predefined groups.\n#' \\item a character giving the name of a feature that is present in the input data \n#' \\item a character giving the name of a column in the sample metadata slot\n#' \\item a vector of the same length as the number of samples specifying the value for each sample. \n#'}\n#' @param color_by specifies color of samples. This can be either: \n#' \\itemize{\n#' \\item (default) the string \"group\": in this case, the plot will color the dots with respect to their predefined groups.\n#' \\item a character giving the name of a feature that is present in the input data \n#' \\item a character giving the name of a column in the sample metadata slot\n#' \\item a vector of the same length as the number of samples specifying the value for each sample. \n#' }\n#' @param shape_by specifies shape of samples. This can be either: \n#' \\itemize{\n#' \\item (default) the string \"group\": in this case, the plot will shape the dots with respect to their predefined groups.\n#' \\item a character giving the name of a feature that is present in the input data \n#' \\item a character giving the name of a column in the sample metadata slot\n#' \\item a vector of the same length as the number of samples specifying the value for each sample. \n#' }\n#' @param add_dots logical indicating whether to add dots.\n#' @param add_violin logical indicating whether to add violin plots\n#' @param add_boxplot logical indicating whether to add box plots\n#' @param dodge logical indicating whether to dodge the dots (default is FALSE).\n#' @param show_missing logical indicating whether to remove samples for which \\code{shape_by} or \\code{color_by} is missing.\n#' @param dot_size numeric indicating dot size.\n#' @param dot_alpha numeric indicating dot transparency.\n#' @param violin_alpha numeric indicating violin plot transparency.\n#' @param color_violin logical indicating whether to color violin plots.\n#' @param boxplot_alpha numeric indicating boxplot transparency.\n#' @param color_boxplot logical indicating whether to color box plots.\n#' @param color_name name for color legend (usually only used if color_by is not a character itself).\n#' @param shape_name name for shape legend (usually only used if shape_by is not a character itself).\n#' @param stroke numeric indicating the stroke size (the black border around the dots).\n#' @param legend logical indicating whether to add a legend to the plot (default is TRUE).\n#' @param rasterize logical indicating whether to rasterize the plot (default is FALSE).\n#' @details One of the main steps for the annotation of factors is to visualise and color them using known covariates or phenotypic data. \\cr\n#' This function generates a Beeswarm plot of the sample values in a given latent factor. \\cr\n#' Similar functions are \\code{\\link{plot_factors}} for doing scatter plots.\n#' @return Returns a \\code{ggplot2} \n#' @import ggplot2 grDevices\n#' @importFrom stats complete.cases\n#' @importFrom forcats fct_na_value_to_level\n#' @importFrom RColorBrewer brewer.pal\n#' @importFrom dplyr summarise group_by\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Plot Factors 1 and 2 and colour by \"group\"\n#' plot_factor(model, factors = c(1,2), color_by=\"group\")\n#' \n#' # Plot Factor 3 and colour by the value of a specific feature\n#' plot_factor(model, factors = 3, color_by=\"feature_981_view_1\")\n#' \n#' # Add violin plots\n#' plot_factor(model, factors = c(1,2), color_by=\"group\", add_violin = TRUE)\n#' \n#' # Scale factor values from -1 to 1\n#' plot_factor(model, factors = c(1,2), scale = TRUE)\n#' \nplot_factor <- function(object, factors = 1, groups = \"all\",\n group_by = \"group\", color_by = \"group\", shape_by = NULL, \n add_dots = TRUE, dot_size = 2, dot_alpha = 1,\n add_violin = FALSE, violin_alpha = 0.5, color_violin = TRUE,\n add_boxplot = FALSE, boxplot_alpha = 0.5, color_boxplot = TRUE,\n show_missing = TRUE, scale = FALSE, dodge = FALSE,\n color_name = \"\", shape_name = \"\", stroke = NULL,\n legend = TRUE, rasterize = FALSE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Define factors\n factors <- .check_and_get_factors(object, factors)\n\n # Get factor values\n Z <- get_factors(object, factors=factors, groups = groups, as.data.frame=TRUE)\n Z$factor <- factor(Z$factor, levels=factors)\n \n # Set group/color/shape\n if (length(color_by)==1 & is.character(color_by)) color_name <- color_by\n if (length(shape_by)==1 & is.character(shape_by)) shape_name <- shape_by\n object_group_by <- .set_groupby(object, group_by)\n object_color_by <- .set_colorby(object, color_by)\n object_shape_by <- .set_shapeby(object, shape_by)\n \n # Remove samples with missing values\n Z <- Z[complete.cases(Z),]\n \n # Merge factor values with group/color/shape information\n df <- merge(Z, object_group_by, by=\"sample\")\n df <- merge(df, object_color_by, by=\"sample\")\n df <- merge(df, object_shape_by, by=\"sample\")\n \n # QC\n if (length(unique(df$color_by))>10 & is.numeric(df$color_by)) {\n add_violin <- FALSE \n add_boxplot <- FALSE\n dodge <- FALSE\n }\n \n if (length(unique(df$shape_by))>5) {\n warning(\"Maximum number of shapes is 5\")\n df$shape_by <- \"1\"\n }\n \n # if (all(unique(df$color_by)==unique(df$group_by))) dodge <- TRUE\n \n # Remove samples with no sample metadata\n if (!show_missing) df <- filter(df, !is.na(color_by) & !is.na(shape_by))\n if (is.factor(df$color_by))\n df$color_by <- forcats::fct_na_value_to_level(df$color_by)\n if (is.factor(df$shape_by))\n df$shape_by <- forcats::fct_na_value_to_level(df$shape_by)\n \n # Scale values\n if (scale) df$value <- df$value/max(abs(df$value))\n \n # Generate plot\n p <- ggplot(df, aes(x=.data$group_by, y=.data$value, fill=.data$color_by, shape=.data$shape_by)) +\n theme_classic()\n \n # Define facets as factors or groups\n if (length(factors) == 1) {\n p <- p + facet_wrap(~group_by, nrow=1, scales=\"free_x\") +\n labs(x=group_by, y=as.character(factors))\n if (length(unique(df$group_by))==1) p <- p + theme(strip.text = element_blank()) # remove facet title\n } else {\n p <- p + facet_wrap(~factor, nrow=1, scales=\"free_x\") +\n labs(x=group_by, y=\"Factor value\")\n if (length(unique(df$factor))==1) p <- p + theme(strip.text = element_blank()) # remove facet title\n }\n\n # Add dots\n if (add_dots) {\n \n # Set stroke\n if (is.null(stroke)) stroke <- .select_stroke(N=length(unique(df$sample)))\n \n if (rasterize) {\n warning(\"geom_jitter is not available with rasterize==TRUE. We use instead ggrastr::geom_quasirandom_rast()\")\n if (dodge) {\n p <- p + ggrastr::geom_quasirandom_rast(size = dot_size, position = \"dodge\", stroke = stroke, alpha = dot_alpha, dodge.width = 1)\n } else {\n p <- p + ggrastr::geom_quasirandom_rast(size = dot_size, stroke = stroke, alpha = dot_alpha)\n }\n } else {\n if (dodge) {\n p <- p + geom_jitter(colour = \"black\", size = dot_size, stroke = stroke, alpha = dot_alpha, \n position = position_jitterdodge(dodge.width=1, jitter.width=0.2))\n } else {\n p <- p + geom_jitter(colour = \"black\", size = dot_size, stroke = stroke, alpha = dot_alpha)\n }\n }\n }\n \n # Add violin plot\n if (add_violin) {\n if (color_violin && dodge) {\n tmp <- summarise(group_by(df, factor, color_by), n=n())\n if (min(tmp$n)==1) {\n warning(\"Warning: some 'color_by' groups have only one observation, violin plots cannot be added. Adding boxplots instead...\")\n add_boxplot <- TRUE\n # p <- p + geom_violin(color=\"black\", fill=\"grey\", alpha=violin_alpha, trim=TRUE, scale=\"width\", show.legend = FALSE)\n # p <- p + geom_violin(color=\"black\", alpha=violin_alpha, trim=TRUE, scale=\"width\", show.legend = FALSE)\n } else {\n p <- p + geom_violin(alpha=violin_alpha, trim=TRUE, scale=\"width\", position=position_dodge(width=1))\n }\n # p <- p + geom_violin(color=\"black\", alpha=violin_alpha, trim=TRUE, scale=\"width\", position=position_dodge(width=1), show.legend = FALSE)\n } else {\n p <- p + geom_violin(color=\"black\", fill=\"grey\", alpha=violin_alpha, trim=TRUE, scale=\"width\", show.legend = FALSE)\n }\n }\n \n # Add boxplot plot\n if (add_boxplot) {\n if (color_boxplot && dodge) {\n tmp <- summarise(group_by(df, factor, color_by), n=n())\n # if (min(tmp$n)==1) {\n # warning(\"Warning: some 'color_by' groups have only one observation, boxplot plots cannot be coloured\")\n # p <- p + geom_boxplot(color=\"black\", alpha=boxplot_alpha, show.legend = FALSE)\n # } else {\n # p <- p + geom_boxplot(alpha=boxplot_alpha, position=position_dodge(width=1), show.legend = FALSE)\n # }\n p <- p + geom_boxplot(color=\"black\", alpha=boxplot_alpha, position=position_dodge(width=1))\n } else {\n p <- p + geom_boxplot(color=\"black\", fill=\"grey\", alpha=boxplot_alpha, show.legend = FALSE)\n }\n }\n \n # Add theme\n p <- p +\n geom_hline(yintercept=0, linetype=\"dashed\", linewidth=0.2, alpha=0.5) +\n theme(\n panel.border = element_rect(color=\"black\", linewidth=0.1, fill=NA),\n strip.background = element_rect(colour = \"black\", linewidth=0.25),\n panel.spacing = unit(0,\"lines\"),\n # axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5),\n axis.text = element_text(size=rel(0.75), color=\"black\"),\n axis.title.x = element_blank(),\n axis.title.y = element_text(size=rel(1.0), color=\"black\"),\n axis.line = element_line(color=\"black\", linewidth=0.25),\n axis.ticks = element_line(color = \"black\")\n )\n \n if (length(unique(df$factor))>1) {\n # p <- p + scale_y_continuous(breaks=NULL)\n } else {\n # Remove strip labels for groups, they are labelled along X axis\n if (isFALSE(dodge)) {\n p <- p + theme(strip.text.x = element_blank())\n }\n }\n \n # If group_by has a single value, remove text\n if (length(unique(df$group_by))==1) {\n p <- p + theme(axis.text.x = element_blank(), axis.ticks.x = element_blank())\n }\n \n # Add legend\n p <- .add_legend(p, df, legend, color_name, shape_name)\n \n return(p)\n}\n\n\n#' @title Scatterplots of two factor values\n#' @name plot_factors\n#' @description Scatterplot of the values of two latent factors.\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param factors a vector of length two with the factors to plot. Factors can be specified either as a characters\n#' @param groups character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use samples from all groups.\n#' @param show_missing logical indicating whether to include samples for which \\code{shape_by} or \\code{color_by} is missing\n#' @param scale logical indicating whether to scale factor values.\n#' @param color_by specifies groups or values used to color the samples. This can be either:\n#' (1) a character giving the name of a feature present in the training data.\n#' (2) a character giving the name of a column present in the sample metadata.\n#' (3) a vector of the same length as the number of samples specifying discrete groups or continuous numeric values.\n#' @param shape_by specifies groups or values used to shape the samples. This can be either:\n#' (1) a character giving the name of a feature present in the training data, \n#' (2) a character giving the name of a column present in the sample metadata.\n#' (3) a vector of the same length as the number of samples specifying discrete groups.\n#' @param color_name name for color legend.\n#' @param shape_name name for shape legend.\n#' @param dot_size numeric indicating dot size (default is 2).\n#' @param stroke numeric indicating the stroke size (the black border around the dots, default is NULL, inferred automatically).\n#' @param alpha numeric indicating dot transparency (default is 1).\n#' @param legend logical indicating whether to add legend.\n#' @param return_data logical indicating whether to return the data frame to plot instead of plotting\n#' @details One of the first steps for the annotation of factors is to visualise and group/color them using known covariates such as phenotypic or clinical data.\n#' This method generates a single scatterplot for the combination of two latent factors.\n#' TO-FINISH...\n#' \\code{\\link{plot_factors}} for doing Beeswarm plots for factors.\n#' @return Returns a \\code{ggplot2} object\n#' @import ggplot2 dplyr\n#' @importFrom stats complete.cases\n#' @importFrom tidyr spread\n#' @importFrom magrittr %>% set_colnames\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Scatterplot of factors 1 and 2\n#' plot_factors(model, factors = c(1,2))\n#' \n#' # Shape dots by a column in the metadata\n#' plot_factors(model, factors = c(1,2), shape_by=\"group\")\n#' \n#' # Scale factor values from -1 to 1\n#' plot_factors(model, factors = c(1,2), scale = TRUE)\n#' \nplot_factors <- function(object, factors = c(1, 2), groups = \"all\",\n show_missing = TRUE, scale = FALSE,\n color_by = NULL, shape_by = NULL, color_name = NULL, shape_name = NULL,\n dot_size = 2, alpha = 1, legend = TRUE, stroke = NULL, return_data = FALSE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # If plotting one or multiple factors, re-direct to other functions \n if (length(unique(factors)) == 1) {\n .args <- as.list(match.call()[-1])\n .args <- .args[names(.args) != \"factors\"]\n return(do.call(plot_factor, c(.args, list(factors = unique(factors)))))\n } else if (length(factors) > 2) {\n .args <- as.list(match.call()[-1])\n p <- do.call(.plot_multiple_factors, .args)\n return(p)\n }\n\n # Remember color_name and shape_name if not provided\n if (!is.null(color_by) && (length(color_by) == 1) && is.null(color_name))\n color_name <- color_by\n if (!is.null(shape_by) && (length(shape_by) == 1) && is.null(shape_name))\n shape_name <- shape_by\n \n # Define factors\n factors <- .check_and_get_factors(object, factors)\n \n # Get factors\n Z <- get_factors(object, factors=factors, groups = groups, as.data.frame=TRUE)\n \n # Set color and shape\n color_by <- .set_colorby(object, color_by)\n shape_by <- .set_shapeby(object, shape_by)\n \n # Remove samples with missing values\n Z <- Z[complete.cases(Z),]\n \n # Merge factor values with color and shape information\n df <- merge(Z, color_by, by=\"sample\")\n df <- merge(df, shape_by, by=\"sample\")\n df$shape_by <- as.character(df$shape_by)\n \n # Remove missing values\n if(isFALSE(show_missing)) df <- filter(df, !is.na(color_by) & !is.na(shape_by))\n \n # spread over factors\n df <- spread(df, key=\"factor\", value=\"value\")\n df <- df[,c(colnames(df)[seq_len(4)], factors)]\n df <- set_colnames(df, c(colnames(df)[seq_len(4)], \"x\", \"y\"))\n\n # Scale values from 0 to 1\n if (scale) {\n df$x <- df$x/max(abs(df$x))\n df$y <- df$y/max(abs(df$y))\n }\n \n # Return data if requested instead of plotting\n if (return_data) return(df)\n \n # Set stroke\n if (is.null(stroke)) {\n stroke <- .select_stroke(N=length(unique(df$sample)))\n }\n \n # Generate plot\n p <- ggplot(df, aes(x=.data$x, y=.data$y, fill=.data$color_by, shape=.data$shape_by)) + \n geom_point(size=dot_size, alpha=alpha, stroke = stroke) +\n labs(x=factors[1], y=factors[2]) +\n theme_classic() +\n theme(\n axis.text = element_text(size = rel(0.8), color = \"black\"), \n axis.title = element_text(size = rel(1.1), color = \"black\"), \n axis.line = element_line(color = \"black\", linewidth = 0.5), \n axis.ticks = element_line(color = \"black\", linewidth = 0.5)\n )\n \n p <- .add_legend(p, df, legend, color_name, shape_name)\n\n # Fix legend labels\n if (!is.null(color_name)) {\n p <- p + labs(fill = color_name)\n }\n\n if (!is.null(shape_name)) {\n p <- p + labs(shape = shape_name)\n }\n\n return(p)\n}\n\n\n \n# Plot multiple factors as pairwise scatterplots\n#' @importFrom stats complete.cases\n.plot_multiple_factors <- function(object, factors = \"all\", show_missing = TRUE, dot_size = 1,\n color_by = NULL, color_name = \"\", shape_by = NULL, shape_name = \"\",\n\t\t\t\t legend = TRUE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Define factors\n factors <- .check_and_get_factors(object, factors)\n \n # Collect relevant data\n Z <- get_factors(object, factors=factors, as.data.frame=TRUE)\n\n # Set color and shape\n color_by <- .set_colorby(object, color_by)\n shape_by <- .set_shapeby(object, shape_by)\n \n # Remove samples with missing factor values\n Z <- Z[complete.cases(Z),]\n \n # Merge factor values with color and shape information\n df <- merge(Z, color_by, by=\"sample\")\n df <- merge(df, shape_by, by=\"sample\")\n \n # Remove missing values\n if(!show_missing) df <- filter(df, !is.na(color_by) & !is.na(shape_by))\n\n # Spread over factors\n df <- tidyr::spread(df, key=\"factor\", value=\"value\")\n \n # Prepare the legend\n p_legend <- ggplot(df, aes(x=.data[[factors[1]]], y=.data[[factors[2]]], color=.data$color_by, shape=.data$shape_by)) +\n geom_point() +\n theme(\n legend.key = element_rect(fill = \"white\"),\n legend.text = element_text(size=rel(1.2)),\n legend.title = element_text(size=rel(1.2))\n )\n\n colorscale <- NULL\n if (length(unique(df$color))>1 && isTRUE(legend)) {\n p_legend <- p_legend + labs(color=color_name)\n } else {\n p_legend <- p_legend + guides(color=\"none\")\n colorscale <- scale_color_manual(values=\"black\")\n }\n if (length(unique(df$color))>1 && isFALSE(legend)) { p_legend <- p_legend + guides(color=\"none\") }\n if (length(unique(df$shape))>1) { p_legend <- p_legend + labs(shape=shape_name) } else { p_legend <- p_legend + guides(shape = \"none\") }\n if (is.numeric(df$color)) colorscale <- scale_color_gradientn(colors=colorRampPalette(rev(brewer.pal(n=5, name=\"RdYlBu\")))(10))\n # Apply scale early so ggpairs builds correct legend\n if (!is.null(colorscale)) p_legend <- p_legend + colorscale\n\n # Grab legend if needed\n if ((length(unique(df$color))>1 || length(unique(df$shape))>1) && isTRUE(legend)) { legend <- GGally::grab_legend(p_legend) } else { legend <- NULL }\n \n # Generate the final plot\n p <- GGally::ggpairs(df,\n columns = factors,\n lower = list(continuous=GGally::wrap(\"points\", size=dot_size)), \n diag = list(continuous='densityDiag'), \n upper = list(continuous=GGally::wrap(\"points\", size=dot_size)), \n mapping = aes(color=.data$color_by, shape=.data$shape_by), \n title = \"\", \n legend = legend\n )\n p <- p + theme_bw() + theme(\n panel.grid.major = element_blank(),\n axis.ticks = element_blank(),\n axis.text = element_blank()\n )\n # Apply colorscale to panels for consistency\n if (!is.null(colorscale)) p <- p + colorscale\n\n return(p)\n}\n \n\n\n#' @title Plot correlation matrix between latent factors\n#' @name plot_factor_cor\n#' @description Function to plot the correlation matrix between the latent factors.\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param method a character indicating the type of correlation coefficient to be computed: pearson (default), kendall, or spearman.\n#' @param ... arguments passed to \\code{\\link[corrplot]{corrplot}}\n#' @details This method plots the correlation matrix between the latent factors. \\cr \n#' The model encourages the factors to be uncorrelated, so this function usually yields a diagonal correlation matrix. \\cr \n#' However, it is not a hard constraint such as in Principal Component Analysis and correlations between factors can occur, \n#' particularly with large number factors. \\cr\n#' Generally, correlated factors are redundant and should be avoided, as they make interpretation harder. Therefore, \n#' if you have too many correlated factors we suggest you try reducing the number of factors.\n#' @return Returns a symmetric matrix with the correlation coefficient between every pair of factors.\n# #' @importFrom corrplot corrplot\n#' @importFrom corrplot corrplot\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Plot correlation between all factors\n#' plot_factor_cor(model)\n#' \nplot_factor_cor <- function(object, method = \"pearson\", ...) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Fetch factors\n Z <- get_factors(object)\n \n # Compute and plot correlation\n r <- abs(cor(x=do.call(rbind, Z), y=do.call(rbind, Z), method=method, use = \"complete.obs\"))\n corrplot(r, tl.col = \"black\", ...)\n}\n\n\n" }, { "path": "R/plot_weights.R", "content": "########################################\n## Functions to visualise the weights ##\n########################################\n\n#' @title Plot heatmap of the weights\n#' @name plot_weights_heatmap\n#' @description Function to visualize the weights for a given set of factors in a given view. \\cr \n#' This is useful to visualize the overall pattern of the weights but not to individually characterise the factors. \\cr\n#' To inspect the weights of individual factors, use the functions \\code{\\link{plot_weights}} and \\code{\\link{plot_top_weights}}\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param view character vector with the view name(s), or numeric vector with the index of the view(s) to use. \n#' Default is the first view.\n#' @param features character vector with the feature name(s), or numeric vector with the index of the feature(s) to use. \n#' Default is 'all'.\n#' @param factors character vector with the factor name(s), or numeric vector with the index of the factor(s) to use. \n#' Default is 'all'.\n#' @param threshold threshold on absolute weight values, so that weights with a magnitude below this threshold (in all factors) are removed\n#' @param ... extra arguments passed to \\code{\\link[pheatmap]{pheatmap}}.\n#' @importFrom pheatmap pheatmap\n#' @return A \\code{\\link{pheatmap}} object\n#' @export\n#' @examples \n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' plot_weights_heatmap(model)\n\nplot_weights_heatmap <- function(object, view = 1, features = \"all\", factors = \"all\", threshold = 0, ...) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n\n if (is.numeric(view)) view <- views_names(object)[view]\n stopifnot(all(view %in% views_names(object))) \n \n # Define factors\n factors <- .check_and_get_factors(object, factors)\n \n # Define features\n if (paste(features, collapse=\"\") ==\"all\") { \n features <- features_names(object)[[view]]\n } else if (is.numeric(features)) {\n features <- features_names(object)[[view]][features]\n } else {\n stopifnot(all(features %in% features_names(object)[[view]])) \n }\n\n # Get relevant data\n W <- get_weights(object, views=view, factors=factors)[[1]][features,]\n \n # apply thresholding of weights\n W <- W[!apply(W,1,function(r) all(abs(r)1 || length(unique(df$shape_by))>1) && legend) {\n p <- p + labs(color = name_color, shape = name_shape) + \n theme(\n legend.key = element_rect(fill = \"white\"),\n legend.text = element_text(size=16),\n legend.title = element_text(size=16)\n )\n } else {\n p <- p + theme(\n legend.position = \"none\"\n )\n }\n \n return(p)\n}\n\n\n#' @title Plot distribution of feature weights (weights)\n#' @name plot_weights\n#' @description An important step to annotate factors is to visualise the corresponding feature weights. \\cr\n#' This function plots all weights for a given latent factor and view, labeling the top ones. \\cr\n#' In contrast, the function \\code{\\link{plot_top_weights}} displays only the top features with highest loading.\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param view a string with the view name, or an integer with the index of the view.\n#' @param factors character vector with the factor name(s), or numeric vector with the index of the factor(s).\n#' @param nfeatures number of top features to label.\n#' @param color_by specifies groups or values (either discrete or continuous) used to color the dots (features). This can be either: \n#' \\itemize{\n#' \\item (default) the string \"group\": in this case, the plot will color the dots with respect to their predefined groups.\n#' \\item a character giving the name of a feature that is present in the input data \n#' \\item a character giving the same of a column in the features metadata slot\n#' \\item a vector of the same length as the number of features specifying the value for each feature \n#' \\item a dataframe with two columns: \"feature\" and \"color\"\n#' }\n#' @param shape_by specifies groups or values (only discrete) used to shape the dots (features). This can be either: \n#' \\itemize{\n#' \\item (default) the string \"group\": in this case, the plot will shape the dots with respect to their predefined groups.\n#' \\item a character giving the name of a feature that is present in the input data \n#' \\item a character giving the same of a column in the features metadata slot\n#' \\item a vector of the same length as the number of features specifying the value for each feature \n#' \\item a dataframe with two columns: \"feature\" and \"shape\"\n#' }\n#' @param abs logical indicating whether to take the absolute value of the weights.\n#' @param manual A nested list of character vectors with features to be manually labelled (see the example for details).\n#' @param color_manual a character vector with colors, one for each element of 'manual'\n#' @param scale logical indicating whether to scale all weights from -1 to 1 (or from 0 to 1 if abs=TRUE).\n#' @param dot_size numeric indicating the dot size.\n#' @param text_size numeric indicating the text size.\n#' @param legend logical indicating whether to add legend.\n#' @param return_data logical indicating whether to return the data frame to plot instead of plotting\n#' @import ggplot2 dplyr tidyr\n#' @importFrom magrittr %>%\n#' @importFrom ggrepel geom_text_repel\n#' @return A \\code{\\link{ggplot}} object or a \\code{data.frame} if return_data is TRUE\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Plot distribution of weights for Factor 1 and View 1\n#' plot_weights(model, view = 1, factors = 1)\n#' \n#' # Plot distribution of weights for Factors 1 to 3 and View 1\n#' plot_weights(model, view = 1, factors = 1:3)\n#' \n#' # Take the absolute value and highlight the top 10 features\n#' plot_weights(model, view = 1, factors = 1, nfeatures = 10, abs = TRUE)\n#' \n#' # Change size of dots and text\n#' plot_weights(model, view = 1, factors = 1, text_size = 5, dot_size = 1)\n#' \nplot_weights <- function(object, view = 1, factors = 1, nfeatures = 10, \n color_by = NULL, shape_by = NULL,\n abs = FALSE, manual = NULL, color_manual = NULL, scale = TRUE, \n dot_size = 1, text_size = 5, legend = TRUE, return_data = FALSE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(length(view)==1)\n \n # Get views\n view <- .check_and_get_views(object, view)\n \n # Get factor names\n factors <- .check_and_get_factors(object, factors)\n \n # Collect expectations \n W <- get_weights(object, views = view, factors = factors, as.data.frame = TRUE)\n \n # Convert factor names to a factor to preserve order\n W$factor <- factor(W$factor, levels = unique(factors))\n\n\n ################\n ## Parse data ##\n ################\n \n # Scale values\n if (scale && sum(W$value>0)>0) W$value <- W$value / max(abs(W$value))\n \n # Take the absolute value\n if (abs) W$value <- abs(W$value)\n \n # Define groups for labelling\n W$labelling_group <- \"0\"\n \n # Define group of features to color according to the loading\n if (is.null(manual) & nfeatures>0) {\n for (f in factors) {\n features <- W[W$factor==f,] %>% group_by(view) %>% top_n(n=nfeatures, abs(value)) %>% .$feature\n W[(W$feature %in% features) & (W$factor==f), \"labelling_group\"] <- \"1\"\n }\n }\n \n # Define group of features to label manually\n if(!is.null(manual)) {\n if (is.null(color_manual)) {\n if (length(manual)>1) {\n # color_manual <- hcl(h = seq(15, 375, length=length(manual)+1), l=65, c=100)[seq_len(length(manual))]\n color_manual <- RColorBrewer::brewer.pal(n=length(manual)+1, \"Dark2\")\n } else {\n color_manual <- \"black\"\n }\n } else {\n stopifnot(length(color_manual)==length(manual)) \n }\n \n # Add labelling group (0 for non-labelled, >= 1 for labelled)\n for (m in seq_len(length(manual)))\n W$labelling_group[W$feature %in% manual[[m]]] <- as.character(m+1)\n }\n \n # Make features names unique\n W$feature_id <- W$feature\n if ((length(unique(W$view)) > 1) && (nfeatures > 0) && (any(duplicated(W[W$factor == factors[1],]$feature_id)))) {\n message(\"Duplicated feature names across views, we will add the view name as a prefix\")\n W$feature_id <- paste(W$view, W$feature, sep=\"_\")\n }\n \n # labelling_indicator is TRUE for labelled, FALSE for non-labelled\n W$labelling_indicator <- as.factor(W$labelling_group != \"0\")\n\n # Set color and shape\n if (length(color_by)==1 & is.character(color_by)) color_name <- color_by\n if (length(shape_by)==1 & is.character(shape_by)) shape_name <- shape_by\n obj_color_by <- .set_colorby_features(object, color_by, view)\n obj_shape_by <- .set_shapeby_features(object, shape_by, view)\n \n # Merge factor values with group/color/shape information\n W <- merge(W, obj_color_by, by=c(\"feature\", \"view\"))\n W <- merge(W, obj_shape_by, by=c(\"feature\", \"view\"))\n\n # Sort features by weight\n W <- by(W, list(W$factor), function(x) x[order(x$value),])\n W <- do.call(rbind, W)\n\n # In order to re-order features across multiple factors, make them unique for different factors\n W$feature_id <- paste(W$feature_id, W$factor, sep=\"_\")\n W$feature_id <- factor(W$feature_id, levels = unique(W$feature_id))\n\n # Return data if requested instead of plotting\n if (return_data) return(W)\n \n # Generate plot\n p <- ggplot(W, aes(x = .data$value, y = .data$feature_id, col = .data$labelling_group)) +\n scale_y_discrete(expand = c(0.03,0.03)) +\n geom_point(aes(shape = .data$shape_by, size=.data$labelling_indicator)) + \n labs(x=\"Weight\", y=\"Rank\", size=dot_size)\n \n # Add labels to the top features\n if (nfeatures>0 || length(unique(W$labelling_group))>0) {\n p <- p + geom_text_repel(\n data = W[W$labelling_group != \"0\",], aes(label = .data$feature, col = .data$labelling_group),\n size = text_size, segment.alpha = 0.25, segment.color = \"black\", segment.size = 0.3, \n show.legend = FALSE, max.overlaps = Inf)\n }\n \n # Configure axis \n if (scale) {\n if (abs) {\n p <- p + \n coord_cartesian(xlim=c(0,1)) +\n scale_x_continuous(breaks=c(0,1)) +\n expand_limits(x=c(0,1))\n } else {\n p <- p + \n coord_cartesian(xlim=c(-1,1)) +\n scale_x_continuous(breaks=c(-1,0,1)) +\n expand_limits(x=c(-1,1))\n }\n }\n \n # Define dot size\n p <- p + scale_size_manual(values=c(dot_size/2,dot_size*2)) + guides(size = \"none\")\n \n # Define dot colours and legend for colours\n if (!is.null(color_by)) { \n p <- p + labs(color=color_name)\n } else {\n foo <- c(\"grey\",\"black\",color_manual); names(foo) <- as.character(0:(length(foo)-1))\n p <- p + guides(color=\"none\") + scale_color_manual(values=foo)\n }\n \n # Add legend for shape\n if (!is.null(shape_by)) { \n p <- p + labs(shape=shape_name)\n } else { \n p <- p + guides(shape=\"none\") \n }\n \n # Facet if multiple factors\n if (length(unique(W$factor)) > 1) {\n p <- p + facet_wrap(~factor, nrow=1, scales=\"free\")\n }\n \n # Add Theme \n p <- p +\n theme_bw() + \n theme(\n plot.title = element_text(size=rel(1.3), hjust=0.5),\n axis.title = element_text(size=rel(1.3), color=\"black\"),\n axis.text.x = element_text(size=rel(1.3), color=\"black\"),\n axis.text.y = element_blank(),\n axis.ticks.y = element_blank(),\n \n # facets\n strip.text = element_text(size=rel(1.2)),\n panel.spacing = unit(1,\"lines\"),\n\n # gridlines\n panel.grid.major.y = element_blank(),\n )\n\n\n # Configure the legend\n if (legend) {\n p <- p + theme(\n legend.text = element_text(size=rel(1.2)),\n legend.title = element_text(size=rel(1.2))\n )\n } else {\n p <- p + theme(legend.position = \"none\")\n }\n \n return(p)\n}\n\n\n#' @title Plot top weights\n#' @name plot_top_weights\n#' @description Plot top weights for a given factor and view.\n#' @param object a trained \\code{\\link{MOFA}} object.\n#' @param view a string with the view name, or an integer with the index of the view.\n#' @param factors a character string with factors names, or an integer vector with factors indices.\n#' @param nfeatures number of top features to display.\n#' Default is 10\n#' @param abs logical indicating whether to use the absolute value of the weights (Default is FALSE).\n#' @param sign can be 'positive', 'negative' or 'all' to show only positive, negative or all weights, respectively. Default is 'all'.\n#' @param scale logical indicating whether to scale all weights from -1 to 1 (or from 0 to 1 if abs=TRUE). Default is TRUE.\n#' @details An important step to annotate factors is to visualise the corresponding feature weights. \\cr\n#' This function displays the top features with highest loading whereas the function \\code{\\link{plot_weights}} plots all weights for a given latent factor and view. \\cr\n#' Importantly, the weights of the features within a view have relative values and they should not be interpreted in an absolute scale.\n#' Therefore, for interpretability purposes we always recommend to scale the weights with \\code{scale=TRUE}.\n#' @import ggplot2\n#' @importFrom dplyr group_by top_n desc\n#' @return Returns a \\code{ggplot2} object\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Plot top weights for Factors 1 and 2 and View 1\n#' plot_top_weights(model, view = 1, factors = c(1,2))\n#' \n#' # Do not take absolute value\n#' plot_weights(model, abs = FALSE)\n#' \nplot_top_weights <- function(object, view = 1, factors = 1,\n nfeatures = 10, abs = TRUE, scale = TRUE, sign = \"all\") {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if (nfeatures <= 0) stop(\"'nfeatures' has to be greater than 0\")\n if (sign==\"all\") { abs <- TRUE}\n if (is.numeric(view)) view <- views_names(object)[view]\n stopifnot(view %in% views_names(object))\n \n # Get views\n view <- .check_and_get_views(object, view)\n \n # Get factor names\n factors <- .check_and_get_factors(object, factors)\n \n # Collect expectations \n W <- get_weights(object, factors = factors, views = view, as.data.frame=TRUE)\n\n # Scale values by weight with highest (absolute) value\n if (scale) W$value <- W$value/max(abs(W$value))\n\n # Store sign\n W <- W[W$value!=0,]\n W$sign <- ifelse(W$value>0, \"+\", \"-\")\n\n # Select subset of only positive or negative weights\n if (sign==\"positive\") { W <- W[W$value>0,] } else if (sign==\"negative\") { W <- W[W$value<0,] }\n\n # Absolute value\n if (abs) W$value <- abs(W$value)\n \n # Extract relevant features\n W <- W[with(W, order(-abs(value))), ]\n\n # Sort according to weights for each factor\n W <- as.data.frame(top_n(group_by(W, factor), n = nfeatures, wt = value))\n #\n \n # Make features names unique\n W$feature_id <- W$feature\n if ((length(unique(W$view)) > 1) && (nfeatures > 0) && (any(duplicated(W[W$factor == factors[1],]$feature_id)))) {\n message(\"Duplicated feature names across views, we will add the view name as a prefix\")\n W$feature_id <- paste(W$view, W$feature, sep=\"_\")\n }\n\n # In order to re-order features across multiple factors, \n # make them unique for different factors\n W$feature_id <- factor(W$feature_id, levels = rev(unique(W$feature_id)))\n \n p <- ggplot(W, aes(x=.data$feature_id, y=.data$value)) +\n geom_point(size=2) +\n geom_segment(aes(xend=.data$feature_id), linewidth=0.75, yend=0) +\n scale_colour_gradient(low=\"grey\", high=\"black\") +\n coord_flip() +\n labs(y=\"Weight\") +\n\n # Theme\n theme_bw() +\n theme(\n axis.title.x = element_text(color='black'),\n axis.title.y = element_blank(),\n axis.text.y = element_text(size=rel(1.1), hjust=1, color='black'),\n axis.text.x = element_text(color='black'),\n axis.ticks.y = element_blank(),\n axis.ticks.x = element_line(),\n legend.position = 'top',\n legend.title = element_blank(),\n legend.text = element_text(color=\"black\"),\n legend.key = element_rect(fill='transparent'),\n \n # facets\n strip.text = element_text(size=rel(1.2)),\n panel.background = element_blank(),\n panel.spacing = unit(1,\"lines\"),\n\n # gridlines\n panel.grid.major.y = element_blank(),\n ) +\n facet_wrap(~factor, nrow=1, scales=\"free\")\n \n if (sign==\"negative\") p <- p + scale_x_discrete(position = \"top\")\n\n # If absolute values are used, add the corresponding signs to the plot\n if (abs) {\n p <- p + \n ylim(0,max(W$value)+0.1) + \n geom_text(label=W$sign,y=max(W$value)+0.1, size=10)\n }\n\n return(p)\n \n}\n\n\n\n# (Hidden) function to define the shape\n.set_shapeby_features <- function(object, shape_by, view) {\n \n # Option 1: no color\n if (is.null(shape_by)) {\n shape_by <- rep(\"1\",sum(object@dimensions[[\"D\"]][view]))\n \n # Option 2: input is a data.frame with columns (feature,color)\n } else if (is(shape_by,\"data.frame\")) {\n stopifnot(all(colnames(shape_by) %in% c(\"feature\",\"color\")))\n stopifnot(all(unique(shape_by$feature) %in% features_names(object)[[view]]))\n \n # Option 3: by a feature_metadata column\n } else if ((length(shape_by)==1) && is.character(shape_by) & (shape_by %in% colnames(features_metadata(object)))) {\n tmp <- features_metadata(object)\n shape_by <- tmp[tmp$view==view,shape_by]\n \n # Option 4: shape_by is a vector of length D\n } else if (length(shape_by) > 1) {\n stopifnot(length(shape_by) == object@dimensions[[\"D\"]][[view]])\n \n # Option not recognised\n } else {\n stop(\"'shape_by' was specified but it was not recognised, please read the documentation\")\n }\n \n # Create data.frame with columns (feature,shape)\n if (!is(shape_by,\"data.frame\")) {\n df = data.frame(\n feature = features_names(object)[[view]],\n shape_by = shape_by,\n view = view\n )\n }\n \n return(df)\n}\n\n\n# (Hidden) function to define the color\n.set_colorby_features <- function(object, color_by, view) {\n \n # Option 1: no color\n if (is.null(color_by)) {\n color_by <- rep(\"1\",sum(object@dimensions[[\"D\"]][view]))\n \n # Option 2: input is a data.frame with columns (feature,color)\n } else if (is(color_by,\"data.frame\")) {\n stopifnot(all(colnames(color_by) %in% c(\"feature\",\"color\")))\n stopifnot(all(unique(color_by$feature) %in% features_names(object)[[view]]))\n \n # Option 3: by a feature_metadata column\n } else if ((length(color_by)==1) && is.character(color_by) && (color_by %in% colnames(features_metadata(object)))) {\n tmp <- features_metadata(object)\n color_by <- tmp[tmp$view==view,color_by]\n \n # Option 4: color_by is a vector of length D\n } else if (length(color_by) > 1) {\n stopifnot(length(color_by) == object@dimensions[[\"D\"]][[view]])\n \n # Option not recognised\n } else {\n stop(\"'color_by' was specified but it was not recognised, please read the documentation\")\n }\n \n # Create data.frame with columns (feature,color)\n if (!is(color_by,\"data.frame\")) {\n df = data.frame(\n feature = features_names(object)[[view]],\n color_by = color_by,\n view = view\n )\n }\n \n return(df)\n}\n" }, { "path": "R/predict.R", "content": "\n######################################\n## Functions to perform predictions ##\n######################################\n\n#' @title Do predictions using a fitted MOFA\n#' @name predict\n#' @description This function uses the latent factors and the weights to do data predictions.\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param views character vector with the view name(s), or numeric vector with the view index(es).\n#' Default is \"all\".\n#' @param groups character vector with the group name(s), or numeric vector with the group index(es).\n#' Default is \"all\".\n#' @param factors character vector with the factor name(s) or numeric vector with the factor index(es).\n#' Default is \"all\".\n#' @param add_intercept add feature intercepts to the prediction (default is TRUE).\n#' @details MOFA generates a denoised and condensed low-dimensional representation of the data that captures the main sources of heterogeneity of the data.\n#' This representation can be used to reconstruct a denoised representation of the data, simply using the equation \\code{Y = WX}. \n#' For more mathematical details read the supplementary methods of the manuscript.\n#' @return Returns a list with the data reconstructed by the model predictions.\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Predict observations for all data modalities\n#' predictions <- predict(model)\npredict <- function(object, views = \"all\", groups = \"all\", factors = \"all\", add_intercept = TRUE) {\n\n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Get views\n views <- .check_and_get_views(object, views, non_gaussian=FALSE)\n groups <- .check_and_get_groups(object, groups)\n\n # Sanity check\n if (any(views %in% names(which(object@model_options$likelihoods!=\"gaussian\")))) stop(\"predict does not work for non-gaussian modalities\")\n \n # Get factors\n if (paste0(factors, collapse=\"\") == \"all\") {\n factors <- factors_names(object)\n } else if (is.numeric(factors)) {\n factors <- factors_names(object)[factors]\n } else {\n stopifnot(all(factors %in% factors_names(object)))\n }\n\n # Collect weights\n W <- get_weights(object, views = views, factors = factors)\n\n # Collect factors\n Z <- get_factors(object, groups = groups, factors = factors)\n Z[is.na(Z)] <- 0 # set missing values in Z to 0 to exclude from imputations\n\n # Do predictions\n predicted_data <- lapply(views, function(m) { lapply(groups, function(g) {\n\n # calculate terms based on linear model\n pred <- t(Z[[g]] %*% t(W[[m]]))\n\n # add feature-wise intercepts (i think this does not work for non-gaussian likelihood, needs some verification)\n tryCatch( {\n if (add_intercept & length(object@intercepts[[1]])>0) {\n intercepts <- object@intercepts[[m]][[g]]\n intercepts[is.na(intercepts)] <- 0\n pred <- pred + object@intercepts[[m]][[g]]\n } }, error = function(e) { NULL })\n\n return(pred)\n })\n })\n\n predicted_data <- .name_views_and_groups(predicted_data, views, groups)\n\n return(predicted_data)\n}\n" }, { "path": "R/prepare_mofa.R", "content": "\n#######################################################\n## Functions to prepare a MOFA object for training ##\n#######################################################\n\n#' @title Prepare a MOFA for training\n#' @name prepare_mofa\n#' @description Function to prepare a \\code{\\link{MOFA}} object for training. \n#' It requires defining data, model and training options.\n#' @param object an untrained \\code{\\link{MOFA}}\n#' @param data_options list of data_options (see \\code{\\link{get_default_data_options}} details). \n#' If NULL, default options are used.\n#' @param model_options list of model options (see \\code{\\link{get_default_model_options}} for details). \n#' If NULL, default options are used.\n#' @param training_options list of training options (see \\code{\\link{get_default_training_options}} for details). \n#' If NULL, default options are used.\n#' @param stochastic_options list of options for stochastic variational inference (see \\code{\\link{get_default_stochastic_options}} for details). \n#' If NULL, default options are used.\n#' @param mefisto_options list of options for mefisto (see \\code{\\link{get_default_mefisto_options}} for details). \n#' If NULL, default options are used.\n#' @return Returns an untrained \\code{\\link{MOFA}} with specified options filled in the corresponding slots\n#' @details This function is called after creating a \\code{\\link{MOFA}} object (using \\code{\\link{create_mofa}}) \n#' and before starting the training (using \\code{\\link{run_mofa}}). Here, we can specify different options for\n#' the data (data_options), the model (model_options) and the training (training_options, stochastic_options). Take a look at the\n#' individual default options for an overview using the get_default_XXX_options functions above.\n#' @export\n#' @examples\n#' # Using an existing simulated data with two groups and two views\n#' file <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\n#' \n#' # Load data dt (in data.frame format)\n#' load(file) \n#' \n#' # Create the MOFA object\n#' MOFAmodel <- create_mofa(dt)\n#' \n#' # Prepare MOFA object using default options\n#' MOFAmodel <- prepare_mofa(MOFAmodel)\n#' \n#' # Prepare MOFA object changing some of the default model options values\n#' model_opts <- get_default_model_options(MOFAmodel)\n#' model_opts$num_factors <- 10\n#' MOFAmodel <- prepare_mofa(MOFAmodel, model_options = model_opts)\nprepare_mofa <- function(object, data_options = NULL, model_options = NULL, \n training_options = NULL, stochastic_options = NULL, mefisto_options = NULL) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if (any(object@dimensions$N<10) & !(.hasSlot(object, \"covariates\") && length(object@covariates)>=1)) warning(\"Some group(s) have less than 10 samples, MOFA will have little power to learn meaningful factors for these group(s)...\")\n if (any(object@dimensions$D<15)) warning(\"Some view(s) have less than 15 features, MOFA will have little power to to learn meaningful factors for these view(s)....\")\n if (any(object@dimensions$D>1e4)) warning(\"Some view(s) have a lot of features, it is recommended to perform a more stringent feature selection before creating the MOFA object....\")\n if (length(object@samples_metadata)>0) { \n stopifnot(c(\"sample\",\"group\") %in% colnames(object@samples_metadata))\n } else {\n stop(\"object@samples_metadata not found\") \n }\n if (length(object@features_metadata)>0) { \n stopifnot(c(\"feature\",\"view\") %in% colnames(object@features_metadata))\n } else {\n stop(\"object@features_metadata not found\") \n }\n if (object@dimensions$G>1) {\n message(\"\\n# Multi-group mode requested.\")\n message(\"\\nThis is an advanced option, if this is the first time that you are running MOFA, we suggest that you try do some exploration first without specifying groups. Two important remarks:\")\n message(\"\\n - The aim of the multi-group framework is to identify the sources of variability *within* the groups. If your aim is to find a factor that 'separates' the groups, you DO NOT want to use the multi-group framework. Please see the FAQ on the MOFA2 webpage.\") \n message(\"\\n - It is important to account for the group effect before selecting highly variable features (HVFs). We suggest that either you calculate HVFs per group and then take the union, or regress out the group effect before HVF selection\")\n }\n\n # Get data options\n message(\"Checking data options...\")\n if (is.null(data_options)) {\n message(\"No data options specified, using default...\")\n object@data_options <- get_default_data_options(object)\n } else {\n if (!is(data_options,\"list\") || !setequal(names(data_options), names(get_default_data_options(object)) ))\n stop(\"data_options are incorrectly specified, please read the documentation in get_default_data_options\")\n object@data_options <- data_options\n }\n # if (any(nchar(unlist(samples_names(object)))>50))\n # warning(\"Due to string size limitations in the HDF5 format, sample names will be trimmed to less than 50 characters\")\n \n # Get training options\n if (is.null(training_options)) {\n message(\"No training options specified, using default...\")\n object@training_options <- get_default_training_options(object)\n } else {\n message(\"Checking training options...\")\n if (!is(training_options,\"list\") || !setequal(names(training_options), names(get_default_training_options(object)) ))\n stop(\"training_options are incorrectly specified, please read the documentation in get_default_training_options\")\n object@training_options <- training_options\n \n if (object@training_options$maxiter<=100)\n warning(\"Maximum number of iterations is very small\\n\")\n if (object@training_options$startELBO<1) object@training_options$startELBO <- 1\n if (object@training_options$freqELBO<1) object@training_options$freqELBO <- 1\n if (!object@training_options$convergence_mode %in% c(\"fast\",\"medium\",\"slow\")) \n stop(\"Convergence mode has to be either 'fast', 'medium', or 'slow'\")\n }\n \n # Get stochastic options\n if (is.null(stochastic_options)) {\n object@stochastic_options <- list()\n } else {\n if (isFALSE(object@training_options[[\"stochastic\"]]))\n stop(\"stochastic_options have been provided but training_opts$stochastic is FALSE. If you want to use stochastic inference you have to set training_opts$stochastic = TRUE\")\n # object@training_options$stochastic <- TRUE\n }\n \n if (object@training_options$stochastic) {\n message(\"Stochastic inference activated. Note that this is only recommended if you have a very large sample size (>1e4) and access to a GPU\")\n \n if (is.null(stochastic_options)) {\n message(\"No stochastic options specified, using default...\")\n object@stochastic_options <- get_default_stochastic_options(object)\n } else {\n object@training_options$stochastic <- TRUE\n message(\"Checking stochastic inference options...\")\n if (!is(stochastic_options,\"list\") || !setequal(names(stochastic_options), names(get_default_stochastic_options(object)) ))\n stop(\"stochastic_options are incorrectly specified, please read the documentation in get_default_stochastic_options\")\n \n if (!stochastic_options$batch_size %in% c(0.05,0.10,0.15,0.20,0.25,0.50))\n stop(\"Batch size has to be one of the following numeric values: 0.05, 0.10, 0.15, 0.20, 0.25, 0.50\")\n if (stochastic_options$batch_size==1)\n warning(\"A batch size equal to 1 is equivalent to non-stochastic inference.\")\n if (stochastic_options$learning_rate<=0 || stochastic_options$learning_rate>1)\n stop(\"The learning rate has to be a value between 0 and 1\")\n if (stochastic_options$forgetting_rate<=0 || stochastic_options$forgetting_rate>1)\n stop(\"The forgetting rate has to be a value between 0 and 1\")\n \n if (sum(object@dimensions$N)<1e4) warning(\"Stochastic inference is only recommended when you have a lot of samples (at least N>10,000))\\n\")\n \n object@stochastic_options <- stochastic_options\n }\n }\n \n # Get model options\n if (is.null(model_options)) {\n message(\"No model options specified, using default...\")\n object@model_options <- get_default_model_options(object)\n } else {\n message(\"Checking model options...\")\n if (!is(model_options,\"list\") || !setequal(names(model_options), names(get_default_model_options(object)) ))\n stop(\"model_options are incorrectly specified, please read the documentation in get_default_model_options\")\n object@model_options <- model_options\n }\n if (object@model_options$num_factors > 50) warning(\"The number of factors is very large, training will be slow...\")\n # if (!object@model_options$ard_weights) warning(\"model_options$ard_weights should always be set to TRUE\")\n if (sum(object@dimensions$N) < 4 * object@model_options$num_factors) {\n warning(sprintf(\"The total number of samples is very small for learning %s factors. \n Try to reduce the number of factors to obtain meaningful results. It should not exceed ~%s.\",\n object@model_options$num_factors, floor(min(object@dimensions$N/4))))\n }\n \n # Get mefisto covariates options\n if (.hasSlot(object, \"covariates\") && length(object@covariates)>=1) {\n if (is.null(mefisto_options)) {\n message(\"Covariates provided but no mefisto options specified, using default...\")\n object@mefisto_options <- get_default_mefisto_options(object)\n } else {\n message(\"Checking inference options for mefisto covariates...\")\n # message(\"mefisto covariates have been provided as prior information.\")\n if (!is(mefisto_options,\"list\") || !setequal(names(mefisto_options), names(get_default_mefisto_options(object)) ))\n stop(\"mefisto_options are incorrectly specified, please read the documentation in get_default_mefisto_options\")\n \n if (isTRUE(mefisto_options$sparseGP)) {\n if (object@dimensions[[\"N\"]] < 1000) warning(\"Warning: sparseGPs should only be used when having a large sample size (>1e3)\")\n if (isTRUE(mefisto_options$warping)) stop(\"Warping is not implemented in conjunction with sparseGPs\")\n }\n \n # Check warping options\n if (isTRUE(mefisto_options$warping)) {\n stopifnot(object@dimensions[['G']] > 1) # check that multi-group is TRUE\n \n if (!is.null(mefisto_options$warping_ref)) {\n stopifnot(length(mefisto_options$warping_ref)==1)\n stopifnot(is.character(mefisto_options$warping_ref))\n stopifnot(mefisto_options$warping_ref %in% groups_names(object))\n }\n \n if (!is.null(mefisto_options$warping_groups)) {\n # check that warping groups are a partition of groups\n groups_ok <- sapply(unique(object@samples_metadata$group), function(g) {\n length(unique(mefisto_options$warping_groups[object@samples_metadata$group == g])) == 1\n })\n if (!all(groups_ok)) stop(\"Warping group assignment needs to be unique within each indiviudal group.\")\n }\n }\n \n # Disable spike-slab on the factors\n if(isTRUE(model_options$spikeslab_factors)) {\n print(\"Spike-and-Slab sparsity prior on the factors is not available when using MEFISTO, setting to False\")\n model_options$spikeslab_factors <- FALSE\n }\n \n # Disable stochastic inference\n if (isTRUE(model_options$stochastic)) {\n print(\"Stochastic inference is not available when using MEFISTO, setting to False\")\n model_options$stochastic <- FALSE\n object@stochastic_options <- list()\n }\n \n # TO-DO: CHECKS ON MODEL_GROUPS\n \n object@mefisto_options <- mefisto_options\n }\n \n } else {\n object@mefisto_options <- list()\n }\n \n # Center the data\n # message(\"Centering the features (per group, this is a mandatory requirement)...\")\n # for (m in views_names(object)) {\n # if (model_options$likelihoods[[m]] == \"gaussian\") {\n # for (g in groups_names(object)) {\n # object@data[[m]][[g]] <- scale(object@data[[m]][[g]], center=T, scale=F)\n # }\n # }\n # }\n \n # Transform sparse matrices into dense ones\n # See https://github.com/rstudio/reticulate/issues/72\n for (m in views_names(object)) {\n for (g in groups_names(object)) {\n if (is(object@data[[m]][[g]], \"dgCMatrix\") || is(object@data[[m]][[g]], \"dgTMatrix\"))\n object@data[[m]][[g]] <- as(object@data[[m]][[g]], \"matrix\")\n }\n }\n \n return(object)\n}\n\n\n\n#' @title Get default training options\n#' @name get_default_training_options\n#' @description Function to obtain the default training options.\n#' @param object an untrained \\code{\\link{MOFA}}\n#' @details This function provides a default set of training options that can be modified and passed to the \\code{\\link{MOFA}} object\n#' in the \\code{\\link{prepare_mofa}} step (see example), i.e. after creating a \\code{\\link{MOFA}} object\n#' (using \\code{\\link{create_mofa}}) and before starting the training (using \\code{\\link{run_mofa}})\n#' The training options are the following: \\cr\n#' \\itemize{\n#' \\item{\\strong{maxiter}: numeric value indicating the maximum number of iterations. \n#' Default is 1000. Convergence is assessed using the ELBO statistic.}\n#' \\item{\\strong{drop_factor_threshold}: numeric indicating the threshold on fraction of variance explained to consider a factor inactive and drop it from the model.\n#' For example, a value of 0.01 implies that factors explaining less than 1\\% of variance (in each view) will be dropped. Default is -1 (no dropping of factors)}\n#' \\item{\\strong{convergence_mode}: character indicating the convergence criteria, either \"fast\", \"medium\" or \"slow\", corresponding to 0.0005\\%, 0.00005\\% or 0.000005\\% deltaELBO change. }\n#' \\item{\\strong{verbose}: logical indicating whether to generate a verbose output.}\n#' \\item{\\strong{startELBO}: integer indicating the first iteration to compute the ELBO (default is 1). }\n#' \\item{\\strong{freqELBO}: integer indicating the first iteration to compute the ELBO (default is 1). }\n#' \\item{\\strong{stochastic}: logical indicating whether to use stochastic variational inference (only required for very big data sets, default is \\code{FALSE}).}\n#' \\item{\\strong{gpu_mode}: logical indicating whether to use GPUs (see details).}\n#' \\item{\\strong{gpu_device}: integer indicating which GPU to use.}\n#' \\item{\\strong{seed}: numeric indicating the seed for reproducibility (default is 42).}\n#' }\n#' @return Returns a list with default training options\n#' @importFrom utils modifyList\n#' @export\n#' @examples\n#' # Using an existing simulated data with two groups and two views\n#' file <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\n#' \n#' # Load data dt (in data.frame format)\n#' load(file) \n#' \n#' # Create the MOFA object\n#' MOFAmodel <- create_mofa(dt)\n#' \n#' # Load default training options\n#' train_opts <- get_default_training_options(MOFAmodel)\n#' \n#' # Edit some of the training options\n#' train_opts$convergence_mode <- \"medium\"\n#' train_opts$startELBO <- 100\n#' train_opts$seed <- 42\n#' \n#' # Prepare the MOFA object\n#' MOFAmodel <- prepare_mofa(MOFAmodel, training_options = train_opts)\nget_default_training_options <- function(object) {\n \n # Get default train options\n training_options <- list(\n maxiter = 1000, # (numeric) Maximum number of iterations\n convergence_mode = 'fast', # (string) Convergence mode based on change in the ELBO (\"slow\",\"medium\",\"fast\")\n drop_factor_threshold = -1, # (numeric) Threshold on fraction of variance explained to drop a factor\n verbose = FALSE, # (logical) Verbosity\n startELBO = 1, # (numeric) First iteration to compute the ELBO\n freqELBO = 5, # (numeric) Frequency of ELBO calculation\n stochastic = FALSE, # (logical) Do stochastic variational inference?\n gpu_mode = FALSE, # (logical) Use GPU?\n gpu_device = NULL, # (integer) Which GPU to use?\n seed = 42, # (numeric) random seed\n outfile = NULL, # (string) Output file name\n weight_views = FALSE, # (logical) Weight the ELBO based on the number of features per view?\n save_interrupted = FALSE # (logical) Save partially trained model when training is interrupted?\n )\n \n # if training_options already exist, replace the default values but keep the additional ones\n if (length(object@training_options)>0)\n training_options <- modifyList(training_options, object@training_options)\n \n return(training_options)\n}\n\n\n#' @title Get default data options\n#' @name get_default_data_options\n#' @description Function to obtain the default data options.\n#' @param object an untrained \\code{\\link{MOFA}} object\n#' @details This function provides a default set of data options that can be modified and passed to the \\code{\\link{MOFA}} object\n#' in the \\code{\\link{prepare_mofa}} step (see example), i.e. after creating a \\code{\\link{MOFA}} object\n#' (using \\code{\\link{create_mofa}}) and before starting the training (using \\code{\\link{run_mofa}})\n#' The data options are the following: \\cr\n#' \\itemize{\n#' \\item{\\strong{scale_views}: logical indicating whether to scale views to have the same unit variance. \n#' As long as the scale differences between the views is not too high, this is not required. Default is FALSE.}\n#' \\item{\\strong{scale_groups}: logical indicating whether to scale groups to have the same unit variance. \n#' As long as the scale differences between the groups is not too high, this is not required. Default is FALSE.}\n#' \\item{\\strong{use_float32}: logical indicating whether use float32 instead of float64 arrays to increase speed and memory usage. Default is FALSE.}\n#' }\n#' @return Returns a list with the default data options.\n#' @importFrom utils modifyList\n#' @export\n#' @examples\n#' # Using an existing simulated data with two groups and two views\n#' file <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\n#' \n#' # Load data dt (in data.frame format)\n#' load(file) \n#' \n#' # Create the MOFA object\n#' MOFAmodel <- create_mofa(dt)\n#' \n#' # Load default data options\n#' data_opts <- get_default_data_options(MOFAmodel)\n#' \n#' # Edit some of the data options\n#' data_opts$scale_views <- TRUE\n#' \n#' # Prepare the MOFA object\n#' MOFAmodel <- prepare_mofa(MOFAmodel, data_options = data_opts)\nget_default_data_options <- function(object) {\n \n # Define default data options\n data_options <- list(\n scale_views = FALSE, # (logical) Scale views to unit variance?\n scale_groups = FALSE, # (logical) Scale groups to unit variance?\n center_groups = TRUE, # (logical) Center groups?\n use_float32 = TRUE # (logical) Use float32 instead of float64 arrays to increase speed and memory usage\n )\n \n # Activate float32 arrays for large sample sizes \n if (sum(object@dimensions$N)>1e5) {\n message(\"A lot of samples detected, using float32 arrays instead of float64 arrays to increase speed and memory usage. \n You can modify this using the `data_options` argument of the `prepare_mofa` function.\")\n data_options$use_float32 <- TRUE\n }\n \n # if data_options already exists, replace the default values but keep the additional ones\n if (length(object@data_options)>0)\n data_options <- modifyList(data_options, object@data_options)\n \n return(data_options)\n}\n\n#' @title Get default model options\n#' @name get_default_model_options\n#' @description Function to obtain the default model options.\n#' @param object an untrained \\code{\\link{MOFA}} object\n#' @details This function provides a default set of model options that can be modified and passed to the \\code{\\link{MOFA}} object\n#' in the \\code{\\link{prepare_mofa}} step (see example), i.e. after creating a \\code{\\link{MOFA}} object\n#' (using \\code{\\link{create_mofa}}) and before starting the training (using \\code{\\link{run_mofa}})\n#' The model options are the following: \\cr\n#' \\itemize{\n#' \\item{\\strong{likelihoods}: character vector with data likelihoods per view: \n#' 'gaussian' for continuous data (Default for all views), 'bernoulli' for binary data and 'poisson' for count data.}\n#' \\item{\\strong{num_factors}: numeric value indicating the (initial) number of factors. Default is 15.}\n#' \\item{\\strong{spikeslab_factors}: logical indicating whether to use spike and slab sparsity on the factors (Default is FALSE)}\n#' \\item{\\strong{spikeslab_weights}: logical indicating whether to use spike and slab sparsity on the weights (Default is TRUE)}\n#' \\item{\\strong{ard_factors}: logical indicating whether to use ARD sparsity on the factors (Default is TRUE only if using multiple groups)}\n#' \\item{\\strong{ard_weights}: logical indicating whether to use ARD sparsity on the weights (Default is TRUE)}\n#' }\n#' @return Returns a list with the default model options.\n#' @importFrom utils modifyList\n#' @export\n#' @examples\n#' # Using an existing simulated data with two groups and two views\n#' file <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\n#' \n#' # Load data dt (in data.frame format)\n#' load(file) \n#' \n#' # Create the MOFA object\n#' MOFAmodel <- create_mofa(dt)\n#' \n#' # Load default model options\n#' model_opts <- get_default_model_options(MOFAmodel)\n#' \n#' # Edit some of the model options\n#' model_opts$num_factors <- 10\n#' model_opts$spikeslab_weights <- FALSE\n#' \n#' # Prepare the MOFA object\n#' MOFAmodel <- prepare_mofa(MOFAmodel, model_options = model_opts)\nget_default_model_options <- function(object) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if (!.hasSlot(object,\"dimensions\") | length(object@dimensions) == 0) \n stop(\"dimensions of object need to be defined before getting the model options\")\n if (.hasSlot(object,\"data\")) {\n if (length(object@data)==0) stop(\"data slot is empty\")\n } else {\n stop(\"data slot not found\")\n }\n \n # Guess likelihoods from the data\n # likelihoods <- .infer_likelihoods(object)\n likelihoods <- rep(x=\"gaussian\", times=object@dimensions$M)\n names(likelihoods) <- views_names(object)\n \n # Define default model options\n model_options <- list(\n likelihoods = likelihoods, # (character vector) likelihood per view [gaussian/bernoulli/poisson]\n num_factors = 10, # (numeric) initial number of latent factors\n spikeslab_factors = FALSE, # (logical) Spike and Slab sparsity on the factors\n spikeslab_weights = FALSE, # (logical) Spike and Slab sparsity on the weights\n ard_factors = FALSE, # (logical) Group-wise ARD sparsity on the factors\n ard_weights = TRUE # (logical) View-wise ARD sparsity on the weights\n )\n \n # (Heuristic) set the number of factors depending on the sample size\n N <- sum(object@dimensions$N)\n if (N<=25) {\n model_options$num_factors <- 5\n } else if (N>25 & N<=1e3) {\n model_options$num_factors <- 15\n } else if (N>1e3 & N<=1e4) {\n model_options$num_factors <- 20\n } else if (N>1e4) {\n model_options$num_factors <- 25\n }\n \n # Group-wise ARD sparsity on the factors only if there are multiple groups\n if (object@dimensions$G>1)\n model_options$ard_factors <- TRUE\n \n # if model_options already exist, replace the default values but keep the additional ones\n if (length(object@model_options)>0)\n model_options <- modifyList(model_options, object@model_options)\n \n return(model_options)\n}\n\n\n\n\n#' @title Get default stochastic options\n#' @name get_default_stochastic_options\n#' @description Function to obtain the default options for stochastic variational inference.\n#' @param object an untrained \\code{\\link{MOFA}}\n#' @details This function provides a default set of stochastic inference options that can be modified and passed to the \\code{\\link{MOFA}} object\n#' in the \\code{\\link{prepare_mofa}} step), i.e. after creating a \\code{\\link{MOFA}} object\n#' (using \\code{\\link{create_mofa}}) and before starting the training (using \\code{\\link{run_mofa}})\n#' These options are only relevant when activating stochastic inference in training_options (see example).\n#' The stochastic inference options are the following: \\cr\n#' \\itemize{\n#' \\item{\\strong{batch_size}: numeric value indicating the batch size (as a fraction)}. \n#' Default is 0.5 (half of the data set).\n#' \\item{\\strong{learning_rate}: numeric value indicating the learning rate. }\n#' Default is 1.0\n#' \\item{\\strong{forgetting_rate}: numeric indicating the forgetting rate.}\n#' Default is 0.5\n#' \\item{\\strong{start_stochastic}: integer indicating the first iteration to start stochastic inference}\n#' Default is 1\n#' }\n#' @return Returns a list with default options\n#' @importFrom utils modifyList\n#' @export\n#' @examples\n#' # Using an existing simulated data with two groups and two views\n#' file <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\n#' \n#' # Load data dt (in data.frame format)\n#' load(file) \n#' \n#' # Create the MOFA object\n#' MOFAmodel <- create_mofa(dt)\n#' \n#' # activate stochastic inference in training options\n#' train_opts <- get_default_training_options(MOFAmodel)\n#' train_opts$stochastic <- TRUE\n#' \n#' # Load default stochastic options\n#' stochastic_opts <- get_default_stochastic_options(MOFAmodel)\n#' \n#' # Edit some of the stochastic options\n#' stochastic_opts$learning_rate <- 0.75\n#' stochastic_opts$batch_size <- 0.25\n#' \n#' # Prepare the MOFA object\n#' MOFAmodel <- prepare_mofa(MOFAmodel, \n#' training_options = train_opts,\n#' stochastic_options = stochastic_opts\n#' )\n#' \nget_default_stochastic_options <- function(object) {\n \n # Get default stochastic options\n stochastic_options <- list(\n batch_size = 0.5, # Batch size (as a fraction)\n learning_rate = 1.0, # Starting learning rate\n forgetting_rate = 0.5, # Forgetting rate\n start_stochastic = 1 # First iteration to start stochastic inference\n )\n \n # if stochastic_options already exist, replace the default values but keep the additional ones\n if (length(object@stochastic_options)>0)\n stochastic_options <- modifyList(stochastic_options, object@stochastic_options)\n \n return(stochastic_options)\n}\n\n" }, { "path": "R/run_mofa.R", "content": "#######################################\n## Functions to train a MOFA model ##\n#######################################\n\n#' @title Train a MOFA model\n#' @name run_mofa\n#' @description Function to train an untrained \\code{\\link{MOFA}} object.\n#' @details This function is called once a MOFA object has been prepared (using \\code{\\link{prepare_mofa}})\n#' In this step the R package calls the \\code{mofapy2} Python package, where model training is performed. \\cr\n#' The interface with Python is done with the \\code{\\link{reticulate}} package. \n#' If you have several versions of Python installed and R is not detecting the correct one, \n#' you can change it using \\code{reticulate::use_python} when loading the R session. \n#' Alternatively, you can let us install mofapy2 for you using \\code{basilisk} if you set use_basilisk to \\code{TRUE}\n#' @param object an untrained \\code{\\link{MOFA}} object\n#' @param save_data logical indicating whether to save the training data in the hdf5 file. \n#' This is useful for some downstream analysis (mainly functions with the prefix \\code{plot_data}), but it can take a lot of disk space.\n#' @param outfile output file for the model (.hdf5 format). If \\code{NULL}, a temporary file is created.\n#' @param use_basilisk use \\code{basilisk} to automatically install a conda environment with mofapy2 and all dependencies? \n#' If \\code{FALSE} (default), you should specify the right python binary when loading R with \\code{reticulate::use_python(..., force=TRUE)}\n#' or the right conda environment with \\code{reticulate::use_condaenv(..., force=TRUE)}.\n#' @return a trained \\code{\\link{MOFA}} object\n#' @import reticulate\n#' @import basilisk\n#' @export\n#' @examples\n#' # Load data (in data.frame format)\n#' file <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\n#' load(file) \n#' \n#' # Create the MOFA object\n#' MOFAmodel <- create_mofa(dt)\n#' \n#' # Prepare the MOFA object with default options\n#' MOFAmodel <- prepare_mofa(MOFAmodel)\n#' \n#' # Run the MOFA model\n#' \\dontrun{ MOFAmodel <- run_mofa(MOFAmodel, use_basilisk = TRUE) }\nrun_mofa <- function(object, outfile = NULL, save_data = TRUE, use_basilisk = FALSE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) \n stop(\"'object' has to be an instance of MOFA\")\n if (object@status==\"trained\") \n stop(\"The model is already trained! If you want to retrain, create a new untrained MOFA\")\n if (length(object@model_options)==0 | length(object@training_options)==0) {\n stop(\"The model is not prepared for training, you have to run `prepare_mofa` before `run_mofa`\")\n }\n \n # If no outfile is provided, store a file in a temporary folder with the respective timestamp\n if (is.null(outfile) || is.na(outfile) || (outfile == \"\")) {\n outfile <- object@training_options$outfile\n if (is.null(outfile) || is.na(outfile) || (outfile == \"\")) {\n outfile <- file.path(tempdir(), paste0(\"mofa_\", format(Sys.time(), format = \"%Y%m%d-%H%M%S\"), \".hdf5\"))\n warning(paste0(\"No output filename provided. Using \", outfile, \" to store the trained model.\\n\\n\"))\n }\n }\n if (file.exists(outfile))\n message(paste0(\"Warning: Output file \", outfile, \" already exists, it will be replaced\"))\n \n # Connect to mofapy2 using reticulate (default)\n if (!use_basilisk) {\n\n message(\"Connecting to the mofapy2 python package using reticulate (use_basilisk = FALSE)... \n Please make sure to manually specify the right python binary when loading R with reticulate::use_python(..., force=TRUE) or the right conda environment with reticulate::use_condaenv(..., force=TRUE)\n If you prefer to let us automatically install a conda environment with 'mofapy2' installed using the 'basilisk' package, please use the argument 'use_basilisk = TRUE'\\n\")\n \n # Sanity checks\n have_mofa2 <- py_module_available(\"mofapy2\")\n if (have_mofa2) {\n mofa <- import(\"mofapy2\")\n\n tryCatch(tmp <- strsplit(mofa$version$`__version__`,\"\\\\.\")[[1]], error = function(e) { stop(sprintf(\"mofapy2 is not detected in the specified python binary, see reticulate::py_config(). Consider setting use_basilisk = TRUE to create a python environment with basilisk (https://bioconductor.org/packages/release/bioc/html/basilisk.html)\")) })\n \n v_major_reticulate = tmp[1]; v_minor_reticulate = tmp[2]; v_patch_reticulate = tmp[3]\n \n tmp <- strsplit(.mofapy2_version,\"\\\\.\")[[1]]\n v_major_pypi = tmp[1]; v_minor_pypi = tmp[2]; v_patch_pypi = tmp[3]\n \n # return error if major or minor versions do not agree\n if ((v_major_reticulate!=v_major_pypi) | (v_minor_reticulate!=v_minor_pypi)) {\n warning(sprintf(\"The latest mofapy2 version is %s, you are using %s. Please upgrade with 'pip install mofapy2'\",.mofapy2_version, mofa$version$`__version__`))\n warning(\"Connecting to the latest mofapy2 python package using reticulate (use_basilisk = FALSE)\")\n have_mofa2 <- FALSE\n }\n \n # return warning if patch versions do not agree\n if (v_patch_reticulate!=v_patch_pypi) {\n warning(sprintf(\"The latest mofapy2 version is %s, you are using %s. Please upgrade with 'pip install mofapy2'\",.mofapy2_version, mofa$version$`__version__`))\n }\n \n }\n if (have_mofa2) {\n .run_mofa_reticulate(object, outfile, save_data)\n } else {\n stop(sprintf(\"mofapy2_%s is not detected in the specified python binary, see reticulate::py_config(). Consider setting use_basilisk = TRUE to create a python environment with basilisk (https://bioconductor.org/packages/release/bioc/html/basilisk.html)\", .mofapy2_version))\n # use_basilisk <- TRUE\n }\n }\n \n # Connect to mofapy2 using basilisk (optional)\n if (use_basilisk) {\n \n message(\"Connecting to the mofapy2 package using basilisk. \n Set 'use_basilisk' to FALSE if you prefer to manually set the python binary using 'reticulate'.\")\n \n proc <- basiliskStart(mofa_env)\n on.exit(basiliskStop(proc))\n tmp <- basiliskRun(proc, function(object, outfile, save_data) {\n .run_mofa_reticulate(object, outfile, save_data)\n }, object=object, outfile=outfile, save_data=save_data)\n }\n \n # Load the trained model\n object <- load_model(outfile)\n \n return(object)\n}\n\n\n\n.run_mofa_reticulate <- function(object, outfile, save_data) {\n \n # sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if (!requireNamespace(\"reticulate\", quietly = TRUE)) {\n stop(\"Package \\\"reticulate\\\" is required but is not installed.\", call. = FALSE)\n }\n \n # Initiate reticulate\n mofa <- import(\"mofapy2\")\n \n # Call entry point\n mofa_entrypoint <- mofa$run.entry_point$entry_point()\n \n # Set data options\n mofa_entrypoint$set_data_options(\n scale_views = object@data_options$scale_views,\n scale_groups = object@data_options$scale_groups,\n center_groups = object@data_options$center_groups,\n use_float32 = object@data_options$use_float32\n )\n\n # Set samples metadata\n if (.hasSlot(object, \"samples_metadata\")) {\n mofa_entrypoint$data_opts$samples_metadata <- r_to_py(lapply(object@data_options$groups,\n function(g) object@samples_metadata[object@samples_metadata$group == g,]))\n }\n\n # Set features metadata\n if (.hasSlot(object, \"features_metadata\")) {\n mofa_entrypoint$data_opts$features_metadata <- r_to_py(unname(lapply(object@data_options$views,\n function(m) object@features_metadata[object@features_metadata$view == m,])))\n }\n\n # r_to_py will convert a list with a single name to a string,\n # hence those are to be wrapped in `list()`\n maybe_list <- function(xs) {\n\t if (length(xs) > 1) {\n\t\t xs\n\t } else {\n\t\t list(xs)\n\t }\n }\n \n # Set the data\n mofa_entrypoint$set_data_matrix(\n data = r_to_py( unname(lapply(object@data, function(x) unname( lapply(x, function(y) r_to_py(t(y)) ))) ) ),\n likelihoods = unname(object@model_options$likelihoods),\n views_names = r_to_py(as.list(object@data_options$views)),\n groups_names = r_to_py(as.list(object@data_options$groups)),\n samples_names = r_to_py(lapply(unname(lapply(object@data[[1]], colnames)), maybe_list)),\n features_names = r_to_py(lapply(unname(lapply(object@data, function(x) rownames(x[[1]]))), maybe_list))\n )\n \n # Set covariates\n if (.hasSlot(object, \"covariates\") && !is.null(object@covariates)) {\n sample_cov_to_py <- r_to_py(unname(lapply(object@covariates, function(x) unname(r_to_py(t(x))))))\n cov_names_2_py <- r_to_py(covariates_names(object))\n mofa_entrypoint$set_covariates(sample_cov_to_py, cov_names_2_py)\n }\n \n # Set model options \n mofa_entrypoint$set_model_options(\n factors = object@model_options$num_factors,\n spikeslab_factors = object@model_options$spikeslab_factors, \n spikeslab_weights = object@model_options$spikeslab_weights, \n ard_factors = object@model_options$ard_factors,\n ard_weights = object@model_options$ard_weights \n )\n \n # Set training options \n mofa_entrypoint$set_train_options(\n iter = object@training_options$maxiter,\n convergence_mode = object@training_options$convergence_mode,\n dropR2 = object@training_options$drop_factor_threshold,\n startELBO = object@training_options$startELBO,\n freqELBO = object@training_options$freqELBO,\n seed = object@training_options$seed, \n gpu_mode = object@training_options$gpu_mode,\n gpu_device = object@training_options$gpu_device,\n verbose = object@training_options$verbose,\n outfile = object@training_options$outfile,\n weight_views = object@training_options$weight_views,\n save_interrupted = object@training_options$save_interrupted\n )\n \n \n # Set stochastic options\n if (object@training_options$stochastic) {\n mofa_entrypoint$set_stochastic_options(\n learning_rate = object@stochastic_options$learning_rate,\n forgetting_rate = object@stochastic_options$forgetting_rate,\n batch_size = object@stochastic_options$batch_size,\n start_stochastic = object@stochastic_options$start_stochastic\n )\n }\n \n # Set mefisto options \n if (.hasSlot(object, \"covariates\") && !is.null(object@covariates) & length(object@mefisto_options)>1) {\n warping_ref <- which(groups_names(object) == object@mefisto_options$warping_ref)\n mofa_entrypoint$set_smooth_options(\n scale_cov = object@mefisto_options$scale_cov,\n start_opt = as.integer(object@mefisto_options$start_opt),\n n_grid = as.integer(object@mefisto_options$n_grid),\n opt_freq = as.integer(object@mefisto_options$opt_freq),\n model_groups = object@mefisto_options$model_groups,\n sparseGP = object@mefisto_options$sparseGP,\n frac_inducing = object@mefisto_options$frac_inducing,\n warping = object@mefisto_options$warping,\n warping_freq = as.integer(object@mefisto_options$warping_freq),\n warping_ref = warping_ref-1, # 0-based python indexing\n warping_open_begin = object@mefisto_options$warping_open_begin,\n warping_open_end = object@mefisto_options$warping_open_end,\n warping_groups = r_to_py(object@mefisto_options$warping_groups)\n )\n }\n \n # Build the model\n mofa_entrypoint$build()\n \n # Run the model\n mofa_entrypoint$run()\n\n # Interpolate\n if (.hasSlot(object, \"covariates\") && !is.null(object@covariates) & length(object@mefisto_options)>1) {\n if(!is.null(object@mefisto_options$new_values)) {\n new_values <- object@mefisto_options$new_values\n if(is.null(dim(new_values))){\n new_values <- matrix(new_values, nrow = 1)\n }\n mofa_entrypoint$predict_factor(new_covariates = r_to_py(t(new_values)))\n }\n }\n \n # Save the model output as an hdf5 file\n mofa_entrypoint$save(outfile, save_data = save_data)\n\n}\n" }, { "path": "R/set_methods.R", "content": "\n\n####################################\n## Set and retrieve factors names ##\n####################################\n\n#' @rdname factors_names\n#' @param object a \\code{\\link{MOFA}} object.\n#' @aliases factors_names,MOFA-method\n#' @return character vector with the factor names\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' factors_names(model)\n\nsetMethod(\"factors_names\", signature(object=\"MOFA\"), \n function(object) {\n colnames(object@expectations$Z[[1]]) \n }\n)\n\n#' @rdname factors_names\n#' @param value a character vector of factor names\n#' @import methods\n#' @export\nsetReplaceMethod(\"factors_names\", signature(object=\"MOFA\", value=\"vector\"), \n function(object, value) {\n if (!methods::.hasSlot(object, \"expectations\") || length(object@expectations) == 0)\n stop(\"Before assigning factor names you have to assign expectations\")\n if (methods::.hasSlot(object, \"dimensions\") && length(object@dimensions) != 0)\n if (length(value) != object@dimensions[\"K\"])\n stop(\"Length of factor names does not match the dimensionality of the latent variable matrix\")\n \n # Modify expectations\n object <- .set_expectations_names(object, entity = 'factors', value)\n \n # Modify interpolated values\n if(length(object@interpolated_Z) > 0) {\n object@interpolated_Z <- lapply(object@interpolated_Z, function(g) {\n if(!is.null(g$mean)) {\n rownames(g$mean) <- value\n }\n if(!is.null(g$variance)) {\n rownames(g$variance) <- value\n }\n return(g)\n }\n )\n }\n \n # Modify cache\n if ((methods::.hasSlot(object, \"cache\")) && (\"variance_explained\" %in% names(object@cache))) {\n for (i in seq_len(length(object@cache$variance_explained$r2_per_factor))) {\n rownames(object@cache$variance_explained$r2_per_factor[[i]]) <- value\n }\n }\n\n # Modify training stats per factor\n if (!is.null(object@training_stats$structural_sig)) {\n rownames(object@training_stats$structural_sig) <- value\n }\n if (!is.null(object@training_stats$length_scales)) {\n rownames(object@training_stats$length_scales) <- value\n }\n if (!is.null(object@training_stats$scales)) {\n rownames(object@training_stats$scales) <- value\n }\n\n object\n })\n\n####################################\n## Set and retrieve covariate names ##\n####################################\n\n#' @rdname covariates_names\n#' @param object a \\code{\\link{MOFA}} object.\n#' @aliases covariates,MOFA-method\n#' @return character vector with the covariate names\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' covariates_names(model)\n\nsetMethod(\"covariates_names\", signature(object=\"MOFA\"),\n function(object) {\n if(!.hasSlot(object, \"covariates\") || is.null(object@covariates))\n stop(\"No covariates present in the given MOFA object.\")\n rownames(object@covariates[[1]])\n }\n)\n\n#' @rdname covariates_names\n#' @param value a character vector of covariate names\n#' @import methods\n#' @importFrom dplyr left_join\n#' @export\nsetReplaceMethod(\"covariates_names\", signature(object=\"MOFA\", value=\"vector\"),\n function(object, value) {\n if(!.hasSlot(object, \"covariates\") || is.null(object@covariates))\n stop(\"No covariates present in the given MOFA object.\")\n if (methods::.hasSlot(object, \"dimensions\") && length(object@dimensions) != 0)\n if (length(value) != object@dimensions[\"C\"])\n stop(\"Length of covariate names does not match the dimensionality of the covariate matrix\")\n \n # Modify covariate names\n old_names <- rownames(object@covariates[[1]])\n for(c in seq_along(object@covariates)) {\n rownames(object@covariates[[c]]) <- value\n if(!is.null(object@covariates_warped)) \n rownames(object@covariates_warped[[c]]) <- value\n }\n # Modify meta.data\n if (methods::.hasSlot(object, \"samples_metadata\")) {\n if(!is.null(old_names)) {\n if(! all(old_names %in% colnames(object@samples_metadata)))\n stop(\"Mismatch of covariate names in sample meta data and covariate slot\")\n object@samples_metadata <- object@samples_metadata[,-old_names]\n }\n df <- as.data.frame(Reduce(rbind, unname(lapply(object@covariates,t))))\n colnames(df) <- value\n df$sample <- rownames(df)\n object@samples_metadata <- dplyr::left_join(object@samples_metadata, df, by = \"sample\",\n suffix = c(\"\", \"_scaled\"))\n if(!is.null(object@covariates_warped)) {\n df <- as.data.frame(Reduce(rbind, unname(lapply(object@covariates_warped,t))))\n colnames(df) <- value\n df$sample <- rownames(df)\n object@samples_metadata <- dplyr::left_join(object@samples_metadata, df, by = \"sample\",\n suffix = c(\"\", \"_warped\"))\n }\n }\n \n object\n })\n\n####################################\n## Set and retrieve samples names ##\n####################################\n\n#' @rdname samples_names\n#' @param object a \\code{\\link{MOFA}} object.\n#' @aliases samples_names,MOFA-method\n#' @return list of character vectors with the sample names for each group\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' samples_names(model)\n\nsetMethod(\"samples_names\", signature(object=\"MOFA\"), \n function(object) {\n \n # When the model is not trained, the samples slot is not initialized yet\n if (!(\"samples_metadata\" %in% slotNames(object)) || (length(samples_metadata(object)) == 0)) {\n return(list())\n }\n \n # The default case when samples are initialized (trained model)\n samples_list <- lapply(object@data_options$groups, function(g) {\n with(object@samples_metadata, object@samples_metadata[group == g, \"sample\"])\n })\n \n names(samples_list) <- object@data_options$groups\n return(samples_list)\n })\n\n#' @rdname samples_names\n#' @param value list of character vectors with the sample names for every group\n#' @import methods\n#' @export\nsetReplaceMethod(\"samples_names\", signature(object=\"MOFA\", value=\"list\"), \n function(object, value) {\n if (!methods::.hasSlot(object, \"data\") || length(object@data) == 0 || length(object@data[[1]]) == 0)\n stop(\"Before assigning sample names you have to assign the training data\")\n if (!methods::.hasSlot(object, \"expectations\") || length(object@expectations) == 0)\n stop(\"Before assigning sample names you have to assign the expectations\")\n if (methods::.hasSlot(object, \"dimensions\") && length(object@dimensions) != 0)\n if (!all(sapply(value, length) == object@dimensions[[\"N\"]]))\n stop(\"Length of sample names does not match the dimensionality of the model\")\n if (!all(sapply(value, length) == sapply(object@data[[1]], ncol)))\n stop(\"sample names do not match the dimensionality of the data (columns)\")\n \n value_groups <- rep(names(value), lengths(value))\n\n # Modify sample names in the sample metadata\n object@samples_metadata$sample <- unlist(value, use.names = FALSE)\n object@samples_metadata$group <- as.factor( value_groups )\n if (is(object@samples_metadata, \"list\")) {\n object@samples_metadata <- data.frame(object@samples_metadata, stringsAsFactors = FALSE)\n }\n \n # Add samples names to the expectations\n object <- .set_expectations_names(object, entity = 'samples', value)\n \n # Add samples names to the data\n if (length(object@data)>0)\n object <- .set_data_names(object, entity = 'samples', value)\n \n # Add sample names to covariates\n if (.hasSlot(object, \"covariates\") && !is.null(object@covariates)) {\n for (m in seq_along(object@covariates))\n colnames(object@covariates[[m]]) <- value[[m]]\n }\n if (.hasSlot(object, \"covariates_warped\") && !is.null(object@covariates_warped)) {\n for (m in seq_along(object@covariates_warped))\n colnames(object@covariates_warped[[m]]) <- value[[m]]\n }\n \n # Add samples names to the imputed data\n if (length(object@imputed_data)>0) \n object <- .set_imputed_data_names(object, entity = 'samples', value)\n \n object\n })\n\n######################################\n## Set and retrieve sample metadata ##\n######################################\n\n#' @rdname samples_metadata\n#' @param object a \\code{\\link{MOFA}} object.\n#' @return a data frame with sample metadata\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' samples_metadata(model)\n \nsetMethod(\"samples_metadata\", signature(object=\"MOFA\"), \n function(object) { \n object@samples_metadata\n })\n\n#' @rdname samples_metadata\n#' @param value data frame with sample metadata, it must at least contain the columns \\code{sample} and \\code{group}.\n#' The order of the rows must match the order of \\code{samples_names(object)}\n#' @import methods\n#' @export\nsetReplaceMethod(\"samples_metadata\", signature(object=\"MOFA\", value=\"data.frame\"), \n function(object, value) {\n if (!methods::.hasSlot(object, \"data\") || length(object@data) == 0 || length(object@data[[1]]) == 0)\n stop(\"Before assigning samples metadata you have to assign the input data\")\n if (methods::.hasSlot(object, \"dimensions\") && length(object@dimensions) != 0)\n if (nrow(value) != sum(object@dimensions[[\"N\"]]))\n stop(\"Number of rows in samples metadata does not match the dimensionality of the model\")\n if (nrow(value) != sum(sapply(object@data[[1]], ncol)))\n stop(\"sample names do not match the dimensionality of the data (columns)\")\n if (!(\"sample\" %in% colnames(value)))\n stop(\"Metadata has to contain the column 'sample'\")\n if (any(sort(value$sample) != sort(unname(unlist(samples_names(object)))) ))\n stop(\"Samples names in the model (see `samples(MOFAobject)`) and in the metadata do not match\")\n if (!(\"group\" %in% colnames(value))) {\n if (length(unique(object@data_options$groups))==1) {\n value$group <- groups_names(object)\n } else {\n stop(\"Metadata has to contain the column 'group'\")\n }\n }\n \n if (any(sort(unique(as.character(value$group))) != sort(groups_names(object))))\n stop(\"Groups names in the model (see `groups(MOFAobject)`) and in the metadata do not match\")\n \n # Make sure that the order of samples metadata match the order of samples\n # samples <- unname(unlist(samples_names(object)))\n samples <- unname(unlist(lapply(object@data[[1]],colnames)))\n value <- value[match(samples, value$sample),]\n\n object@samples_metadata <- as.data.frame(value)\n \n object\n })\n\n#####################################\n## Set and retrieve features names ##\n#####################################\n\n#' @rdname features_names\n#' @param object a \\code{\\link{MOFA}} object.\n#' @aliases features_names,MOFA-method\n#' @return list of character vectors with the feature names for each view\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' features_names(model)\n\nsetMethod(\"features_names\", signature(object=\"MOFA\"), \n function(object) {\n # When the model is not trained, the features slot is not initialized yet\n if (!(\"features_metadata\" %in% slotNames(object)) || (length(object@features_metadata) == 0)) {\n return(list())\n }\n # The default case when features are initialized (trained model)\n features_list <- lapply(object@data_options$views, function(m) {\n with(object@features_metadata, object@features_metadata[view == m, \"feature\"])\n })\n names(features_list) <- object@data_options$views\n return(features_list)\n })\n\n#' @rdname features_names\n#' @param value list of character vectors with the feature names for every view\n#' @import methods\n#' @export\nsetReplaceMethod(\"features_names\", signature(object=\"MOFA\", value=\"list\"),\n function(object, value) {\n if (!methods::.hasSlot(object, \"data\") || length(object@data) == 0)\n stop(\"Before assigning feature names you have to assign the training data\")\n if (!methods::.hasSlot(object, \"expectations\") || length(object@expectations) == 0)\n stop(\"Before assigning feature names you have to assign the expectations\")\n if (methods::.hasSlot(object, \"dimensions\") || length(object@dimensions) == 0)\n if (!all(sapply(value, length) == object@dimensions[[\"D\"]]))\n stop(\"Length of feature names does not match the dimensionality of the model\")\n if (!all(sapply(value, length) == sapply(object@data, function(e) nrow(e[[1]]))))\n stop(\"Feature names do not match the dimensionality of the data (rows)\")\n \n value_groups <- rep(names(value), lengths(value))\n\n object@features_metadata$feature <- unlist(value, use.names = FALSE)\n object@features_metadata$view <- value_groups\n\n if (is(object@features_metadata, \"list\")) {\n object@features_metadata <- data.frame(object@features_metadata, stringsAsFactors = FALSE)\n }\n \n # Add features names to the expectations matrices\n object <- .set_expectations_names(object, entity = 'features', value)\n \n # Add features names to the data\n if (length(object@data)>0)\n object <- .set_data_names(object, entity = 'features', value)\n \n # Add samples names to the imputed data\n if (length(object@imputed_data)>0) \n object <- .set_imputed_data_names(object, entity = 'features', value)\n \n object\n })\n\n#######################################\n## Set and retrieve feature metadata ##\n#######################################\n\n#' @rdname features_metadata\n#' @param object a \\code{\\link{MOFA}} object.\n#' @return a data frame with sample metadata\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' features_metadata(model)\n \nsetMethod(\"features_metadata\", signature(object=\"MOFA\"), \n function(object) { \n object@features_metadata\n })\n\n#' @rdname features_metadata\n#' @param value data frame with feature information, it at least must contain the columns \\code{feature} and \\code{view}\n#' @import methods\n#' @export\nsetReplaceMethod(\"features_metadata\", signature(object=\"MOFA\", value=\"data.frame\"), \n function(object, value) {\n if (!methods::.hasSlot(object, \"data\") || length(object@data) == 0 || length(object@data[[1]]) == 0)\n stop(\"Before assigning features metadata you have to assign the training data\")\n # if (!methods::.hasSlot(object, \"expectations\") || length(object@expectations) == 0)\n # stop(\"Before assigning features metadata you have to assign the expectations\")\n if (methods::.hasSlot(object, \"dimensions\") && length(object@dimensions) != 0)\n if (nrow(value) != sum(object@dimensions[[\"D\"]]))\n stop(\"Number of rows in features metadata does not match the dimensionality of the model\")\n if (nrow(value) != sum(sapply(object@data, function(e) nrow(e[[1]]))))\n stop(\"Features names do not match the dimensionality of the data (rows)\")\n if (!(\"feature\" %in% colnames(value)))\n stop(\"Metadata has to contain the column feature\")\n if (!(\"view\" %in% colnames(value)))\n stop(\"Metadata has to contain the column view\")\n if (colnames(value)[1] != \"feature\")\n message(\"Note that feature is currently not the first column of the features metadata.\")\n \n object@features_metadata <- value\n \n object\n })\n\n##################################\n## Set and retrieve views names ##\n##################################\n\n#' @rdname views_names\n#' @param object a \\code{\\link{MOFA}} object.\n#' @return character vector with the names for each view\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' views_names(model)\n#' views_names(model) <- c(\"viewA\", \"viewB\")\n\nsetMethod(\"views_names\", signature(object=\"MOFA\"), \n function(object) {\n object@data_options$views\n })\n\n\n#' @rdname views_names\n#' @param value character vector with the names for each view\n#' @import methods\n#' @export\nsetMethod(\"views_names<-\", signature(object=\"MOFA\", value=\"character\"), \n function(object, value) {\n # if (!methods::.hasSlot(object, \"data\") || length(object@data) == 0)\n # stop(\"Before assigning view names you have to assign the training data\")\n if (methods::.hasSlot(object, \"dimensions\") && length(object@dimensions) != 0)\n if (length(value) != object@dimensions[[\"M\"]])\n stop(\"Length of view names does not match the dimensionality of the model\")\n # if (length(value) != length(object@data))\n # stop(\"View names do not match the number of views in the training data\")\n \n # Define types of nodes\n nodes_types <- .get_nodes_types()\n \n # Set view names in data options\n old_views <- object@data_options$views\n object@data_options$views <- value\n \n # Set view names in model options\n if (length(object@model_options$likelihoods)>0)\n names(object@model_options$likelihoods) <- value\n \n # Set view names in features_metadata \n if (!is.null(object@features_metadata) && (length(object@features_metadata) != 0)) {\n # object@features_metadata$view <- as.character(object@features_metadata$view)\n for (i in seq_len(object@dimensions[[\"M\"]])) {\n old_name <- old_views[i]\n new_name <- value[i]\n object@features_metadata[object@features_metadata$view == old_name, \"view\"] <- new_name\n }\n }\n \n # Set view names in cache\n if (!is.null(object@cache$variance_explained)) {\n for (i in names(object@cache$variance_explained$r2_total)) {\n names(object@cache$variance_explained$r2_total[[i]]) <- value\n }\n for (i in names(object@cache$variance_explained$r2_per_factor)) {\n colnames(object@cache$variance_explained$r2_per_factor[[i]]) <- value\n }\n }\n \n # Set view names in expectations\n for (node in names(object@expectations)) {\n if (node %in% nodes_types$multiview_nodes || node %in% nodes_types$twodim_nodes) {\n if (is(object@expectations[[node]], \"list\") && length(object@expectations[[node]]) == object@dimensions[\"M\"]) {\n names(object@expectations[[node]]) <- value \n }\n }\n }\n \n # Set view names in the training data\n if (length(object@data)>0)\n names(object@data) <- value\n \n # Set view names in the intercepts\n if (length(object@intercepts)>0)\n names(object@intercepts) <- value\n \n # Set view names in the imputed data\n if (length(object@imputed_data)>0)\n names(object@imputed_data) <- value\n \n # Set view names in the dimensionalities\n names(object@dimensions$D) <- value\n \n return(object)\n })\n\n\n###################################\n## Set and retrieve groups names ##\n###################################\n\n#' @rdname groups_names\n#' @param object a \\code{\\link{MOFA}} object.\n#' @return character vector with the names for each sample group\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' groups_names(model)\n#' groups_names(model) <- c(\"my_group\")\n \nsetMethod(\"groups_names\", signature(object=\"MOFA\"), \n function(object) {\n object@data_options$groups\n })\n\n\n#' @rdname groups_names\n#' @param value character vector with the names for each group\n#' @import methods\n#' @export\nsetMethod(\"groups_names<-\", signature(object=\"MOFA\", value=\"character\"), \n function(object, value) {\n # if (!methods::.hasSlot(object, \"data\") || length(object@data) == 0)\n # stop(\"Before assigning group names you have to assign the training data\")\n if (methods::.hasSlot(object, \"dimensions\") && length(object@dimensions) != 0)\n if(length(value) != object@dimensions[[\"G\"]])\n stop(\"Length of group names does not match the dimensionality of the model\")\n # if (length(value) != length(object@data[[1]]))\n # stop(\"Group names do not match the number of groups in the training data\")\n \n # Define types of nodes\n nodes_types <- .get_nodes_types()\n\n # Set sample group names in data options\n old_groups <- object@data_options$groups\n object@data_options$groups <- value\n \n # Set sample group names in samples_metadata\n if (!is.null(object@samples_metadata) && (length(object@samples_metadata) != 0)) {\n object@samples_metadata$group <- as.character(object@samples_metadata$group)\n for (i in seq_len(object@dimensions[[\"G\"]])) {\n old_name <- old_groups[i]\n new_name <- value[i]\n object@samples_metadata[object@samples_metadata$group == old_name, \"group\"] <- new_name\n }\n object@samples_metadata$group <- factor(object@samples_metadata$group, levels=value)\n }\n \n # Set sample group names in cache\n if (!is.null(object@cache$variance_explained)) {\n names(object@cache$variance_explained$r2_total) <- value\n names(object@cache$variance_explained$r2_per_factor) <- value\n }\n \n # Set sample group names in expectations\n for (node in nodes_types$multigroup_nodes) {\n if (node %in% names(object@expectations)) {\n if (is(object@expectations[[node]], \"list\") && length(object@expectations[[node]])==object@dimensions[\"G\"]) {\n names(object@expectations[[node]]) <- value \n }\n }\n }\n for (node in nodes_types$twodim_nodes) {\n if (node %in% names(object@expectations)) {\n for (m in seq_len(length(object@expectations[[node]]))) {\n if (is(object@expectations[[node]][[m]], \"list\") && length(object@expectations[[node]][[m]])==object@dimensions[\"G\"]) {\n names(object@expectations[[node]][[m]]) <- value \n }\n }\n }\n }\n \n # Set sample group names in data\n if (length(object@data)>0) {\n for (m in names(object@data))\n names(object@data[[m]]) <- value\n }\n \n # Set sample group names in covariates\n if (.hasSlot(object, \"covariates\") && !is.null(object@covariates)) {\n names(object@covariates) <- value\n }\n \n # Set sample group names in the intercepts\n if (length(object@intercepts)>0) {\n for (m in names(object@intercepts)) {\n if (length(object@intercepts[[m]])>0)\n names(object@intercepts[[m]]) <- value\n }\n }\n \n # Set sample group names in imputed data\n if (length(object@imputed_data)>0) {\n for (m in names(object@imputed_data)) {\n if (length(object@imputed_data[[m]])>0)\n names(object@imputed_data[[m]]) <- value\n }\n }\n \n # Set sample group names in dimensionalities\n stopifnot(length(object@dimensions$N)==length(value))\n names(object@dimensions$N) <- value\n \n return(object)\n })\n\n\n# (Hidden) General function to set dimension names for the expectations\n# Entity is features, samples, or factors\n.set_expectations_names <- function(object, entity, values, views=\"all\", groups=\"all\") {\n \n # Define types of nodes\n nodes_types <- .get_nodes_types()\n \n # Define what entities should be updated for which nodes\n # Notation for axes: 2 is for columns, 1 is for rows, 0 is for vectors, 3 for 3-rd dim in tensors\n stopifnot(entity %in% c(\"features\", \"samples\", \"factors\"))\n node_lists_options <- list(\n # features = list(nodes = c(\"Y\", \"Tau\", \"W\"), axes = c(1, 1, 1, 1)),\n # samples = list(nodes = c(\"Y\", \"Tau\", \"Z\"), axes = c(2, 2, 1, 1)),\n features = list(nodes = c(\"Y\", \"Tau\", \"W\"), axes = c(1, 2, 1)),\n samples = list(nodes = c(\"Y\", \"Tau\", \"Z\", \"Sigma\", \"Sigma\"), axes = c(2, 1, 1, 2, 3)),\n factors = list(nodes = c(\"Z\", \"W\", \"AlphaZ\", \"AlphaW\", \"ThetaZ\", \"ThetaW\", \"Sigma\"), axes = c(2, 2, 0, 0, 0, 0, 1))\n )\n \n if (paste0(views, collapse = \"\") == \"all\") { \n views <- names(object@dimensions$D)\n } else {\n stopifnot(all(views %in% names(object@dimensions$D)))\n }\n \n if (paste0(groups, collapse = \"\") == \"all\") {\n groups <- names(object@dimensions$N)\n } else {\n stopifnot(all(groups %in% names(object@dimensions$N)))\n }\n \n # Iterate over node list depending on the entity\n nodes <- node_lists_options[[entity]]$nodes\n axes <- node_lists_options[[entity]]$axes\n for (i in seq_len(length(nodes))) {\n node <- nodes[i]\n axis <- axes[i]\n \n # Update the nodes for which expectations do exist\n if (node %in% names(object@expectations)) {\n \n # Update nodes with one level of nestedness (e.g. W or Z)\n if (any(node %in% nodes_types$multiview_node, node %in% nodes_types$multigroup_nodes)) {\n sub_dim <- length(object@expectations[[node]])\n for (ind in seq_len(sub_dim)) {\n \n # No nestedness in values if factors\n vals <- if (entity == \"factors\") values else values[[ind]]\n dim <- length(vals)\n \n # Set names for rows\n if (axis == 1) {\n stopifnot(nrow(object@expectations[[node]][[ind]]) == dim)\n rownames(object@expectations[[node]][[ind]]) <- vals\n # ... or set names for columns\n } else if (axis == 2) {\n stopifnot(ncol(object@expectations[[node]][[ind]]) == dim)\n colnames(object@expectations[[node]][[ind]]) <- vals\n # ... or set vector names\n } else if (axis == 0) {\n stopifnot(length(object@expectations[[node]][[ind]]) == dim)\n names(object@expectations[[node]][[ind]]) <- vals\n }\n }\n \n # Update nodes with two levels of nestedness (e.g. Y or Tau)\n } else if (node %in% nodes_types$twodim_nodes) {\n sub_dim <- length(object@expectations[[node]])\n for (ind in seq_len(sub_dim)) {\n sub_dim2 <- length(object@expectations[[node]][[ind]])\n for (ind2 in seq_len(sub_dim2)) {\n \n # Infer which index to use to iterate over a provided list of values\n deduced_ind <- if (entity == \"features\") ind else ind2 # since ind corresponds to views (groups of features)\n dim <- length(values[[deduced_ind]])\n \n # Set names for rows\n if (axis == 1) {\n stopifnot(nrow(object@expectations[[node]][[ind]][[ind2]]) == dim)\n rownames(object@expectations[[node]][[ind]][[ind2]]) <- values[[deduced_ind]]\n # ... or set names for columns\n } else if (axis == 2) {\n stopifnot(ncol(object@expectations[[node]][[ind]][[ind2]]) == dim)\n colnames(object@expectations[[node]][[ind]][[ind2]]) <- values[[deduced_ind]]\n # ... or set vector names\n } else {\n stopifnot(length(object@expectations[[node]][[ind]]) == dim)\n names(object@expectations[[node]][[ind]]) <- vals\n }\n }\n }\n # Update nodes with multivariate components (e.g. Sigma)\n } else if (node %in% nodes_types$multivariate_singleview_node) {\n # Set names for rows\n if (axis != 0) {\n dimnames(object@expectations[[node]][[1]])[[axis]] <- unlist(values)\n } else {\n # names(object@expectations[[node]][[1]]) <- values # no group structure in Sigma (full covariance across all samples)\n }\n } else {\n print(paste0(\"DEV :: NOTE: There are no expectations for the node \", node))\n }\n }\n }\n \n object\n}\n\n\n# (Hidden) Function to set dimensions names for the data and intercepts\n.set_data_names <- function(object, entity, values) {\n \n stopifnot(entity %in% c(\"features\", \"samples\"))\n \n axes_options <- list(features = 1, samples = 2)\n \n for (m in seq_len(length(object@data))) {\n for (g in seq_len(length(object@data[[m]]))) {\n deduced_ind <- if (entity == \"features\") m else g # since ind corresponds to views (groups of features)\n if (axes_options[[entity]] == 1) {\n rownames(object@data[[m]][[g]]) <- values[[deduced_ind]]\n } else {\n colnames(object@data[[m]][[g]]) <- values[[deduced_ind]]\n }\n \n if (entity==\"features\")\n tryCatch(names(object@intercepts[[m]][[g]]) <- values[[deduced_ind]], error = function(e) { NULL })\n }\n }\n \n object\n}\n\n\n# (Hidden) Function to set dimensions names for the imputed data\n.set_imputed_data_names <- function(object, entity, values) {\n \n stopifnot(entity %in% c(\"features\", \"samples\"))\n \n axes_options <- list(features = 1, samples = 2)\n \n for (m in seq_len(length(object@data))) {\n for (g in seq_len(length(object@data[[m]]))) {\n deduced_ind <- if (entity == \"features\") m else g # since ind corresponds to views (groups of features)\n if (axes_options[[entity]] == 1) {\n rownames(object@imputed_data[[m]][[g]]) <- values[[deduced_ind]]\n # rownames(object@imputed_data[[m]][[g]][[\"mean\"]]) <- values[[deduced_ind]]\n # rownames(object@imputed_data[[m]][[g]][[\"variance\"]]) <- values[[deduced_ind]]\n } else {\n colnames(object@imputed_data[[m]][[g]]) <- values[[deduced_ind]]\n # colnames(object@imputed_data[[m]][[g]][[\"mean\"]]) <- values[[deduced_ind]]\n # colnames(object@imputed_data[[m]][[g]][[\"variance\"]]) <- values[[deduced_ind]]\n }\n }\n }\n object\n}\n\n" }, { "path": "R/subset.R", "content": "\n################################\n## Functions to do subsetting ##\n################################\n\n#' @title Subset groups\n#' @name subset_groups\n#' @description Method to subset (or sort) groups\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param groups character vector with the groups names, numeric vector with the groups indices\n#' or logical vector with the groups to be kept as TRUE.\n#' @return A \\code{\\link{MOFA}} object\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Subset the first group\n#' model <- subset_groups(model, groups = 1)\nsubset_groups <- function(object, groups) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(length(groups) <= object@dimensions[[\"G\"]])\n \n # Define groups \n groups <- .check_and_get_groups(object, groups)\n \n # Subset expectations\n if (length(object@expectations)>0) {\n if (\"Z\" %in% names(object@expectations) & length(object@expectations$Z)>0)\n object@expectations$Z <- object@expectations$Z[groups]\n if (\"Y\" %in% names(object@expectations) & length(object@expectations$Y)>0)\n object@expectations$Y <- sapply(object@expectations$Y, function(x) x[groups], simplify = FALSE, USE.NAMES = TRUE) \n }\n \n # Subset data\n if (length(object@data)>0) {\n object@data <- sapply(object@data, function(x) x[groups], simplify = FALSE, USE.NAMES = TRUE) \n }\n\n # Subset imputed data\n if (length(object@imputed_data)>0) {\n object@imputed_data <- sapply(object@imputed_data, function(x) x[groups], simplify = FALSE, USE.NAMES = TRUE) \n }\n \n # Subset intercepts\n if (length(object@intercepts[[1]])>0) {\n object@intercepts <- sapply(object@intercepts, function(x) x[groups], simplify = FALSE, USE.NAMES = TRUE) \n }\n \n # Update dimensionality\n object@dimensions[[\"G\"]] <- length(groups)\n object@dimensions[[\"N\"]] <- object@dimensions[[\"N\"]][groups]\n \n # Subset sample metadata\n stopifnot(groups%in%unique(object@samples_metadata$group))\n object@samples_metadata <- object@samples_metadata[object@samples_metadata$group %in% groups,]\n object@samples_metadata$group <- factor(object@samples_metadata$group, levels=groups)\n \n # Re-order samples\n samples <- unname(unlist(lapply(object@data[[1]],colnames)))\n object@samples_metadata <- object@samples_metadata[match(samples, object@samples_metadata$sample),]\n \n # Sanity checks\n stopifnot(object@samples_metadata$sample == unlist(lapply(object@data[[1]],colnames)))\n stopifnot(object@samples_metadata$sample == unlist(lapply(object@expectations$Z,rownames)))\n stopifnot(object@samples_metadata$sample == unlist(lapply(object@expectations$Y,colnames)))\n \n # Update groups names\n # groups_names(object) <- groups # don't need to run this\n object@data_options$groups <- groups\n \n # Subset variance explained\n object@cache[[\"variance_explained\"]]$r2_per_factor <- object@cache[[\"variance_explained\"]]$r2_per_factor[groups]\n object@cache[[\"variance_explained\"]]$r2_total <- object@cache[[\"variance_explained\"]]$r2_total[groups]\n \n return(object)\n}\n\n\n#' @title Subset views\n#' @name subset_views\n#' @description Method to subset (or sort) views\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param views character vector with the views names, numeric vector with the views indices,\n#' or logical vector with the views to be kept as TRUE.\n#' @return A \\code{\\link{MOFA}} object\n#' @export\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Subset the first view\n#' model <- subset_views(model, views = 1)\nsubset_views <- function(object, views) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(length(views) <= object@dimensions[[\"M\"]])\n # warning(\"Removing views a posteriori is fine for an exploratory analysis, but you should removing them before training!\")\n \n # Define views\n views <- .check_and_get_views(object, views)\n \n # Subset relevant slots\n if (length(object@expectations)>0) {\n object@expectations$W <- object@expectations$W[views]\n object@expectations$Y <- object@expectations$Y[views]\n }\n\n # Subset data\n if (length(object@data)>0) {\n object@data <- object@data[views]\n }\n \n # Subset imputed data\n if (length(object@imputed_data)>0) {\n object@imputed_data <- object@imputed_data[views]\n }\n \n # Subset intercepts\n if (length(object@intercepts[[1]])>0) {\n object@intercepts <- object@intercepts[views]\n }\n \n # Subset feature metadata\n if (length(object@features_metadata)>0) {\n object@features_metadata <- object@features_metadata[object@features_metadata$view %in% views,]\n }\n \n # Subset likelihoods\n object@model_options$likelihoods <- object@model_options$likelihoods[views]\n # Update dimensionality\n object@dimensions[[\"M\"]] <- length(views)\n object@dimensions[[\"D\"]] <- object@dimensions[[\"D\"]][views]\n \n # Update view names\n object@data_options$views <- views\n \n # Subset variance explained\n if ((methods::.hasSlot(object, \"cache\")) && (\"variance_explained\" %in% names(object@cache))) {\n object@cache[[\"variance_explained\"]]$r2_per_factor <- lapply(object@cache[[\"variance_explained\"]]$r2_per_factor, function(x) x[,views,drop=FALSE])\n object@cache[[\"variance_explained\"]]$r2_total <- lapply(object@cache[[\"variance_explained\"]]$r2_total, function(x) x[views])\n }\n \n return(object)\n}\n\n\n#' @title Subset factors\n#' @name subset_factors\n#' @description Method to subset (or sort) factors\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param factors character vector with the factor names, or numeric vector with the index of the factors.\n#' @param recalculate_variance_explained logical indicating whether to recalculate variance explained values. Default is \\code{TRUE}.\n#' @export\n#' @return A \\code{\\link{MOFA}} object\n#' @examples\n#' # Using an existing trained model on simulated data\n#' file <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n#' model <- load_model(file)\n#' \n#' # Subset factors 1 to 3\n#' model <- subset_factors(model, factors = 1:3)\nsubset_factors <- function(object, factors, recalculate_variance_explained = TRUE) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(length(factors) <= object@dimensions[[\"K\"]])\n \n # Define factors\n factors <- .check_and_get_factors(object, factors)\n \n # Subset expectations\n nodes_with_factors <- list(nodes = c(\"Z\", \"W\", \"Sigma\", \"AlphaZ\", \"AlphaW\", \"ThetaZ\", \"ThetaW\"), axes = c(2, 2, 1, 0, 0, 0, 0))\n stopifnot(all(nodes_with_factors$axes %in% c(0, 1, 2)))\n\n if (length(object@expectations)>0) {\n for (i in seq_len(length(nodes_with_factors$nodes))) {\n node <- nodes_with_factors$nodes[i]\n axis <- nodes_with_factors$axes[i]\n if (node %in% names(object@expectations)) {\n if(node != \"Sigma\") {\n if (axis == 1) {\n object@expectations[[node]] <- sapply(object@expectations[[node]], function(x) x[factors,,drop=FALSE], simplify = FALSE, USE.NAMES = TRUE)\n } else if (axis == 2) {\n object@expectations[[node]] <- sapply(object@expectations[[node]], function(x) x[,factors,drop=FALSE], simplify = FALSE, USE.NAMES = TRUE)\n } else {\n object@expectations[[node]] <- sapply(object@expectations[[node]], function(x) x[factors], simplify = FALSE, USE.NAMES = TRUE)\n }\n } else {\n if (axis == 1) {\n object@expectations[[node]] <- sapply(object@expectations[[node]], function(x) x[factors,,,drop=FALSE], simplify = FALSE, USE.NAMES = TRUE)\n } else if (axis == 2) {\n object@expectations[[node]] <- sapply(object@expectations[[node]], function(x) x[,factors,,drop=FALSE], simplify = FALSE, USE.NAMES = TRUE)\n } else if (axis == 3) {\n object@expectations[[node]] <- sapply(object@expectations[[node]], function(x) x[,,factors,drop=FALSE], simplify = FALSE, USE.NAMES = TRUE)\n } \n }\n }\n }\n }\n \n # Subset interpolations\n if(length(object@interpolated_Z) > 0) {\n object@interpolated_Z <- lapply(object@interpolated_Z, function(g) { \n if(!is.null(g$mean)) {\n m <- g$mean[factors, , drop = FALSE]\n }\n if(!is.null(g$variance)) {\n v <- g$variance[factors, , drop = FALSE]\n }\n list(mean = m, variance = v, new_values = g$new_values)\n })\n }\n \n # Remove total variance explained estimates \n if (length(factors)0) {\n if (\"Z\" %in% names(object@expectations) & length(object@expectations$Z)>0) {\n object@expectations$Z[[g]] <- object@expectations$Z[[g]][samples_g,, drop=FALSE]\n }\n \n if (\"Y\" %in% names(object@expectations) & length(object@expectations$Y)>0) {\n for (m in views_names(object)) {\n object@expectations$Y[[m]][[g]] <- object@expectations$Y[[m]][[g]][,samples_g,drop=FALSE]\n } \n }\n if (\"Tau\" %in% names(object@expectations) & length(object@expectations$Tau)>0) {\n for (m in views_names(object)) {\n object@expectations$Tau[[m]][[g]] <- object@expectations$Tau[[m]][[g]][samples_g, , drop=FALSE]\n } \n }\n if(g == groups[1]) {# only one Sigma node\n if (\"Sigma\" %in% names(object@expectations) & length(object@expectations$Sigma)>0) {\n samples <- unique(unlist(tmp)) # TODO - make Sigma live on covariate level or expand to group-level\n object@expectations$Sigma[[1]] <- object@expectations$Sigma[[1]][,samples,samples,drop=FALSE]\n }\n }\n }\n\n # Subset data\n if (length(object@data)>0) { \n for (m in views_names(object)) {\n object@data[[m]][[g]] <- object@data[[m]][[g]][,samples_g,drop=FALSE]\n }\n }\n \n # Subset imputed data\n if (length(object@imputed_data)>0) { \n for (m in views_names(object)) {\n object@imputed_data[[m]][[g]] <- object@imputed_data[[m]][[g]][,samples_g,drop=FALSE]\n }\n }\n \n }\n\n # Subset sample metadata\n object@samples_metadata <- object@samples_metadata[object@samples_metadata$sample %in% samples,]\n \n # Update dimensionality\n object@dimensions[[\"N\"]] <- sapply(tmp, length)\n \n # Update sample names\n samples_names(object) <- tmp\n \n # Sanity checks\n stopifnot(object@samples_metadata$sample == unlist(lapply(object@data[[1]],colnames)))\n stopifnot(object@samples_metadata$sample == unlist(lapply(object@expectations$Z,rownames)))\n stopifnot(object@samples_metadata$sample == unlist(lapply(object@expectations$Y,colnames)))\n \n # Remove variance explained estimates \n warning(\"After subsetting the samples the variance explained estimates are not valid anymore, removing them...\")\n object@cache[[\"variance_explained\"]] <- NULL\n \n return(object)\n}\n\n\n#' @title Subset features\n#' @name subset_features\n#' @description Method to subset (or sort) features\n#' @param object a \\code{\\link{MOFA}} object.\n#' @param view character vector with the view name or integer with the view index\n#' @param features character vector with the sample names, numeric vector with the feature indices \n#' or logical vector with the samples to be kept as TRUE.\n#' @return A \\code{\\link{MOFA}} object\n#' @export\n\nsubset_features <- function(object, view, features) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(length(features) <= sapply(object@dimensions[[\"D\"]], sum))\n warning(\"Removing features a posteriori is fine for an exploratory analysis, but we recommend removing them before training!\")\n\n if (is.numeric(view)) view <- views_names(object)[view]\n stopifnot(all(view %in% views_names(object))) \n\n # Define features\n if (is.character(features)) {\n stopifnot(all(features %in% features_names(object)[[view]]))\n } else {\n features <- features_names(object)[[view]][features]\n }\n \n # Subset relevant slots\n if (length(object@expectations)>0) {\n if (\"W\" %in% names(object@expectations) & length(object@expectations$W)>0)\n object@expectations$W <- lapply(object@expectations$W, function(x) x[features,, drop=FALSE])\n if (\"Y\" %in% names(object@expectations) & length(object@expectations$Y)>0)\n object@expectations$Y[[view]] <- lapply(object@expectations$Y[[view]], function(x) x[features,])\n\n if (length(object@data)>0)\n object@data <- lapply(object@data, function(x) sapply(x, function(y) y[features,], simplify = FALSE, USE.NAMES = TRUE))\n\n if (length(object@expectations)>0)\n object@intercepts <- lapply(object@intercepts, function(x) sapply(x, function(y) y[features], simplify = FALSE, USE.NAMES = TRUE))\n\n if (length(object@imputed_data) != 0) {\n stop()\n # object@imputed_data <- lapply(object@imputed_data, function(x) sapply(x, function(y) y[,samples], simplify = FALSE, USE.NAMES = TRUE)) \n }\n }\n # Update dimensionality\n object@dimensions[[\"D\"]][[view]] <- length(features)\n \n # Update features names\n features_names(object)[[view]] <- features\n \n # Remove variance explained estimates \n warning(\"After subsetting the features the variance explained estimates are not valid anymore, removing them...\")\n object@cache[[\"variance_explained\"]] <- NULL\n \n return(object)\n}\n" }, { "path": "R/utils.R", "content": "\n# Function to find \"intercept\" factors\n# .detectInterceptFactors <- function(object, cor_threshold = 0.75) {\n# \n# # Sanity checks\n# if (!is(object, \"MOFAmodel\")) stop(\"'object' has to be an instance of MOFAmodel\")\n# \n# # Fetch data\n# data <- getTrainData(object)\n# factors <- getfactors_names(object)\n# \n# # Correlate the factors with global means per sample\n# r <- lapply(data, function(x) abs(cor(colSums(x,na.rm=T),factors, use=\"pairwise.complete.obs\")))\n# \n# token <- 0\n# for (i in names(r)) {\n# if (any(r[[i]]>cor_threshold)) {\n# token <- 1\n# message(paste0(\"Warning: Factor \",which(r[[i]]>cor_threshold),\" is strongly correlated with the total expression for each sample in \",i))\n# }\n# }\n# if (token==1)\n# message(\"Such (strong) factors usually appear when count-based assays are not properly normalised by library size.\")\n# }\n\n# x: a named vector, where names correspond to sample names\n.add_column_to_metadata <- function(object, x, name) {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(!is.null(names(x)))\n stopifnot(names(x) %in% unlist(samples_names(object)))\n \n # sort vector to match samples names (fill with NA where applicable)\n vec <- rep(NA,sum(get_dimensions(object)[[\"N\"]]))\n names(vec) <- object@samples_metadata$sample\n vec[names(x)] <- x\n \n # add to metadata\n object@samples_metadata[[name]] <- x\n \n return(object) \n}\n\n.infer_likelihoods <- function(object) {\n \n # Gaussian by default\n likelihood <- rep(x=\"gaussian\", times=object@dimensions$M)\n names(likelihood) <- views_names(object)\n \n for (m in views_names(object)) {\n # data <- get_data(object, views=m)[[1]][[1]] # take only first group\n data <- object@data[[m]][[1]]\n \n # bernoulli\n if (length(unique(data[!is.na(data)]))==2) {\n likelihood[m] <- \"bernoulli\"\n # poisson\n } else if (all(data[!is.na(data)]%%1==0)) {\n likelihood[m] <- \"poisson\"\n }\n }\n \n return(likelihood)\n}\n\n# Set view names and group names for nested list objects (e.g. Y)\n.name_views_and_groups <- function(nested_list, view_names, group_names) {\n names(nested_list) <- view_names\n for (view in view_names) { names(nested_list[[view]]) <- group_names }\n nested_list\n}\n\n#' @importFrom stats sd\n.detect_outliers <- function(object, groups = \"all\", factors = \"all\") {\n \n # Sanity checks\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Define groups\n groups <- .check_and_get_groups(object, groups)\n H <- length(groups)\n \n # Define factors\n factors <- .check_and_get_factors(object, factors)\n \n for (k in factors) {\n for (g in groups) {\n \n Z <- get_factors(object, groups=g, factors=k)[[1]][,1]\n Z <- Z[!is.na(Z)]\n \n # warning(\"Outlier detection is independent of the inferred lengthscale currently - might lead to unwanted results\")\n cutoff <- 2.5 * 1.96\n tmp <- abs(Z - mean(Z)) / sd(Z)\n\n outliers <- names(which(tmp>cutoff & abs(Z)>0.5))\n \n if (length(outliers)>0 & length(outliers)<5) {\n object@expectations$Z[[g]][,k][outliers] <- NA\n }\n \n }\n }\n \n # re-compute variance explained\n object@cache[[\"variance_explained\"]] <- calculate_variance_explained(object)\n \n return(object)\n}\n\n\n.flip_factor <- function(model, factor){\n for(g in names(model@expectations$Z)) {\n model@expectations$Z[[g]][,factor] <- - model@expectations$Z[[g]][,factor]\n }\n for(m in names(model@expectations$W)) {\n model@expectations$W[[m]][,factor] <- -model@expectations$W[[m]][,factor]\n }\nreturn(model)\n}\n\n\n.check_and_get_factors <- function(object, factors) {\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(!any(duplicated(factors)))\n if (is.numeric(factors)) {\n stopifnot(all(factors <= object@dimensions$K))\n factors_names(object)[factors] \n } else {\n if (paste0(factors, collapse = \"\") == \"all\") { \n factors_names(object)\n } else {\n stopifnot(all(factors %in% factors_names(object)))\n factors\n }\n }\n \n}\n\n.check_and_get_covariates <- function(object, covariates) {\n if (!.hasSlot(object, \"covariates\") || is.null(object@covariates))\n stop(\"No covariates found in object.\")\n stopifnot(!any(duplicated(covariates)))\n if (is.numeric(covariates)) {\n stopifnot(all(covariates <= object@dimensions$C))\n covariates_names(object)[covariates] \n } else {\n if (paste0(covariates, collapse = \"\") == \"all\") { \n covariates_names(object)\n } else {\n stopifnot(all(covariates %in% covariates_names(object)))\n covariates\n }\n }\n}\n\n.check_and_get_views <- function(object, views, non_gaussian=TRUE) {\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(!any(duplicated(views)))\n if (is.numeric(views)) {\n stopifnot(all(views <= object@dimensions$M))\n views <- views_names(object)[views]\n } else {\n if (paste0(views, sep = \"\", collapse = \"\") == \"all\") { \n views <- views_names(object)\n } else {\n stopifnot(all(views %in% views_names(object)))\n }\n }\n \n # Ignore non-gaussian views \n if (isFALSE(non_gaussian)) {\n non_gaussian_views <- names(which(object@model_options$likelihoods!=\"gaussian\"))\n views <- views[!views%in%non_gaussian_views]\n }\n \n return(views)\n}\n\n\n.check_and_get_groups <- function(object, groups) {\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(!any(duplicated(groups)))\n if (is.numeric(groups)) {\n stopifnot(all(groups <= object@dimensions$G))\n groups_names(object)[groups] \n } else {\n if (paste0(groups, collapse = \"\") == \"all\") { \n groups_names(object)\n } else {\n stopifnot(all(groups %in% groups_names(object)))\n groups\n }\n }\n}\n\n\n.check_and_get_samples <- function(object, samples) {\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(!any(duplicated(samples)))\n if (is.numeric(samples)) {\n stopifnot(all(samples <= sum(object@dimensions$N)))\n unlist(samples_names(object))[samples] \n } else {\n if (paste0(samples, collapse = \"\") == \"all\") { \n unlist(samples_names(object))\n } else {\n stopifnot(all(samples %in% unlist(samples_names(object))))\n samples\n }\n }\n}\n\n.check_and_get_features_from_view <- function(object, view, features) {\n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n stopifnot(!any(duplicated(features)))\n if (is.numeric(features)) {\n stopifnot(all(features <= sum(object@dimensions$D[view])))\n unname(unlist(features_names(object)[[view]])[features])\n } else {\n if (paste0(features, collapse = \"\") == \"all\") { \n unlist(features_names(object)[[view]])\n } else {\n stopifnot(all(features %in% unlist(features_names(object)[[view]])))\n features\n }\n }\n}\n\n.get_top_features_by_loading <- function(object, view, factors, nfeatures = 10) {\n \n if (!is(object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n \n # Collect expectations \n W <- get_weights(object, factors = factors, views = view, as.data.frame=TRUE)\n # Work with absolute values to sort them\n W$value <- abs(W$value)\n\n # Extract relevant features\n W <- W[with(W, order(-abs(value))), ]\n\n return(as.character(head(W$feature, nfeatures)))\n}\n\n\n.get_nodes_types <- function() {\n nodes_types <- list(\n multiview_nodes = c(\"W\", \"AlphaW\", \"ThetaW\"),\n multigroup_nodes = c(\"Z\", \"AlphaZ\", \"ThetaZ\"),\n twodim_nodes = c(\"Y\", \"Tau\"),\n multivariate_singleview_node = \"Sigma\"\n )\n}\n\nsetClass(\"matrix_placeholder\", \n slots=c(rownames = \"ANY\",\n colnames = \"ANY\",\n nrow = \"integer\",\n ncol = \"integer\")\n)\n\nsetMethod(\"rownames\", \"matrix_placeholder\", function(x) { x@rownames })\nsetMethod(\"colnames\", \"matrix_placeholder\", function(x) { x@colnames })\nsetMethod(\"nrow\", \"matrix_placeholder\", function(x) { x@nrow })\nsetMethod(\"ncol\", \"matrix_placeholder\", function(x) { x@ncol })\n\nsetReplaceMethod(\"rownames\", signature(x = \"matrix_placeholder\"),\n function(x, value) { \n x@rownames <- value \n x@nrow <- length(value)\n x \n })\nsetReplaceMethod(\"colnames\", signature(x = \"matrix_placeholder\"),\n function(x, value) { \n x@colnames <- value \n x@ncol <- length(value)\n x \n })\n\n.create_matrix_placeholder <- function(rownames, colnames) {\n mx <- new(\"matrix_placeholder\")\n mx@rownames <- rownames\n mx@colnames <- colnames\n mx@nrow <- length(rownames)\n mx@ncol <- length(colnames)\n mx\n}\n\n\n\n\n# (Hidden) function to define the group\n.set_groupby <- function(object, group_by) {\n \n # Option 0: no group\n if (is.null(group_by)) {\n group_by <- rep(\"1\",sum(object@dimensions[[\"N\"]]))\n \n # Option 1: by default group\n } else if (group_by[1] == \"group\") {\n # group_by = c()\n # for (group in names(samples_names(object))) {\n # group_by <- c(group_by,rep(group,length(samples_names(object)[[group]])))\n # }\n # group_by = factor(group_by, levels=groups_names(object))\n group_by <- samples_metadata(object)$group\n \n # Option 2: by a metadata column in object@samples$metadata\n } else if ((length(group_by) == 1) && (is.character(group_by)|is.factor(group_by)) & (group_by[1] %in% colnames(samples_metadata(object)))) {\n group_by <- samples_metadata(object)[,group_by]\n # if (is.character(group_by)) group_by <- as.factor( group_by )\n \n # Option 3: input is a data.frame with columns (sample,group)\n } else if (is(group_by,\"data.frame\")) {\n stopifnot(all(colnames(group_by) %in% c(\"sample\",\"group\")))\n stopifnot(all(unique(group_by$sample) %in% unlist(samples_names(object))))\n \n # Option 4: group_by is a vector of length N\n } else if (length(group_by) > 1) {\n stopifnot(length(group_by) == sum(object@dimensions[[\"N\"]]))\n \n # Option not recognised\n } else {\n stop(\"'group_by' was specified but it was not recognised, please read the documentation\")\n }\n \n # Create data.frame with columns (sample,group)\n if (!is(group_by,\"data.frame\")) {\n df = data.frame(\n # sample = unlist(samples_names(object)),\n sample = samples_metadata(object)$sample,\n group_by = group_by,\n stringsAsFactors = FALSE\n )\n \n }\n \n return(df)\n}\n\n# (Hidden) function to define the color\n.set_xax <- function(object, xax) {\n \n # Option 1: by a metadata column in object@samples_metadata\n if ((length(xax) == 1) && (is.character(xax)|is.factor(xax)) & (xax[1] %in% colnames(samples_metadata(object)))) {\n xax <- samples_metadata(object)[,xax]\n \n # Option 2: by a feature present in the training data \n } else if ((length(xax) == 1) && is.character(xax) && (xax[1] %in% unlist(features_names(object)))) {\n data <- lapply(get_data(object), function(l) Reduce(cbind, l))\n features <- lapply(data, rownames)\n viewidx <- which(sapply(features, function(x) xax %in% x))\n xax <- data[[viewidx]][xax,]\n \n # Option 5: input is a data.frame with columns (sample, value)\n } else if (is(xax, \"data.frame\")) {\n stopifnot(all(colnames(xax) %in% c(\"sample\", \"value\")))\n stopifnot(all(unique(xax$sample) %in% unlist(samples_names(object))))\n xax <- dplyr::rename(xax, covariate_value = value)\n # Option 6: color_by is a vector of length N\n } else if (length(xax) > 1) {\n stopifnot(length(xax) == sum(get_dimensions(object)$N))\n \n # Option not recognised\n } else {\n stop(\"'xax' was specified but it was not recognised, please read the documentation\")\n }\n \n # Create data.frame with columns (sample,color)\n if (!is(xax,\"data.frame\")) {\n xax = data.frame(\n sample = unlist(samples_names(object)),\n covariate_value = xax,\n stringsAsFactors = FALSE\n )\n }\n return(xax)\n}\n\n# (Hidden) function to define the color\n.set_colorby <- function(object, color_by) {\n \n # Option 0: no color\n if (is.null(color_by)) {\n color_by <- rep(\"1\",sum(object@dimensions[[\"N\"]]))\n \n # Option 1: by default group\n } else if (color_by[1] == \"group\") {\n color_by <- samples_metadata(object)$group\n \n # Option 2: by a metadata column in object@samples$metadata\n } else if ((length(color_by) == 1) && (is.character(color_by)|is.factor(color_by)) && (color_by[1] %in% colnames(samples_metadata(object)))) {\n color_by <- samples_metadata(object)[,color_by]\n # if (is.character(color_by)) color_by <- as.factor( color_by )\n \n # Option 3: by a feature present in the training data \n } else if ((length(color_by) == 1) && is.character(color_by) && (color_by[1] %in% unlist(features_names(object)))) {\n viewidx <- which(sapply(features_names(object), function(x) color_by %in% x))\n foo <- list(color_by); names(foo) <- names(viewidx)\n color_by <- lapply(get_data(object, features = foo), function(l) Reduce(cbind, l))[[1]][1,]\n \n # data <- lapply(get_data(object), function(l) Reduce(cbind, l))\n # features <- lapply(data, rownames)\n # viewidx <- which(sapply(features, function(x) color_by %in% x))\n # color_by <- data[[viewidx]][color_by,]\n \n \n # Option 4: by a factor value in object@expectations$Z\n } else if ((length(color_by) == 1) && is.character(color_by) && (color_by[1] %in% colnames(get_factors(object)[[1]]))) {\n color_by <- do.call(rbind, get_factors(object))[,color_by]\n \n # Option 5: input is a data.frame with columns (sample, color)\n } else if (is(color_by, \"data.frame\")) {\n stopifnot(all(colnames(color_by) %in% c(\"sample\", \"color\")))\n stopifnot(all(unique(color_by$sample) %in% unlist(samples_names(object))))\n \n # Option 6: color_by is a vector of length N\n } else if (length(color_by) > 1) {\n stopifnot(length(color_by) == sum(get_dimensions(object)$N))\n \n # Option not recognised\n } else {\n stop(\"'color_by' was specified but it was not recognised, please read the documentation\")\n }\n \n # Create data.frame with columns (sample,color)\n if (!is(color_by,\"data.frame\")) {\n df <- data.frame(\n # sample = unlist(samples_names(object)),\n sample = samples_metadata(object)$sample,\n color_by = color_by,\n stringsAsFactors = FALSE\n )\n }\n if (length(unique(df$color_by)) < 5) df$color_by <- as.factor(df$color_by)\n \n return(df)\n}\n\n\n# (Hidden) function to define the shape\n.set_shapeby <- function(object, shape_by) {\n \n # Option 0: no color\n if (is.null(shape_by)) {\n shape_by <- rep(\"1\",sum(object@dimensions[[\"N\"]]))\n \n # Option 1: by default group\n } else if (shape_by[1] == \"group\") {\n # shape_by = c()\n # for (group in names(samples_names(object))){\n # shape_by <- c(shape_by,rep(group,length(samples_names(object)[[group]])))\n # }\n shape_by <- samples_metadata(object)$group\n \n \n # Option 2: by a metadata column in object@samples$metadata\n } else if ((length(shape_by) == 1) && is.character(shape_by) & (shape_by %in% colnames(samples_metadata(object)))) {\n shape_by <- samples_metadata(object)[,shape_by]\n \n # Option 3: by a feature present in the training data \n } else if ((length(shape_by) == 1) && is.character(shape_by) && (shape_by[1] %in% unlist(features_names(object)))) {\n # data <- lapply(get_data(object), function(l) Reduce(cbind, l))\n # features <- lapply(data, rownames)\n # viewidx <- which(sapply(features, function(x) shape_by %in% x))\n # shape_by <- data[[viewidx]][shape_by,]\n \n viewidx <- which(sapply(features_names(object), function(x) shape_by %in% x))\n foo <- list(shape_by); names(foo) <- names(viewidx)\n shape_by <- lapply(get_data(object, features = foo), function(l) Reduce(cbind, l))[[1]][1,]\n \n \n # Option 4: input is a data.frame with columns (sample,color)\n } else if (is(shape_by,\"data.frame\")) {\n stopifnot(all(colnames(shape_by) %in% c(\"sample\",\"color\")))\n stopifnot(all(unique(shape_by$sample) %in% unlist(samples_names(object))))\n \n # Option 5: shape_by is a vector of length N\n } else if (length(shape_by) > 1) {\n stopifnot(length(shape_by) == sum(object@dimensions[[\"N\"]]))\n \n # Option not recognised\n } else {\n stop(\"'shape_by' was specified but it was not recognised, please read the documentation\")\n }\n \n # Create data.frame with columns (sample,shape)\n if (!is(shape_by,\"data.frame\")) {\n df = data.frame(\n sample = samples_metadata(object)$sample,\n # sample = unlist(samples_names(object)),\n shape_by = as.factor(shape_by),\n stringsAsFactors = FALSE\n )\n }\n \n return(df)\n}\n\n\n\n.add_legend <- function(p, df, legend, color_name, shape_name) {\n \n # Add legend for color\n if (is.numeric(df$color_by)) {\n p <- p + \n # guides(color=\"none\") +\n scale_fill_gradientn(colors=colorRampPalette(rev(brewer.pal(n=5, name=\"RdYlBu\")))(10)) +\n # scale_fill_gradientn(colours = c('lightgrey', 'blue'))\n labs(fill=color_name)\n \n } else {\n if (length(unique(df$color_by))>1) {\n p <- p +\n guides(fill=guide_legend(override.aes = list(shape=21))) +\n labs(fill=color_name)\n } else {\n p <- p + guides(fill=\"none\", color=\"none\") +\n scale_color_manual(values=\"black\") +\n scale_fill_manual(values=\"gray60\")\n }\n \n }\n \n # Add legend for shape\n if (length(unique(df$shape_by))>1) { \n p <- p + \n scale_shape_manual(values=c(21,23,24,25)[1:length(unique(df$shape_by))]) +\n guides(shape = guide_legend(override.aes = list(fill = \"black\"))) +\n labs(shape=shape_name)\n } else { \n p <- p + \n scale_shape_manual(values=c(21)) +\n guides(shape=\"none\") \n }\n \n # Add legend theme\n if (legend) {\n \n p <- p + \n guides(color=guide_legend(override.aes = list(fill=\"white\"))) +\n theme(\n legend.text = element_text(size=rel(0.8)),\n legend.title = element_text(size=rel(0.8)),\n legend.key = element_rect(fill = \"white\", color=\"white\")\n # legend.background = element_rect(color = NA, fill=NA),\n # legend.box.background = element_blank()\n )\n } else {\n p <- p + theme(legend.position = \"none\")\n }\n \n return(p)\n}\n\n# Function to define the stroke for each dot\n.select_stroke <- function(N) {\n if (N<=1000) { \n stroke <- 0.5 \n } else if (N>1000 & N<=10000) { \n stroke <- 0.2\n } else { \n stroke <- 0.05\n }\n}\n\n# # (Hidden) function to define the shape\n# .set_shapeby_features <- function(object, shape_by, view) {\n# \n# # Option 1: no color\n# if (is.null(shape_by)) {\n# shape_by <- rep(\"1\",sum(object@dimensions[[\"D\"]][view]))\n# \n# # Option 2: input is a data.frame with columns (feature,color)\n# } else if (is(shape_by,\"data.frame\")) {\n# stopifnot(all(colnames(shape_by) %in% c(\"feature\",\"color\")))\n# stopifnot(all(unique(shape_by$feature) %in% features(object)[[view]]))\n# \n# # Option 3: by a feature_metadata column\n# } else if ((length(shape_by)==1) && is.character(shape_by) & (shape_by %in% colnames(features_metadata(object)))) {\n# tmp <- features_metadata(object)\n# shape_by <- tmp[tmp$view==view,shape_by]\n# \n# # Option 4: shape_by is a vector of length D\n# } else if (length(shape_by) > 1) {\n# stopifnot(length(shape_by) == object@dimensions[[\"D\"]][[view]])\n# \n# # Option not recognised\n# } else {\n# stop(\"'shape_by' was specified but it was not recognised, please read the documentation\")\n# }\n# \n# # Create data.frame with columns (feature,shape)\n# if (!is(shape_by,\"data.frame\")) {\n# df = data.frame(\n# feature = features(object)[[view]],\n# shape_by = shape_by,\n# view = view\n# )\n# }\n# \n# return(df)\n# }\n# \n# \n# # (Hidden) function to define the color\n# .set_colorby_features <- function(object, color_by, view) {\n# \n# # Option 1: no color\n# if (is.null(color_by)) {\n# color_by <- rep(\"1\",sum(object@dimensions[[\"D\"]][view]))\n# \n# # Option 2: input is a data.frame with columns (feature,color)\n# } else if (is(color_by,\"data.frame\")) {\n# stopifnot(all(colnames(color_by) %in% c(\"feature\",\"color\")))\n# stopifnot(all(unique(color_by$feature) %in% features(object)[[view]]))\n# \n# # Option 3: by a feature_metadata column\n# } else if ((length(color_by)==1) && is.character(color_by) & (color_by %in% colnames(features_metadata(object)))) {\n# tmp <- features_metadata(object)\n# color_by <- tmp[tmp$view==view,color_by]\n# \n# # Option 4: color_by is a vector of length D\n# } else if (length(color_by) > 1) {\n# stopifnot(length(color_by) == object@dimensions[[\"D\"]][[view]])\n# \n# # Option not recognised\n# } else {\n# stop(\"'color_by' was specified but it was not recognised, please read the documentation\")\n# }\n# \n# # Create data.frame with columns (feature,color)\n# if (!is(color_by,\"data.frame\")) {\n# df = data.frame(\n# feature = features(object)[[view]],\n# color_by = color_by,\n# view = view\n# )\n# }\n# \n# return(df)\n# }\n\n\n\n#' @title Function to add the MOFA representation onto a Seurat object\n#' @name add_mofa_factors_to_seurat\n#' @description Function to add the MOFA latent representation to a Seurat object\n#' @param mofa_object a trained \\code{\\link{MOFA}} object.\n#' @param seurat_object a Seurat object\n#' @param views character vector with the view names, or numeric vector with view indexes. Default is 'all'\n#' @param factors character vector with the factor names, or numeric vector with the factor indexes. Default is 'all'\n#' @details This function calls the \\code{CreateDimReducObject} function from Seurat to store the MOFA factors.\n#' @return Returns a Seurat object with the 'reductions' slot filled with the MOFA factors. Also adds, if calculated, the UMAP/TSNE obtained with the MOFA factors.\n#' @export\n#' @examples\n#' # Generate a simulated data set\n#' MOFAexample <- make_example_data()\nadd_mofa_factors_to_seurat <- function(mofa_object, seurat_object, views = \"all\", factors = \"all\") {\n \n # Sanity checks\n if (!is(mofa_object, \"MOFA\")) stop(\"'object' has to be an instance of MOFA\")\n if (!requireNamespace(\"Seurat\", quietly = TRUE)) {\n stop(\"Package \\\"Seurat\\\" is required but is not installed.\", call. = FALSE)\n }\n if (!all(colnames(seurat_object)==unlist(samples_names(mofa_object)))) {\n stop(\"Samples do not match between the MOFA object and the Seurat object\")\n }\n \n # Get factors\n factors <- .check_and_get_factors(mofa_object, factors)\n Z <- get_factors(mofa_object, factors=factors)\n Z <- do.call(\"rbind\",Z)\n \n # Get weights (currently not exported)\n views <- .check_and_get_views(mofa_object, views=views)\n W <- get_weights(mofa_object, views=views, factors=factors)\n \n # Collect MOFA options\n mofa_options <- list(\n \"data_options\" = mofa_object@data_options,\n \"model_options\" = mofa_object@model_options,\n \"training_options\" = mofa_object@training_options,\n \"dimensions\" = mofa_object@dimensions\n )\n \n # Sanity checks\n stopifnot(rownames(Z) %in% colnames(seurat_object))\n stopifnot(views_names(mofa_object) %in% names(seurat_object@assays))\n \n # Add to seurat\n # Add \"MOFA\" with no view-specific weights to the default assay \n message(\"(1) Adding the MOFA factors to the 'reductions' slot of the default Seurat assay with the 'MOFA' key (no feature weights/loadings provided)...\")\n seurat_object@reductions[[\"MOFA\"]] <- CreateDimReducObject(\n embeddings = Z, \n key = \"MOFA_\", \n misc = mofa_options\n )\n \n # Add a view-specific \"MOFA_\" that includes the weights\n # message(\"(2) Adding the MOFA representation to the 'reductions' slot of each assay, including the feature weights/loadings...\")\n # for (m in views_names(mofa_object)) {\n # seurat_object@reductions[[sprintf(\"MOFA%s_\",m)]] <- CreateDimReducObject(\n # embeddings = Z, \n # loadings = W[[m]], \n # assay = m,\n # key = sprintf(\"MOFA%s_\",m), \n # misc = mofa_options\n # )\n # }\n \n if (length(mofa_object@dim_red)>0) {\n if (\"UMAP\" %in% names(mofa_object@dim_red)) {\n message(\"(2) Adding the UMAP representation obtained with the MOFA factors to the 'reductions' slot of the default Seurat assay using the key 'MOFAUMAP'...\")\n df <- mofa_object@dim_red$UMAP; mtx <- as.matrix(df[,-1]); rownames(mtx) <- df$sample\n colnames(df) <- paste0(\"MOFA_UMAP\",1:ncol(df))\n seurat_object@reductions[[\"MOFAUMAP\"]] <- CreateDimReducObject(embeddings = mtx, key = \"MOFAUMAP_\")\n }\n if (\"TSNE\" %in% names(mofa_object@dim_red)) {\n message(\"(2) Adding the UMAP representation obtained with the MOFA factors to the 'reductions' slot of the default Seurat assay using the key 'MOFATSNE'...\")\n df <- mofa_object@dim_red$UMAP; mtx <- as.matrix(df[,-1]); rownames(mtx) <- df$sample\n seurat_object@reductions[[\"MOFATSNE\"]] <- CreateDimReducObject(embeddings = mtx, key = \"MOFATSNE_\")\n }\n }\n \n return(seurat_object)\n}\n" }, { "path": "README.md", "content": "\n# Multi-Omics Factor Analysis\n\nMOFA is a factor analysis model that provides a general framework for the integration of multi-omic data sets in an unsupervised fashion. \n\nPlease [visit our website](https://biofam.github.io/MOFA2/) for installation instructions, tutorials, and much more!" }, { "path": "configure", "content": "#!/bin/sh\n\n${R_HOME}/bin/Rscript -e \"basilisk::configureBasiliskEnv()\"" }, { "path": "configure.win", "content": "#!/bin/sh\n\n${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe -e \"basilisk::configureBasiliskEnv()\"" }, { "path": "inst/CITATION", "content": "citEntry(entry=\"article\",\n title = \"Multi‐Omics Factor Analysis—a framework for unsupervised integration of multi‐omics data sets\",\n author = personList( as.person(\"Ricard Argelaguet\"),\n as.person(\"Britta Velten\"),\n as.person(\"Damien Arnol\"),\n as.person(\"Sascha Dietrich\"),\n as.person(\"Thorsten Zenz\"),\n as.person(\"John C Marioni\"),\n as.person(\"Florian Buettner\"),\n as.person(\"Wolfgang Huber\"),\n as.person(\"Oliver Stegle\")),\n year = 2018,\n journal = \"Molecular Systems Biology\",\n doi = \"10.15252/msb.20178124\",\n volume = 14,\n textVersion = \n paste(\"Argelaguet, Velten, Arnol, Dietrich, Zenz, Marioni, Buettner, Huber and Stegle:\", \n \"Multi‐Omics Factor Analysis — a framework for unsupervised integration of multi‐omics data sets.\",\n \"Mol Syst Biol (2018)14:e8124\"))\n\n\ncitEntry(entry=\"article\",\n title = \"MOFA+: a statistical framework for comprehensive integration of multi-modal single-cell data.\",\n author = personList( as.person(\"Ricard Argelaguet\"),\n as.person(\"Damien Arnol\"),\n as.person(\"Danila Bredikhin\"),\n as.person(\"Yonatan Deloro\"),\n as.person(\"Britta Velten\"),\n as.person(\"John C Marioni\"),\n as.person(\"Oliver Stegle\")),\n year = 2020,\n journal = \"Genome Biology\",\n doi = \"10.1186/s13059-020-02015-1\",\n volume = 21,\n textVersion = \n paste(\"Argelaguet, Arnol, Bredikhin, Deloro, Velten, Marioni,and Stegle:\", \n \"MOFA+: a statistical framework for comprehensive integration of multi-modal single-cell data\",\n \"Genome Biology, 21(1), 1-17\"))\n\n\ncitEntry(entry=\"article\",\n title = \"Identifying temporal and spatial patterns of variation from multi-modal data using MEFISTO.\",\n author = personList( as.person(\"Britta Velten\"),\n as.person(\"Jana M. Braunger\"),\n as.person(\"Damien Arnol\"),\n as.person(\"Ricard Argelaguet\"),\n as.person(\"Oliver Stegle\")),\n year = 2020,\n journal = \"bioRxiv\",\n doi = \"10.1101/2020.11.03.366674\",\n textVersion = \n paste(\"Velten, Braunger, Arnol, Argelaguet and Stegle:\", \n \"Identifying temporal and spatial patterns of variation from multi-modal data using MEFISTO\",\n \"bioRxiv 2020\"))\n" }, { "path": "inst/scripts/template_script.R", "content": "library(MOFA2)\nlibrary(data.table)\n\n# (Optional) set up reticulate connection with Python\n# library(reticulate)\n# reticulate::use_python(\"/Users/ricard/anaconda3/envs/base_new/bin/python\", required = T)\n\n###############\n## Load data ##\n###############\n\n# Multiple formats are allowed for the input data:\n\n## -- Option 1 -- ##\n# nested list of matrices, where the first index refers to the view and the second index refers to the group.\n# samples are stored in the rows and features are stored in the columns.\n# Missing values must be filled with NAs, including samples missing an entire view\n\n# (...)\n\n## -- Option 2 -- ##\n# data.frame with columns [\"sample\",\"feature\",\"view\",\"group\",\"value\"]\n# In this case there is no need to have missing values in the data.frame,\n# they will be automatically filled in when creating the corresponding matrices\n\nfile = \"ftp://ftp.ebi.ac.uk/pub/databases/mofa/getting_started/data.txt.gz\"\ndata = fread(file)\n\n#######################\n# Create MOFA object ##\n#######################\n\nMOFAobject <- create_mofa(data)\n\n# Visualise data structure\nplot_data_overview(MOFAobject)\n\n####################\n## Define options ##\n####################\n\n# Data options\n# - scale_views: if views have very different ranges/variances, it is good practice to scale each view to unit variance (default is FALSE)\ndata_opts <- get_default_data_options(MOFAobject)\n\n\n# Model options\n# - likelihoods: likelihood per view (options are \"gaussian\",\"poisson\",\"bernoulli\"). \"gaussian\" is used by default\n# - num_factors: number of factors. By default K=10\nmodel_opts <- get_default_model_options(MOFAobject)\nmodel_opts$num_factors <- 10\n\n# Training options\n# - maxiter: number of iterations\n# - convergence_mode: \"fast\", \"medium\", \"slow\". For exploration, the fast mode is good enough.\n# - drop_factor_threshold: minimum variance explained criteria to drop factors while training. Default is -1 (no dropping of factors)\n# - gpu_mode: use GPU mode? This needs cupy installed and a functional GPU, see https://biofam.github.io/MOFA2/gpu_training.html\n# - seed: random seed\ntrain_opts <- get_default_training_options(MOFAobject)\ntrain_opts$convergence_mode <- \"medium\"\ntrain_opts$seed <- 42\n\n#########################\n## Prepare MOFA object ##\n#########################\n\nMOFAobject <- prepare_mofa(MOFAobject,\n data_options = data_opts,\n model_options = model_opts,\n training_options = train_opts\n)\n\n#####################\n## Train the model ##\n#####################\n\nMOFAobject <- run_mofa(MOFAobject)\n\n####################\n## Save the model ##\n####################\n\noutfile <- paste0(getwd(),\"/model.hdf5\")\nsaveRDS(MOFAobject, outfile)\n" }, { "path": "inst/scripts/template_script.py", "content": "\n######################################################\n## Template script to train a MOFA+ model in Python ##\n######################################################\n\nfrom mofapy2.run.entry_point import entry_point\nimport pandas as pd\nimport io\nimport requests # to download the online data\n\n###############\n## Load data ##\n###############\n\n# Two formats are allowed for the input data:\n\n# Option 1: a nested list of matrices, where the first index refers to the view and the second index refers to the group.\n# samples are stored in the rows and features are stored in the columns.\n# \t\t\tMissing values must be filled with NAs, including samples missing an entire view\n\n# datadir = \"/Users/ricard/data/mofaplus/test\"\n# views = [\"0\",\"1\"]\n# groups = [\"0\",\"1\"]\n# data = [None]*len(views)\n# for m in range(len(views)):\n# data[m] = [None]*len(groups)\n# for g in range(len(groups)):\n# datafile = \"%s/%s_%s.txt.gz\" % (datadir, views[m], groups[g])\n# data[m][g] = pd.read_csv(datafile, header=None, sep=' ')\n\n# Option 2: a data.frame with columns [\"sample\",\"feature\",\"view\",\"group\",\"value\"]\n# In this case there is no need to have missing values in the data.frame,\n# they will be automatically filled in when creating the corresponding matrices\n\nfile = \"ftp://ftp.ebi.ac.uk/pub/databases/mofa/getting_started/data.txt.gz\"\ndata = pd.read_csv(file, sep=\"\\t\")\n\n###########################\n## Initialise MOFA model ##\n###########################\n\n\n## (1) initialise the entry point\nent = entry_point()\n\n\n## (2) Set data options\n# - scale_views: if views have very different ranges, one can to scale each view to unit variance\nent.set_data_options(\n\tscale_views = False\n)\n\n# (3) Set data using the long data frame format\nent.set_data_df(data)\n\n## (3) Set data using the nested list of matrices format ##\n# views_names = [\"view1\",\"view2\"]\n# groups_names = [\"groupA\",\"groupB\"]\n\n# samples_names nested list with length NGROUPS. Each entry g is a list with the sample names for the g-th group\n# - if not provided, MOFA will fill it with default samples names\n# samples_names = (...)\n\n# features_names nested list with length NVIEWS. Each entry m is a list with the features names for the m-th view\n# - if not provided, MOFA will fill it with default features names\n# features_names = (...)\n\n# ent.set_data_matrix(data, \n# \tviews_names = views_names, \n# \tgroups_names = groups_names, \n# \tsamples_names = samples_names, \n# \tfeatures_names = features_names\n# )\n\n\n## (4) Set model options\n# - factors: number of factors. Default is 15\n# - likelihods: likelihoods per view (options are \"gaussian\",\"poisson\",\"bernoulli\"). Default and recommended is \"gaussian\"\n# - spikeslab_weights: use spike-slab sparsity prior in the weights? (recommended TRUE)\n# - ard_weights: use automatic relevance determination prior in the weights? (TRUE if using multiple views)\n\n# using default values\nent.set_model_options()\n\n# using personalised values\nent.set_model_options(\n\tfactors = 5, \n\tspikeslab_weights = True, \n\tard_weights = True\n)\n\n## (5) Set training options ##\n# - iter: number of iterations\n# - convergence_mode: \"fast\", \"medium\", \"slow\". Fast mode is usually good enough.\n# - dropR2: minimum variance explained criteria to drop factors while training. Default is None, inactive factors are not dropped during training\n# - gpu_mode: use GPU mode? this functionality needs cupy installed and a functional GPU, see https://biofam.github.io/MOFA2/gpu_training.html\n# - seed: random seed\n\n# using default values\nent.set_train_options()\n\n# using personalised values\nent.set_train_options(\n\titer = 100, \n\tconvergence_mode = \"fast\", \n\tdropR2 = None, \n\tgpu_mode = False, \n\tseed = 42\n)\n\n####################################\n## Build and train the MOFA model ##\n####################################\n\n# Build the model \nent.build()\n\n# Run the model\nent.run()\n\n####################\n## Save the model ##\n####################\n\noutfile = \"/Users/ricard/data/mofaplus/hdf5/test.hdf5\"\n\n# - save_data: logical indicating whether to save the training data in the hdf5 file.\n# this is useful for some downstream analysis in R, but it can take a lot of disk space.\nent.save(outfile, save_data=True)\n\n#########################\n## Downstream analysis ##\n#########################\n\n# Check the mofax package for the downstream analysis in Python: https://github.com/bioFAM/mofax\n# Check the MOFA2 R package for the downstream analysis in R: https://www.bioconductor.org/packages/release/bioc/html/MOFA2.html\n# All tutorials: https://biofam.github.io/MOFA2/tutorials.html\n\n# Extract factor values (a list with one matrix per sample group)\nfactors = ent.model.nodes[\"Z\"].getExpectation()\n\n# Extract weights (a list with one matrix per view)\nweights = ent.model.nodes[\"W\"].getExpectation()\n\n# Extract variance explained values\nr2 = ent.model.calculate_variance_explained()\n\n# Interact directly with the hdf5 file\nimport h5py\nf = h5py.File(outfile, 'r')\nf.keys()\n\n# Extract factors\nf[\"expectations\"][\"Z\"][\"group_0\"].value\nf[\"expectations\"][\"Z\"][\"group_1\"].value\n\n# Extract weights\nf[\"expectations\"][\"W\"][\"view_0\"].value\nf[\"expectations\"][\"W\"][\"view_1\"].value\n\n# Extract variance explained estimates\nf[\"variance_explained\"][\"r2_per_factor\"]\nf[\"variance_explained\"][\"r2_total\"]\n" }, { "path": "inst/scripts/template_script_dataframe.py", "content": "\n######################################################\n## Template script to train a MOFA+ model in Python ##\n######################################################\n\nfrom mofapy2.run.entry_point import entry_point\nimport pandas as pd\nimport io\nimport requests # to download the online data\n\n###############\n## Load data ##\n###############\n\n# The input needs to be a data.frame with columns [\"sample\",\"feature\",\"view\",\"group\",\"value\"]\n# In this case there is no need to have missing values in the data.frame, they will be automatically filled in when creating the corresponding matrices\nfile = \"ftp://ftp.ebi.ac.uk/pub/databases/mofa/getting_started/data.txt.gz\"\ndata = pd.read_csv(file, sep=\"\\t\")\n\n###########################\n## Initialise MOFA model ##\n###########################\n\n\n## (1) initialise the entry point\nent = entry_point()\n\n\n## (2) Set data options\n# - scale_views: if views have very different ranges, one can to scale each view to unit variance\nent.set_data_options(\n\tscale_views = False\n)\n\n# (3) Set data using the data frame format\nent.set_data_df(data)\n\n# using default values\nent.set_model_options()\n\n# using personalised values\nent.set_model_options(\n\tfactors = 5, \n\tspikeslab_weights = True, \n\tard_weights = True\n)\n\n## (5) Set training options ##\n# - iter: number of iterations\n# - convergence_mode: \"fast\", \"medium\", \"slow\". Fast mode is usually good enough.\n# - dropR2: minimum variance explained criteria to drop factors while training. Default is None, inactive factors are not dropped during training\n# - gpu_mode: use GPU mode? this functionality needs cupy installed and a functional GPU, see https://biofam.github.io/MOFA2/gpu_training.html\n# - seed: random seed\n\n# using default values\nent.set_train_options()\n\n# using personalised values\nent.set_train_options(\n\titer = 100, \n\tconvergence_mode = \"fast\", \n\tdropR2 = None, \n\tgpu_mode = False, \n\tseed = 42\n)\n\n####################################\n## Build and train the MOFA model ##\n####################################\n\n# Build the model \nent.build()\n\n# Run the model\nent.run()\n\n####################\n## Save the model ##\n####################\n\noutfile = \"/Users/ricard/data/mofaplus/hdf5/test.hdf5\"\n\n# - save_data: logical indicating whether to save the training data in the hdf5 file.\n# this is useful for some downstream analysis in R, but it can take a lot of disk space.\nent.save(outfile, save_data=True)\n\n#########################\n## Downstream analysis ##\n#########################\n\n# Check the mofax package for the downstream analysis in Python: https://github.com/bioFAM/mofax\n# Check the MOFA2 R package for the downstream analysis in R: https://www.bioconductor.org/packages/release/bioc/html/MOFA2.html\n# All tutorials: https://biofam.github.io/MOFA2/tutorials.html\n\n# Extract factor values (a list with one matrix per sample group)\nfactors = ent.model.nodes[\"Z\"].getExpectation()\n\n# Extract weights (a list with one matrix per view)\nweights = ent.model.nodes[\"W\"].getExpectation()\n\n# Extract variance explained values\nr2 = ent.model.calculate_variance_explained()\n\n# Interact directly with the hdf5 file\nimport h5py\nf = h5py.File(outfile, 'r')\nf.keys()\n\n# Extract factors\nf[\"expectations\"][\"Z\"][\"group_0\"].value\nf[\"expectations\"][\"Z\"][\"group_1\"].value\n\n# Extract weights\nf[\"expectations\"][\"W\"][\"view_0\"].value\nf[\"expectations\"][\"W\"][\"view_1\"].value\n\n# Extract variance explained estimates\nf[\"variance_explained\"][\"r2_per_factor\"]\nf[\"variance_explained\"][\"r2_total\"]\n" }, { "path": "inst/scripts/template_script_matrix.py", "content": "\n######################################################\n## Template script to train a MOFA+ model in Python ##\n######################################################\n\nfrom mofapy2.run.entry_point import entry_point\nimport pandas as pd\nimport io\nimport requests # to download the online data\n\n###############\n## Load data ##\n###############\n\n# The data format is a nested list of matrices, where the first index refers to the view and the second index refers to the group.\n# samples are stored in the rows and features are stored in the columns.\n# Missing values must be explicitly filled using NAs, including samples missing an entire view\n\ndatadir = \"/Users/ricard/data/mofaplus/test\"\nviews = [\"0\",\"1\"]\ngroups = [\"0\",\"1\"]\ndata = [None]*len(views)\nfor m in range(len(views)):\n data[m] = [None]*len(groups)\n for g in range(len(groups)):\n datafile = \"%s/%s_%s.txt.gz\" % (datadir, views[m], groups[g])\n data[m][g] = pd.read_csv(datafile, header=None, sep=' ')\n\n###########################\n## Initialise MOFA model ##\n###########################\n\n## (1) initialise the entry point\nent = entry_point()\n\n\n## (2) Set data options\n# - scale_views: if views have very different ranges, one can to scale each view to unit variance\nent.set_data_options(\n\tscale_views = False\n)\n\n\n## (3) Define names\nviews_names = [\"view1\",\"view2\"]\n# groups_names = [\"groupA\",\"groupB\"]\n\n# samples_names nested list with length n_groups. Each entry g is a list with the sample names for the g-th group\n# - if not provided, MOFA will fill it with default samples names\nsamples_names = (...)\n\n# features_names nested list with length NVIEWS. Each entry m is a list with the features names for the m-th view\n# - if not provided, MOFA will fill it with default features names\nfeatures_names = (...)\n\n\n## (4) Set data matrix\nent.set_data_matrix(data, \n\tviews_names = views_names, \n\tgroups_names = groups_names, \n\tsamples_names = samples_names, \n\tfeatures_names = features_names\n)\n\n\n## (5) Set model options\n# - factors: number of factors. Default is 15\n# - likelihods: likelihoods per view (options are \"gaussian\",\"poisson\",\"bernoulli\"). Default and recommended is \"gaussian\"\n# - spikeslab_weights: use spike-slab sparsity prior in the weights? (recommended TRUE)\n# - ard_weights: use automatic relevance determination prior in the weights? (TRUE if using multiple views)\n\n# using default values\nent.set_model_options()\n\n# using personalised values\nent.set_model_options(\n\tfactors = 5, \n\tspikeslab_weights = True, \n\tard_weights = True\n)\n\n## (5) Set training options ##\n# - iter: number of iterations\n# - convergence_mode: \"fast\", \"medium\", \"slow\". Fast mode is usually good enough.\n# - dropR2: minimum variance explained criteria to drop factors while training. Default is None, inactive factors are not dropped during training\n# - gpu_mode: use GPU mode? this functionality needs cupy installed and a functional GPU, see https://biofam.github.io/MOFA2/gpu_training.html\n# - seed: random seed\n\n# using default values\nent.set_train_options()\n\n# using personalised values\nent.set_train_options(\n\titer = 100, \n\tconvergence_mode = \"fast\", \n\tdropR2 = None, \n\tgpu_mode = False, \n\tseed = 42\n)\n\n####################################\n## Build and train the MOFA model ##\n####################################\n\n# Build the model \nent.build()\n\n# Run the model\nent.run()\n\n####################\n## Save the model ##\n####################\n\noutfile = \"/Users/ricard/data/mofaplus/hdf5/test.hdf5\"\n\n# - save_data: logical indicating whether to save the training data in the hdf5 file.\n# this is useful for some downstream analysis in R, but it can take a lot of disk space.\nent.save(outfile, save_data=True)\n\n#########################\n## Downstream analysis ##\n#########################\n\n# Check the mofax package for the downstream analysis in Python: https://github.com/bioFAM/mofax\n# Check the MOFA2 R package for the downstream analysis in R: https://www.bioconductor.org/packages/release/bioc/html/MOFA2.html\n# All tutorials: https://biofam.github.io/MOFA2/tutorials.html\n\n# Extract factor values (a list with one matrix per sample group)\nfactors = ent.model.nodes[\"Z\"].getExpectation()\n\n# Extract weights (a list with one matrix per view)\nweights = ent.model.nodes[\"W\"].getExpectation()\n\n# Extract variance explained values\nr2 = ent.model.calculate_variance_explained()\n\n# Interact directly with the hdf5 file\nimport h5py\nf = h5py.File(outfile, 'r')\nf.keys()\n\n# Extract factors\nf[\"expectations\"][\"Z\"][\"group_0\"].value\nf[\"expectations\"][\"Z\"][\"group_1\"].value\n\n# Extract weights\nf[\"expectations\"][\"W\"][\"view_0\"].value\nf[\"expectations\"][\"W\"][\"view_1\"].value\n\n# Extract variance explained estimates\nf[\"variance_explained\"][\"r2_per_factor\"]\nf[\"variance_explained\"][\"r2_total\"]\n" }, { "path": "man/.Rapp.history", "content": "" }, { "path": "man/MOFA.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllClasses.R\n\\docType{class}\n\\name{MOFA}\n\\alias{MOFA}\n\\alias{MOFA-class}\n\\title{Class to store a mofa model}\n\\description{\nThe \\code{MOFA} is an S4 class used to store all relevant data to analyse a MOFA model\n}\n\\section{Slots}{\n\n\\describe{\n\\item{\\code{data}}{The input data}\n\n\\item{\\code{intercepts}}{Feature intercepts}\n\n\\item{\\code{samples_metadata}}{Samples metadata}\n\n\\item{\\code{features_metadata}}{Features metadata.}\n\n\\item{\\code{imputed_data}}{The imputed data.}\n\n\\item{\\code{expectations}}{expected values of the factors and the loadings.}\n\n\\item{\\code{dim_red}}{non-linear dimensionality reduction manifolds.}\n\n\\item{\\code{training_stats}}{model training statistics.}\n\n\\item{\\code{data_options}}{Data processing options.}\n\n\\item{\\code{training_options}}{Model training options.}\n\n\\item{\\code{stochastic_options}}{Stochastic variational inference options.}\n\n\\item{\\code{model_options}}{Model options.}\n\n\\item{\\code{mefisto_options}}{Options for the use of MEFISO}\n\n\\item{\\code{dimensions}}{Dimensionalities of the model: \nM for the number of views, \nG for the number of groups,\nN for the number of samples (per group),\nC for the number of covariates per sample,\nD for the number of features (per view),\nK for the number of factors.}\n\n\\item{\\code{on_disk}}{Logical indicating whether data is loaded from disk.}\n\n\\item{\\code{cache}}{Cache.}\n\n\\item{\\code{status}}{Auxiliary variable indicating whether the model has been trained.}\n\n\\item{\\code{covariates}}{optional slot to store sample covariate for training in MEFISTO}\n\n\\item{\\code{covariates_warped}}{optional slot to store warped sample covariate for training in MEFISTO}\n\n\\item{\\code{interpolated_Z}}{optional slot to store interpolated factor values (used only with MEFISTO)}\n}}\n\n" }, { "path": "man/add_mofa_factors_to_seurat.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/utils.R\n\\name{add_mofa_factors_to_seurat}\n\\alias{add_mofa_factors_to_seurat}\n\\title{Function to add the MOFA representation onto a Seurat object}\n\\usage{\nadd_mofa_factors_to_seurat(\n mofa_object,\n seurat_object,\n views = \"all\",\n factors = \"all\"\n)\n}\n\\arguments{\n\\item{mofa_object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{seurat_object}{a Seurat object}\n\n\\item{views}{character vector with the view names, or numeric vector with view indexes. Default is 'all'}\n\n\\item{factors}{character vector with the factor names, or numeric vector with the factor indexes. Default is 'all'}\n}\n\\value{\nReturns a Seurat object with the 'reductions' slot filled with the MOFA factors. Also adds, if calculated, the UMAP/TSNE obtained with the MOFA factors.\n}\n\\description{\nFunction to add the MOFA latent representation to a Seurat object\n}\n\\details{\nThis function calls the \\code{CreateDimReducObject} function from Seurat to store the MOFA factors.\n}\n\\examples{\n# Generate a simulated data set\nMOFAexample <- make_example_data()\n}\n" }, { "path": "man/calculate_contribution_scores.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/contribution_scores.R\n\\name{calculate_contribution_scores}\n\\alias{calculate_contribution_scores}\n\\title{Calculate contribution scores for each view in each sample}\n\\usage{\ncalculate_contribution_scores(\n object,\n views = \"all\",\n groups = \"all\",\n factors = \"all\",\n scale = TRUE\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{views}{character vector with the view names, or numeric vector with view indexes. Default is 'all'}\n\n\\item{groups}{character vector with the group names, or numeric vector with group indexes. Default is 'all'}\n\n\\item{factors}{character vector with the factor names, or numeric vector with the factor indexes. Default is 'all'}\n\n\\item{scale}{logical indicating whether to scale the sample-wise variance explained values by the total amount of variance explained per view. \nThis effectively normalises each view by its total variance explained. It is important when different amounts of variance is explained for each view (check with \\code{plot_variance_explained(..., plot_total=TRUE)})}\n}\n\\value{\nadds the contribution scores to the metadata slot (\\code{samples_metadata(MOFAobject)}) and to the \\code{MOFAobject@cache} slot\n}\n\\description{\nThis function calculates, *for each sample* how much each view contributes to its location in the latent manifold, what we call \\emph{contribution scores}\n}\n\\details{\nContribution scores are calculated in three steps:\n\\itemize{\n \\item{\\strong{Step 1}: calculate variance explained for each cell i and each view m (\\eqn{R_{im}}), using all factors}\n \\item{\\strong{Step 2} (optional): scale values by the total variance explained for each view}\n \\item{\\strong{Step 3}: calculate contribution score (\\eqn{C_{im}}) for cell i and view m as: \\deqn{C_{im} = \\frac{R2_{im}}{\\sum_{m} R2_{im}} } }\n}\nNote that contribution scores can be calculated using any number of data modalities, but it is easier to interpret when you specify two. \\cr\nPlease note that this functionality is still experimental, contact the authors if you have questions.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nmodel <- calculate_contribution_scores(model)\n\n}\n" }, { "path": "man/calculate_variance_explained.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/calculate_variance_explained.R\n\\name{calculate_variance_explained}\n\\alias{calculate_variance_explained}\n\\title{Calculate variance explained by the model}\n\\usage{\ncalculate_variance_explained(\n object,\n views = \"all\",\n groups = \"all\",\n factors = \"all\"\n)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{views}{character vector with the view names, or numeric vector with view indexes. Default is 'all'}\n\n\\item{groups}{character vector with the group names, or numeric vector with group indexes. Default is 'all'}\n\n\\item{factors}{character vector with the factor names, or numeric vector with the factor indexes. Default is 'all'}\n}\n\\value{\na list with matrices with the amount of variation explained per factor and view.\n}\n\\description{\nThis function takes a trained MOFA model as input and calculates the proportion of variance explained \n(i.e. the coefficient of determinations (R^2)) by the MOFA factors across the different views.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Calculate variance explained (R2)\nr2 <- calculate_variance_explained(model)\n\n# Plot variance explained values (view as x-axis, and factor as y-axis)\nplot_variance_explained(model, x=\"view\", y=\"factor\")\n\n# Plot variance explained values (view as x-axis, and group as y-axis)\nplot_variance_explained(model, x=\"view\", y=\"group\")\n\n# Plot variance explained values for factors 1 to 3\nplot_variance_explained(model, x=\"view\", y=\"group\", factors=1:3)\n\n# Scale R2 values\nplot_variance_explained(model, max_r2 = 0.25)\n}\n" }, { "path": "man/calculate_variance_explained_per_sample.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/calculate_variance_explained.R\n\\name{calculate_variance_explained_per_sample}\n\\alias{calculate_variance_explained_per_sample}\n\\title{Calculate variance explained by the MOFA factors for each sample}\n\\usage{\ncalculate_variance_explained_per_sample(\n object,\n views = \"all\",\n groups = \"all\",\n factors = \"all\"\n)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{views}{character vector with the view names, or numeric vector with view indexes. Default is 'all'}\n\n\\item{groups}{character vector with the group names, or numeric vector with group indexes. Default is 'all'}\n\n\\item{factors}{character vector with the factor names, or numeric vector with the factor indexes. Default is 'all'}\n}\n\\value{\na list with matrices with the amount of variation explained per sample and view.\n}\n\\description{\nThis function takes a trained MOFA model as input and calculates, **for each sample** the proportion of variance explained \n(i.e. the coefficient of determinations (R^2)) by the MOFA factors across the different views.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Calculate variance explained (R2)\nr2 <- calculate_variance_explained_per_sample(model)\n\n}\n" }, { "path": "man/cluster_samples.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/cluster_samples.R\n\\name{cluster_samples}\n\\alias{cluster_samples}\n\\title{K-means clustering on samples based on latent factors}\n\\usage{\ncluster_samples(object, k, factors = \"all\", ...)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{k}{number of clusters (integer).}\n\n\\item{factors}{character vector with the factor name(s), or numeric vector with the index of the factor(s) to use. \nDefault is 'all'}\n\n\\item{...}{extra arguments passed to \\code{\\link{kmeans}}}\n}\n\\value{\noutput from \\code{\\link{kmeans}} function\n}\n\\description{\nMOFA factors are continuous in nature but they can be used to predict discrete clusters of samples. \\cr\nThe clustering can be performed in a single factor, which is equivalent to setting a manual threshold.\nMore interestingly, it can be done using multiple factors, where multiple sources of variation are aggregated. \\cr\nImportantly, this type of clustering is not weighted and does not take into account the different importance of the latent factors.\n}\n\\details{\nIn some cases, due to model technicalities, samples can have missing values in the latent factor space. \nIn such a case, these samples are currently ignored in the clustering procedure.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Cluster samples in the factor space using factors 1 to 3 and K=2 clusters \nclusters <- cluster_samples(model, k=2, factors=1:3)\n}\n" }, { "path": "man/compare_elbo.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/compare_models.R\n\\name{compare_elbo}\n\\alias{compare_elbo}\n\\title{Compare different trained \\code{\\link{MOFA}} objects in terms of the final value of the ELBO statistics and number of inferred factors}\n\\usage{\ncompare_elbo(models, log = FALSE, return_data = FALSE)\n}\n\\arguments{\n\\item{models}{a list containing \\code{\\link{MOFA}} objects.}\n\n\\item{log}{logical indicating whether to plot the log of the ELBO.}\n\n\\item{return_data}{logical indicating whether to return a data.frame with the ELBO values per model}\n}\n\\value{\nA \\code{\\link{ggplot}} object or the underlying data.frame if return_data is TRUE\n}\n\\description{\nDifferent objects of \\code{\\link{MOFA}} are compared in terms of the final value of the ELBO statistics.\nFor model selection the model with the highest ELBO value is selected.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel1 <- load_model(file)\nmodel2 <- load_model(file)\n\n# Compare ELBO between models\n\\dontrun{compare_elbo(list(model1,model2))}\n}\n" }, { "path": "man/compare_factors.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/compare_models.R\n\\name{compare_factors}\n\\alias{compare_factors}\n\\title{Plot the correlation of factors between different models}\n\\usage{\ncompare_factors(models, ...)\n}\n\\arguments{\n\\item{models}{a list with \\code{\\link{MOFA}} objects.}\n\n\\item{...}{extra arguments passed to pheatmap}\n}\n\\value{\nPlots a heatmap of the Pearson correlation between latent factors across all input models.\n}\n\\description{\nDifferent \\code{\\link{MOFA}} objects are compared in terms of correlation between their factors.\n}\n\\details{\nIf assessing model robustness across trials, the output should look like a block diagonal matrix, \nsuggesting that all factors are robustly detected in all model instances.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel1 <- load_model(file)\nmodel2 <- load_model(file)\n\n# Compare factors between models\ncompare_factors(list(model1,model2))\n}\n" }, { "path": "man/correlate_factors_with_covariates.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/correlate_covariates.R\n\\name{correlate_factors_with_covariates}\n\\alias{correlate_factors_with_covariates}\n\\title{Plot correlation of factors with external covariates}\n\\usage{\ncorrelate_factors_with_covariates(\n object,\n covariates,\n factors = \"all\",\n groups = \"all\",\n abs = FALSE,\n plot = c(\"log_pval\", \"r\"),\n alpha = 0.05,\n return_data = FALSE,\n transpose = FALSE,\n ...\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{covariates}{\\itemize{\n \\item{\\strong{data.frame}: a data.frame where the samples are stored in the rows and the covariates are stored in the columns. \n Use row names for sample names and column names for covariate names. Columns values must be numeric. }\n \\item{\\strong{character vector}: character vector with names of columns that are present in the sample metadata (\\code{samples_metadata(model)}}\n}}\n\n\\item{factors}{character vector with the factor name(s), or numeric vector with the index of the factor(s) to use. Default is 'all'.}\n\n\\item{groups}{character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use samples from all groups.}\n\n\\item{abs}{logical indicating whether to take the absolute value of the correlation coefficient (default is \\code{TRUE}).}\n\n\\item{plot}{character indicating whether to plot Pearson correlation coefficients (\\code{plot=\"r\"}) or log10 adjusted p-values (\\code{plot=\"log_pval\"}).}\n\n\\item{alpha}{p-value threshold}\n\n\\item{return_data}{logical indicating whether to return the correlation results instead of plotting}\n\n\\item{transpose}{logical indicating whether to transpose the plot}\n\n\\item{...}{extra arguments passed to \\code{\\link[corrplot]{corrplot}} (if \\code{plot==\"r\"}) or \\code{\\link[pheatmap]{pheatmap}} (if \\code{plot==\"log_pval\"}).}\n}\n\\value{\nA \\code{\\link[corrplot]{corrplot}} (if \\code{plot==\"r\"}) or \\code{\\link[pheatmap]{pheatmap}} (if \\code{plot==\"log_pval\"}) or the underlying data.frame if return_data is TRUE\n}\n\\description{\nFunction to correlate factor values with external covariates.\n}\n" }, { "path": "man/covariates_names.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/set_methods.R\n\\name{covariates_names}\n\\alias{covariates_names}\n\\alias{covariates_names<-}\n\\alias{covariates_names,MOFA-method}\n\\alias{covariates,MOFA-method}\n\\alias{covariates_names<-,MOFA,vector-method}\n\\title{covariates_names: set and retrieve covariate names}\n\\usage{\ncovariates_names(object)\n\ncovariates_names(object) <- value\n\n\\S4method{covariates_names}{MOFA}(object)\n\n\\S4method{covariates_names}{MOFA,vector}(object) <- value\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{value}{a character vector of covariate names}\n}\n\\value{\ncharacter vector with the covariate names\n}\n\\description{\ncovariates_names: set and retrieve covariate names\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\ncovariates_names(model)\n}\n" }, { "path": "man/create_mofa.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/create_mofa.R\n\\name{create_mofa}\n\\alias{create_mofa}\n\\title{create a MOFA object}\n\\usage{\ncreate_mofa(data, groups = NULL, extract_metadata = TRUE, ...)\n}\n\\arguments{\n\\item{data}{one of the formats above}\n\n\\item{groups}{group information, only relevant when using the multi-group framework.}\n\n\\item{extract_metadata}{logical indicating whether to incorporate the sample metadata from the input object into the MOFA object (\nnot relevant when the input is a list of matrices). Default is \\code{TRUE}.}\n\n\\item{...}{further arguments that can be passed to the function depending on the input data format.\nSee the documentation of above functions for details.}\n}\n\\value{\nReturns an untrained \\code{\\link{MOFA}} object\n}\n\\description{\nMethod to create a \\code{\\link{MOFA}} object. Depending on the input data format, this method calls one of the following functions:\n\\itemize{\n \\item{\\strong{long data.frame}: \\code{\\link{create_mofa_from_df}}}\n \\item{\\strong{List of matrices}: \\code{\\link{create_mofa_from_matrix}}}\n \\item{\\strong{MultiAssayExperiment}: \\code{\\link{create_mofa_from_MultiAssayExperiment}}}\n \\item{\\strong{Seurat}: \\code{\\link{create_mofa_from_Seurat}}}\n \\item{\\strong{SingleCellExperiment}: \\code{\\link{create_mofa_from_SingleCellExperiment}}}\n }\n Please read the documentation of the corresponding function for more details on your specific data format.\n}\n\\examples{\n# Using an existing simulated data with two groups and two views\nfile <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\n\n# Load data (in long data.frame format)\nload(file) \nMOFAmodel <- create_mofa(dt)\n}\n" }, { "path": "man/create_mofa_from_MultiAssayExperiment.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/create_mofa.R\n\\name{create_mofa_from_MultiAssayExperiment}\n\\alias{create_mofa_from_MultiAssayExperiment}\n\\title{create a MOFA object from a MultiAssayExperiment object}\n\\usage{\ncreate_mofa_from_MultiAssayExperiment(\n mae,\n groups = NULL,\n extract_metadata = FALSE\n)\n}\n\\arguments{\n\\item{mae}{a MultiAssayExperiment object}\n\n\\item{groups}{a string specifying column name of the colData to use it as a group variable. \nAlternatively, a character vector with group assignment for every sample.\nDefault is \\code{NULL} (no group structure).}\n\n\\item{extract_metadata}{logical indicating whether to incorporate the metadata from the MultiAssayExperiment object into the MOFA object}\n}\n\\value{\nReturns an untrained \\code{\\link{MOFA}} object\n}\n\\description{\nMethod to create a \\code{\\link{MOFA}} object from a MultiAssayExperiment object\n}\n" }, { "path": "man/create_mofa_from_Seurat.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/create_mofa.R\n\\name{create_mofa_from_Seurat}\n\\alias{create_mofa_from_Seurat}\n\\title{create a MOFA object from a Seurat object}\n\\usage{\ncreate_mofa_from_Seurat(\n seurat,\n groups = NULL,\n assays = NULL,\n layer = \"data\",\n features = NULL,\n extract_metadata = FALSE\n)\n}\n\\arguments{\n\\item{seurat}{Seurat object}\n\n\\item{groups}{a string specifying column name of the samples metadata to use it as a group variable. \nAlternatively, a character vector with group assignment for every sample.\nDefault is \\code{NULL} (no group structure).}\n\n\\item{assays}{assays to use, default is \\code{NULL}, it fetched all assays available}\n\n\\item{layer}{layer to be used (default is data).}\n\n\\item{features}{a list with vectors, which are used to subset features, with names corresponding to assays; a vector can be provided when only one assay is used}\n\n\\item{extract_metadata}{logical indicating whether to incorporate the metadata from the Seurat object into the MOFA object}\n}\n\\value{\nReturns an untrained \\code{\\link{MOFA}} object\n}\n\\description{\nMethod to create a \\code{\\link{MOFA}} object from a Seurat object\n}\n" }, { "path": "man/create_mofa_from_SingleCellExperiment.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/create_mofa.R\n\\name{create_mofa_from_SingleCellExperiment}\n\\alias{create_mofa_from_SingleCellExperiment}\n\\title{create a MOFA object from a SingleCellExperiment object}\n\\usage{\ncreate_mofa_from_SingleCellExperiment(\n sce,\n groups = NULL,\n assay = \"logcounts\",\n extract_metadata = FALSE\n)\n}\n\\arguments{\n\\item{sce}{SingleCellExperiment object}\n\n\\item{groups}{a string specifying column name of the colData to use it as a group variable. \nAlternatively, a character vector with group assignment for every sample.\nDefault is \\code{NULL} (no group structure).}\n\n\\item{assay}{assay to use, default is \\code{logcounts}.}\n\n\\item{extract_metadata}{logical indicating whether to incorporate the metadata from the SingleCellExperiment object into the MOFA object}\n}\n\\value{\nReturns an untrained \\code{\\link{MOFA}} object\n}\n\\description{\nMethod to create a \\code{\\link{MOFA}} object from a SingleCellExperiment object\n}\n" }, { "path": "man/create_mofa_from_df.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/create_mofa.R\n\\name{create_mofa_from_df}\n\\alias{create_mofa_from_df}\n\\title{create a MOFA object from a data.frame object}\n\\usage{\ncreate_mofa_from_df(df, extract_metadata = TRUE)\n}\n\\arguments{\n\\item{df}{\\code{data.frame} object with at most 5 columns: \\code{sample}, \\code{group}, \\code{feature}, \\code{view}, \\code{value}. \nThe \\code{group} column (optional) indicates the group of each sample when using the multi-group framework.\nThe \\code{view} column (optional) indicates the view of each feature when having multi-view data.}\n\n\\item{extract_metadata}{logical indicating whether to incorporate the extra columns as sample metadata into the MOFA object}\n}\n\\value{\nReturns an untrained \\code{\\link{MOFA}} object\n}\n\\description{\nMethod to create a \\code{\\link{MOFA}} object from a data.frame object\n}\n\\examples{\n# Using an existing simulated data with two groups and two views\nfile <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\n\n# Load data (in long data.frame format)\nload(file) \nMOFAmodel <- create_mofa_from_df(dt)\n}\n" }, { "path": "man/create_mofa_from_matrix.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/create_mofa.R\n\\name{create_mofa_from_matrix}\n\\alias{create_mofa_from_matrix}\n\\title{create a MOFA object from a a list of matrices}\n\\usage{\ncreate_mofa_from_matrix(data, groups = NULL)\n}\n\\arguments{\n\\item{data}{A list of matrices, where each entry corresponds to one view.\nSamples are stored in columns and features in rows.\nMissing values must be filled in prior to creating the MOFA object (see for example the CLL tutorial)}\n\n\\item{groups}{A character vector with group assignment for every sample. Default is \\code{NULL}, no group structure.}\n}\n\\value{\nReturns an untrained \\code{\\link{MOFA}} object\n}\n\\description{\nMethod to create a \\code{\\link{MOFA}} object from a list of matrices\n}\n\\examples{\nm <- make_example_data()\ncreate_mofa_from_matrix(m$data)\n}\n" }, { "path": "man/factors_names.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/set_methods.R\n\\name{factors_names}\n\\alias{factors_names}\n\\alias{factors_names<-}\n\\alias{factors_names,MOFA-method}\n\\alias{factors_names<-,MOFA,vector-method}\n\\title{factors_names: set and retrieve factor names}\n\\usage{\nfactors_names(object)\n\nfactors_names(object) <- value\n\n\\S4method{factors_names}{MOFA}(object)\n\n\\S4method{factors_names}{MOFA,vector}(object) <- value\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{value}{a character vector of factor names}\n}\n\\value{\ncharacter vector with the factor names\n}\n\\description{\nfactors_names: set and retrieve factor names\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nfactors_names(model)\n}\n" }, { "path": "man/features_metadata.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/set_methods.R\n\\name{features_metadata}\n\\alias{features_metadata}\n\\alias{features_metadata<-}\n\\alias{features_metadata,MOFA-method}\n\\alias{features_metadata<-,MOFA,data.frame-method}\n\\title{features_metadata: set and retrieve feature metadata}\n\\usage{\nfeatures_metadata(object)\n\nfeatures_metadata(object) <- value\n\n\\S4method{features_metadata}{MOFA}(object)\n\n\\S4method{features_metadata}{MOFA,data.frame}(object) <- value\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{value}{data frame with feature information, it at least must contain the columns \\code{feature} and \\code{view}}\n}\n\\value{\na data frame with sample metadata\n}\n\\description{\nfeatures_metadata: set and retrieve feature metadata\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nfeatures_metadata(model)\n}\n" }, { "path": "man/features_names.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/set_methods.R\n\\name{features_names}\n\\alias{features_names}\n\\alias{features_names<-}\n\\alias{features_names,MOFA-method}\n\\alias{features_names<-,MOFA,list-method}\n\\title{features_names: set and retrieve feature names}\n\\usage{\nfeatures_names(object)\n\nfeatures_names(object) <- value\n\n\\S4method{features_names}{MOFA}(object)\n\n\\S4method{features_names}{MOFA,list}(object) <- value\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{value}{list of character vectors with the feature names for every view}\n}\n\\value{\nlist of character vectors with the feature names for each view\n}\n\\description{\nfeatures_names: set and retrieve feature names\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nfeatures_names(model)\n}\n" }, { "path": "man/get_covariates.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/mefisto.R\n\\name{get_covariates}\n\\alias{get_covariates}\n\\title{Get sample covariates}\n\\usage{\nget_covariates(\n object,\n covariates = \"all\",\n as.data.frame = FALSE,\n warped = FALSE\n)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{covariates}{character vector with the covariate name(s), or numeric vector with the covariate index(es).}\n\n\\item{as.data.frame}{logical indicating whether to output the result as a long data frame, default is \\code{FALSE}.}\n\n\\item{warped}{logical indicating whether to extract the aligned covariates}\n}\n\\value{\na matrix with dimensions (samples,covariates). If \\code{as.data.frame} is \\code{TRUE}, a long-formatted data frame with columns (sample,factor,value)\n}\n\\description{\nFunction to extract the covariates from a \\code{\\link{MOFA}} object using MEFISTO.\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\ncovariates <- get_covariates(model)\n}\n" }, { "path": "man/get_data.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/get_methods.R\n\\name{get_data}\n\\alias{get_data}\n\\title{Get data}\n\\usage{\nget_data(\n object,\n views = \"all\",\n groups = \"all\",\n features = \"all\",\n as.data.frame = FALSE,\n add_intercept = TRUE,\n denoise = FALSE,\n na.rm = TRUE\n)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{views}{character vector with the view name(s), or numeric vector with the view index(es). \nDefault is \"all\".}\n\n\\item{groups}{character vector with the group name(s), or numeric vector with the group index(es). \nDefault is \"all\".}\n\n\\item{features}{a *named* list of character vectors. Example: list(\"view1\"=c(\"feature_1\",\"feature_2\"), \"view2\"=c(\"feature_3\",\"feature_4\"))\nDefault is \"all\".}\n\n\\item{as.data.frame}{logical indicating whether to return a long data frame instead of a list of matrices. Default is \\code{FALSE}.}\n\n\\item{add_intercept}{logical indicating whether to add feature intercepts to the data. Default is \\code{TRUE}.}\n\n\\item{denoise}{logical indicating whether to return the denoised data (i.e. the model predictions). Default is \\code{FALSE}.}\n\n\\item{na.rm}{remove NAs from the data.frame (only if as.data.frame is \\code{TRUE}).}\n}\n\\value{\nA list of data matrices with dimensionality (D,N) or a \\code{data.frame} (if \\code{as.data.frame} is TRUE)\n}\n\\description{\nFetch the input data\n}\n\\details{\nBy default this function returns a list where each element is a data matrix with dimensionality (D,N) \nwhere D is the number of features and N is the number of samples. \\cr\nAlternatively, if \\code{as.data.frame} is \\code{TRUE}, the function returns a long-formatted data frame with columns (view,feature,sample,value).\nMissing values are not included in the the long data.frame format by default. To include them use the argument \\code{na.rm=FALSE}.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Fetch data\ndata <- get_data(model)\n\n# Fetch a specific view\ndata <- get_data(model, views = \"view_0\")\n\n# Fetch data in data.frame format instead of matrix format\ndata <- get_data(model, as.data.frame = TRUE)\n\n# Fetch centered data (do not add the feature intercepts)\ndata <- get_data(model, as.data.frame = FALSE)\n\n# Fetch denoised data (do not add the feature intercepts)\ndata <- get_data(model, denoise = TRUE)\n}\n" }, { "path": "man/get_default_data_options.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/prepare_mofa.R\n\\name{get_default_data_options}\n\\alias{get_default_data_options}\n\\title{Get default data options}\n\\usage{\nget_default_data_options(object)\n}\n\\arguments{\n\\item{object}{an untrained \\code{\\link{MOFA}} object}\n}\n\\value{\nReturns a list with the default data options.\n}\n\\description{\nFunction to obtain the default data options.\n}\n\\details{\nThis function provides a default set of data options that can be modified and passed to the \\code{\\link{MOFA}} object\nin the \\code{\\link{prepare_mofa}} step (see example), i.e. after creating a \\code{\\link{MOFA}} object\n (using \\code{\\link{create_mofa}}) and before starting the training (using \\code{\\link{run_mofa}})\nThe data options are the following: \\cr\n\\itemize{\n \\item{\\strong{scale_views}: logical indicating whether to scale views to have the same unit variance. \n As long as the scale differences between the views is not too high, this is not required. Default is FALSE.}\n \\item{\\strong{scale_groups}: logical indicating whether to scale groups to have the same unit variance. \n As long as the scale differences between the groups is not too high, this is not required. Default is FALSE.}\n \\item{\\strong{use_float32}: logical indicating whether use float32 instead of float64 arrays to increase speed and memory usage. Default is FALSE.}\n }\n}\n\\examples{\n# Using an existing simulated data with two groups and two views\nfile <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\n\n# Load data dt (in data.frame format)\nload(file) \n\n# Create the MOFA object\nMOFAmodel <- create_mofa(dt)\n\n# Load default data options\ndata_opts <- get_default_data_options(MOFAmodel)\n\n# Edit some of the data options\ndata_opts$scale_views <- TRUE\n\n# Prepare the MOFA object\nMOFAmodel <- prepare_mofa(MOFAmodel, data_options = data_opts)\n}\n" }, { "path": "man/get_default_mefisto_options.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/mefisto.R\n\\name{get_default_mefisto_options}\n\\alias{get_default_mefisto_options}\n\\title{Get default options for MEFISTO covariates}\n\\usage{\nget_default_mefisto_options(object)\n}\n\\arguments{\n\\item{object}{an untrained \\code{\\link{MOFA}} object}\n}\n\\value{\nReturns a list with default options for the MEFISTO covariate(s) functionality.\n}\n\\description{\nFunction to obtain the default options for the usage of MEFISTO covariates with MEFISTO\n}\n\\details{\nThe options are the following: \\cr\n\\itemize{\n \\item{\\strong{scale_cov}:} logical: Scale covariates?\n \\item{\\strong{start_opt}:} integer: First iteration to start the optimisation of GP hyperparameters\n \\item{\\strong{n_grid}:} integer: Number of points for the grid search in the optimisation of GP hyperparameters\n \\item{\\strong{opt_freq}:} integer: Frequency of optimisation of GP hyperparameters\n \\item{\\strong{sparseGP}:} logical: Use sparse GPs to speed up the optimisation of the GP parameters?\n \\item{\\strong{frac_inducing}:} numeric between 0 and 1: Fraction of samples to use as inducing points (only relevant if sparseGP is \\code{TRUE})\n \\item{\\strong{warping}:} logical: Activate warping functionality to align covariates between groups (requires a multi-group design)\n \\item{\\strong{warping_freq}:} numeric: frequency of the warping (only relevant if warping is \\code{TRUE})\n \\item{\\strong{warping_ref}:} A character specifying the reference group for warping (only relevant if warping is \\code{TRUE})\n \\item{\\strong{warping_open_begin}:} logical: Warping: Allow for open beginning? (only relevant warping is \\code{TRUE})\n \\item{\\strong{warping_open_end}:} logical: Warping: Allow for open end? (only relevant warping is \\code{TRUE})\n \\item{\\strong{warping_groups}:} Assignment of groups to classes used for alignment (advanced option). \n Needs to be a vector of length number of samples, e.g. a column of samples_metadata, which needs to have the same value within each group.\n By default groups are used specified in `create_mofa`.\n \\item{\\strong{model_groups}:} logical: Model covariance structure across groups (for more than one group, otherwise FALSE)? If FALSE, we assume the same patterns in all groups. \n \\item{\\strong{new_values}:} Values for which to predict the factor values (for interpolation / extrapolation). \n This should be numeric matrix in the same format with covariate(s) in rows and new values in columns.\n Default is NULL, leading to no interpolation.\n}\n}\n\\examples{\n# generate example data\ndd <- make_example_data(sample_cov = seq(0,1,length.out = 200), n_samples = 200,\nn_factors = 4, n_features = 200, n_views = 4, lscales = c(0.5, 0.2, 0, 0))\n# input data\ndata <- dd$data\n# covariate matrix with samples in columns\ntime <- dd$sample_cov\nrownames(time) <- \"time\"\n\n# create mofa and set covariates\nsm <- create_mofa(data = dd$data)\nsm <- set_covariates(sm, covariates = time)\n\nMEFISTO_opt <- get_default_mefisto_options(sm)\n}\n" }, { "path": "man/get_default_model_options.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/prepare_mofa.R\n\\name{get_default_model_options}\n\\alias{get_default_model_options}\n\\title{Get default model options}\n\\usage{\nget_default_model_options(object)\n}\n\\arguments{\n\\item{object}{an untrained \\code{\\link{MOFA}} object}\n}\n\\value{\nReturns a list with the default model options.\n}\n\\description{\nFunction to obtain the default model options.\n}\n\\details{\nThis function provides a default set of model options that can be modified and passed to the \\code{\\link{MOFA}} object\nin the \\code{\\link{prepare_mofa}} step (see example), i.e. after creating a \\code{\\link{MOFA}} object\n (using \\code{\\link{create_mofa}}) and before starting the training (using \\code{\\link{run_mofa}})\nThe model options are the following: \\cr\n\\itemize{\n \\item{\\strong{likelihoods}: character vector with data likelihoods per view: \n 'gaussian' for continuous data (Default for all views), 'bernoulli' for binary data and 'poisson' for count data.}\n \\item{\\strong{num_factors}: numeric value indicating the (initial) number of factors. Default is 15.}\n \\item{\\strong{spikeslab_factors}: logical indicating whether to use spike and slab sparsity on the factors (Default is FALSE)}\n \\item{\\strong{spikeslab_weights}: logical indicating whether to use spike and slab sparsity on the weights (Default is TRUE)}\n \\item{\\strong{ard_factors}: logical indicating whether to use ARD sparsity on the factors (Default is TRUE only if using multiple groups)}\n \\item{\\strong{ard_weights}: logical indicating whether to use ARD sparsity on the weights (Default is TRUE)}\n }\n}\n\\examples{\n# Using an existing simulated data with two groups and two views\nfile <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\n\n# Load data dt (in data.frame format)\nload(file) \n\n# Create the MOFA object\nMOFAmodel <- create_mofa(dt)\n\n# Load default model options\nmodel_opts <- get_default_model_options(MOFAmodel)\n\n# Edit some of the model options\nmodel_opts$num_factors <- 10\nmodel_opts$spikeslab_weights <- FALSE\n\n# Prepare the MOFA object\nMOFAmodel <- prepare_mofa(MOFAmodel, model_options = model_opts)\n}\n" }, { "path": "man/get_default_stochastic_options.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/prepare_mofa.R\n\\name{get_default_stochastic_options}\n\\alias{get_default_stochastic_options}\n\\title{Get default stochastic options}\n\\usage{\nget_default_stochastic_options(object)\n}\n\\arguments{\n\\item{object}{an untrained \\code{\\link{MOFA}}}\n}\n\\value{\nReturns a list with default options\n}\n\\description{\nFunction to obtain the default options for stochastic variational inference.\n}\n\\details{\nThis function provides a default set of stochastic inference options that can be modified and passed to the \\code{\\link{MOFA}} object\nin the \\code{\\link{prepare_mofa}} step), i.e. after creating a \\code{\\link{MOFA}} object\n (using \\code{\\link{create_mofa}}) and before starting the training (using \\code{\\link{run_mofa}})\nThese options are only relevant when activating stochastic inference in training_options (see example).\nThe stochastic inference options are the following: \\cr\n\\itemize{\n \\item{\\strong{batch_size}: numeric value indicating the batch size (as a fraction)}. \n Default is 0.5 (half of the data set).\n \\item{\\strong{learning_rate}: numeric value indicating the learning rate. }\n Default is 1.0\n \\item{\\strong{forgetting_rate}: numeric indicating the forgetting rate.}\n Default is 0.5\n \\item{\\strong{start_stochastic}: integer indicating the first iteration to start stochastic inference}\n Default is 1\n }\n}\n\\examples{\n# Using an existing simulated data with two groups and two views\nfile <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\n\n# Load data dt (in data.frame format)\nload(file) \n\n# Create the MOFA object\nMOFAmodel <- create_mofa(dt)\n\n# activate stochastic inference in training options\ntrain_opts <- get_default_training_options(MOFAmodel)\ntrain_opts$stochastic <- TRUE\n\n# Load default stochastic options\nstochastic_opts <- get_default_stochastic_options(MOFAmodel)\n\n# Edit some of the stochastic options\nstochastic_opts$learning_rate <- 0.75\nstochastic_opts$batch_size <- 0.25\n\n# Prepare the MOFA object\nMOFAmodel <- prepare_mofa(MOFAmodel, \n training_options = train_opts,\n stochastic_options = stochastic_opts\n)\n\n}\n" }, { "path": "man/get_default_training_options.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/prepare_mofa.R\n\\name{get_default_training_options}\n\\alias{get_default_training_options}\n\\title{Get default training options}\n\\usage{\nget_default_training_options(object)\n}\n\\arguments{\n\\item{object}{an untrained \\code{\\link{MOFA}}}\n}\n\\value{\nReturns a list with default training options\n}\n\\description{\nFunction to obtain the default training options.\n}\n\\details{\nThis function provides a default set of training options that can be modified and passed to the \\code{\\link{MOFA}} object\nin the \\code{\\link{prepare_mofa}} step (see example), i.e. after creating a \\code{\\link{MOFA}} object\n (using \\code{\\link{create_mofa}}) and before starting the training (using \\code{\\link{run_mofa}})\nThe training options are the following: \\cr\n\\itemize{\n \\item{\\strong{maxiter}: numeric value indicating the maximum number of iterations. \n Default is 1000. Convergence is assessed using the ELBO statistic.}\n \\item{\\strong{drop_factor_threshold}: numeric indicating the threshold on fraction of variance explained to consider a factor inactive and drop it from the model.\n For example, a value of 0.01 implies that factors explaining less than 1\\% of variance (in each view) will be dropped. Default is -1 (no dropping of factors)}\n \\item{\\strong{convergence_mode}: character indicating the convergence criteria, either \"fast\", \"medium\" or \"slow\", corresponding to 0.0005\\%, 0.00005\\% or 0.000005\\% deltaELBO change. }\n \\item{\\strong{verbose}: logical indicating whether to generate a verbose output.}\n \\item{\\strong{startELBO}: integer indicating the first iteration to compute the ELBO (default is 1). }\n \\item{\\strong{freqELBO}: integer indicating the first iteration to compute the ELBO (default is 1). }\n \\item{\\strong{stochastic}: logical indicating whether to use stochastic variational inference (only required for very big data sets, default is \\code{FALSE}).}\n \\item{\\strong{gpu_mode}: logical indicating whether to use GPUs (see details).}\n \\item{\\strong{gpu_device}: integer indicating which GPU to use.}\n \\item{\\strong{seed}: numeric indicating the seed for reproducibility (default is 42).}\n}\n}\n\\examples{\n# Using an existing simulated data with two groups and two views\nfile <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\n\n# Load data dt (in data.frame format)\nload(file) \n\n# Create the MOFA object\nMOFAmodel <- create_mofa(dt)\n\n# Load default training options\ntrain_opts <- get_default_training_options(MOFAmodel)\n\n# Edit some of the training options\ntrain_opts$convergence_mode <- \"medium\"\ntrain_opts$startELBO <- 100\ntrain_opts$seed <- 42\n\n# Prepare the MOFA object\nMOFAmodel <- prepare_mofa(MOFAmodel, training_options = train_opts)\n}\n" }, { "path": "man/get_dimensions.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/get_methods.R\n\\name{get_dimensions}\n\\alias{get_dimensions}\n\\title{Get dimensions}\n\\usage{\nget_dimensions(object)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n}\n\\value{\nlist containing the dimensionalities of the model\n}\n\\description{\nExtract dimensionalities from the model.\n}\n\\details{\nK indicates the number of factors, M indicates the number of views, D indicates the number of features (per view), \nN indicates the number of samples (per group) and C indicates the number of covariates.\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\ndims <- get_dimensions(model)\n}\n" }, { "path": "man/get_elbo.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/get_methods.R\n\\name{get_elbo}\n\\alias{get_elbo}\n\\title{Get ELBO}\n\\usage{\nget_elbo(object)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n}\n\\value{\nValue of the ELBO\n}\n\\description{\nExtract the value of the ELBO statistics after model training. This can be useful for model selection.\n}\n\\details{\nThis can be useful for model selection.\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nelbo <- get_elbo(model)\n}\n" }, { "path": "man/get_expectations.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/get_methods.R\n\\name{get_expectations}\n\\alias{get_expectations}\n\\title{Get expectations}\n\\usage{\nget_expectations(object, variable, as.data.frame = FALSE)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{variable}{variable name: 'Z' for factors and 'W' for weights.}\n\n\\item{as.data.frame}{logical indicating whether to output the result as a long data frame, default is \\code{FALSE}.}\n}\n\\value{\nthe output varies depending on the variable of interest: \\cr\n\\itemize{\n \\item{\\strong{\"Z\"}: a matrix with dimensions (samples,factors). If \\code{as.data.frame} is \\code{TRUE}, a long-formatted data frame with columns (sample,factor,value)}\n \\item{\\strong{\"W\"}: a list of length (views) where each element is a matrix with dimensions (features,factors). If \\code{as.data.frame} is \\code{TRUE}, a long-formatted data frame with columns (view,feature,factor,value)}\n}\n}\n\\description{\nFunction to extract the expectations from the (variational) posterior distributions of a trained \\code{\\link{MOFA}} object.\n}\n\\details{\nTechnical note: MOFA is a Bayesian model where each variable has a prior distribution and a posterior distribution. \nIn particular, to achieve scalability we used the variational inference framework, thus true posterior distributions are replaced by approximated variational distributions.\nThis function extracts the expectations of the variational distributions, which can be used as final point estimates to analyse the results of the model. \\cr \nThe priors and variational distributions of each variable are extensively described in the supplementary methods of the original paper.\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nfactors <- get_expectations(model, \"Z\")\nweights <- get_expectations(model, \"W\")\n}\n" }, { "path": "man/get_factors.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/get_methods.R\n\\name{get_factors}\n\\alias{get_factors}\n\\title{Get factors}\n\\usage{\nget_factors(\n object,\n groups = \"all\",\n factors = \"all\",\n scale = FALSE,\n as.data.frame = FALSE\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{groups}{character vector with the group name(s), or numeric vector with the group index(es).\nDefault is \"all\".}\n\n\\item{factors}{character vector with the factor name(s), or numeric vector with the factor index(es).\nDefault is \"all\".}\n\n\\item{scale}{logical indicating whether to scale factor values.}\n\n\\item{as.data.frame}{logical indicating whether to return a long data frame instead of a matrix.\nDefault is \\code{FALSE}.}\n}\n\\value{\nBy default it returns the latent factor matrix of dimensionality (N,K), where N is number of samples and K is number of factors. \\cr\nAlternatively, if \\code{as.data.frame} is \\code{TRUE}, returns a long-formatted data frame with columns (sample,factor,value).\n}\n\\description{\nExtract the latent factors from the model.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Fetch factors in matrix format (a list, one matrix per group)\nfactors <- get_factors(model)\n\n# Concatenate groups\nfactors <- do.call(\"rbind\",factors)\n\n# Fetch factors in data.frame format instead of matrix format\nfactors <- get_factors(model, as.data.frame = TRUE)\n}\n" }, { "path": "man/get_group_kernel.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/get_methods.R\n\\name{get_group_kernel}\n\\alias{get_group_kernel}\n\\title{Get group covariance matrix}\n\\usage{\nget_group_kernel(object)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n}\n\\value{\nA list of group-group correlation matrices per factor\n}\n\\description{\nExtract the inferred group-group covariance matrix per factor\n}\n\\details{\nThis can be used only if covariates are passed to the MOFAobject upon creation and GP_factors is set to True.\n}\n" }, { "path": "man/get_imputed_data.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/get_methods.R\n\\name{get_imputed_data}\n\\alias{get_imputed_data}\n\\title{Get imputed data}\n\\usage{\nget_imputed_data(\n object,\n views = \"all\",\n groups = \"all\",\n features = \"all\",\n as.data.frame = FALSE\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{views}{character vector with the view name(s), or numeric vector with the view index(es). \nDefault is \"all\".}\n\n\\item{groups}{character vector with the group name(s), or numeric vector with the group index(es).\nDefault is \"all\".}\n\n\\item{features}{list of character vectors with the feature names or list of numeric vectors with the feature indices. \nDefault is \"all\".}\n\n\\item{as.data.frame}{logical indicating whether to return a long-formatted data frame instead of a list of matrices. \nDefault is \\code{FALSE}.}\n}\n\\value{\nA list containing the imputed valued or a data.frame if as.data.frame is TRUE\n}\n\\description{\nFunction to get the imputed data. It requires the previous use of the \\code{\\link{impute}} method.\n}\n\\details{\nData is imputed from the generative model of MOFA.\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nmodel <- impute(model)\nimputed <- get_imputed_data(model)\n}\n" }, { "path": "man/get_interpolated_factors.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/get_methods.R\n\\name{get_interpolated_factors}\n\\alias{get_interpolated_factors}\n\\title{Get interpolated factor values}\n\\usage{\nget_interpolated_factors(object, as.data.frame = FALSE, only_mean = FALSE)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object}\n\n\\item{as.data.frame}{logical indicating whether to return data as a data.frame}\n\n\\item{only_mean}{logical indicating whether include only mean or also uncertainties}\n}\n\\value{\nBy default, a nested list containing for each group a list with a matrix with the interpolated factor values (\"mean\"),\n their variance (\"variance\") and the values of the covariate at which interpolation took place (\"new_values\"). \nAlternatively, if \\code{as.data.frame} is \\code{TRUE}, returns a long-formatted data frame with columns containing the covariates \nand (factor, group, mean and variance).\n}\n\\description{\nExtract the interpolated factor values\n}\n\\details{\nThis can be used only if covariates are passed to the object upon creation, GP_factors is set to True and new covariates were passed for interpolation.\n}\n" }, { "path": "man/get_lengthscales.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/get_methods.R\n\\name{get_lengthscales}\n\\alias{get_lengthscales}\n\\title{Get lengthscales}\n\\usage{\nget_lengthscales(object)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n}\n\\value{\nA numeric vector containing the lengthscale for each factor.\n}\n\\description{\nExtract the inferred lengthscale for each factor after model training.\n}\n\\details{\nThis can be used only if covariates are passed to the MOFAobject upon creation and GP_factors is set to True.\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nls <- get_lengthscales(model)\n}\n" }, { "path": "man/get_scales.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/get_methods.R\n\\name{get_scales}\n\\alias{get_scales}\n\\title{Get scales}\n\\usage{\nget_scales(object)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n}\n\\value{\nA numeric vector containing the scale for each factor.\n}\n\\description{\nExtract the inferred scale for each factor after model training.\n}\n\\details{\nThis can be used only if covariates are passed to the MOFAobject upon creation and GP_factors is set to True.\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\ns <- get_scales(model)\n}\n" }, { "path": "man/get_variance_explained.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/get_methods.R\n\\name{get_variance_explained}\n\\alias{get_variance_explained}\n\\title{Get variance explained values}\n\\usage{\nget_variance_explained(\n object,\n groups = \"all\",\n views = \"all\",\n factors = \"all\",\n as.data.frame = FALSE\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{groups}{character vector with the group name(s), or numeric vector with the group index(es).\nDefault is \"all\".}\n\n\\item{views}{character vector with the view name(s), or numeric vector with the view index(es).\nDefault is \"all\".}\n\n\\item{factors}{character vector with the factor name(s), or numeric vector with the factor index(es).\nDefault is \"all\".}\n\n\\item{as.data.frame}{logical indicating whether to return a long data frame instead of a matrix.\nDefault is \\code{FALSE}.}\n}\n\\value{\nA list of data matrices with variance explained per group or a \\code{data.frame} (if \\code{as.data.frame} is TRUE)\n}\n\\description{\nExtract the latent factors from the model.\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Fetch variance explained values (in matrix format)\nr2 <- get_variance_explained(model)\n\n# Fetch variance explained values (in data.frame format)\nr2 <- get_variance_explained(model, as.data.frame = TRUE)\n\n}\n" }, { "path": "man/get_weights.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/get_methods.R\n\\name{get_weights}\n\\alias{get_weights}\n\\title{Get weights}\n\\usage{\nget_weights(\n object,\n views = \"all\",\n factors = \"all\",\n abs = FALSE,\n scale = FALSE,\n as.data.frame = FALSE\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{views}{character vector with the view name(s), or numeric vector with the view index(es). \nDefault is \"all\".}\n\n\\item{factors}{character vector with the factor name(s) or numeric vector with the factor index(es). \\cr\nDefault is \"all\".}\n\n\\item{abs}{logical indicating whether to take the absolute value of the weights.}\n\n\\item{scale}{logical indicating whether to scale all weights from -1 to 1 (or from 0 to 1 if \\code{abs=TRUE}).}\n\n\\item{as.data.frame}{logical indicating whether to return a long data frame instead of a list of matrices. \nDefault is \\code{FALSE}.}\n}\n\\value{\nBy default it returns a list where each element is a loading matrix with dimensionality (D,K), \nwhere D is the number of features and K is the number of factors. \\cr\nAlternatively, if \\code{as.data.frame} is \\code{TRUE}, returns a long-formatted data frame with columns (view,feature,factor,value).\n}\n\\description{\nExtract the weights from the model.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Fetch weights in matrix format (a list, one matrix per view)\nweights <- get_weights(model)\n\n# Fetch weights for factor 1 and 2 and view 1\nweights <- get_weights(model, views = 1, factors = c(1,2))\n\n# Fetch weights in data.frame format\nweights <- get_weights(model, as.data.frame = TRUE)\n}\n" }, { "path": "man/groups_names.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/set_methods.R\n\\name{groups_names}\n\\alias{groups_names}\n\\alias{groups_names<-}\n\\alias{groups_names,MOFA-method}\n\\alias{groups_names<-,MOFA,character-method}\n\\title{groups_names: set and retrieve group names}\n\\usage{\ngroups_names(object)\n\ngroups_names(object) <- value\n\n\\S4method{groups_names}{MOFA}(object)\n\n\\S4method{groups_names}{MOFA,character}(object) <- value\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{value}{character vector with the names for each group}\n}\n\\value{\ncharacter vector with the names for each sample group\n}\n\\description{\ngroups_names: set and retrieve group names\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\ngroups_names(model)\ngroups_names(model) <- c(\"my_group\")\n}\n" }, { "path": "man/impute.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/impute.R\n\\name{impute}\n\\alias{impute}\n\\title{Impute missing values from a fitted MOFA}\n\\usage{\nimpute(\n object,\n views = \"all\",\n groups = \"all\",\n factors = \"all\",\n add_intercept = TRUE\n)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{views}{character vector with the view name(s), or numeric vector with view index(es).}\n\n\\item{groups}{character vector with the group name(s), or numeric vector with group index(es).}\n\n\\item{factors}{character vector with the factor names, or numeric vector with the factor index(es).}\n\n\\item{add_intercept}{add feature intercepts to the imputation (default is TRUE).}\n}\n\\value{\nThis method fills the \\code{imputed_data} slot by replacing the missing values in the input data with the model predictions.\n}\n\\description{\nThis function uses the latent factors and the loadings to impute missing values.\n}\n\\details{\nMOFA generates a denoised and condensed low-dimensional representation of the data that captures the main sources of heterogeneity of the data.\nThis representation can be used to reconstruct the data, simply using the equation \\code{Y = WX}. \nFor more details read the supplementary methods of the manuscript. \\cr\nNote that with \\code{\\link{impute}} you can only generate the point estimates (the means of the posterior distributions). \nIf you want to add uncertainty estimates (the variance) you need to set \\code{impute=TRUE} in the training options.\nSee \\code{\\link{get_default_training_options}}.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Impute missing values in all data modalities\nimputed_data <- impute(model, views = \"all\")\n\n# Impute missing values in all data modalities using factors 1:3\nimputed_data <- impute(model, views = \"all\", factors = 1:3)\n}\n" }, { "path": "man/interpolate_factors.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/mefisto.R\n\\name{interpolate_factors}\n\\alias{interpolate_factors}\n\\title{Interpolate factors in MEFISTO based on new covariate values}\n\\usage{\ninterpolate_factors(object, new_values)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object trained with MEFISTO options and a covariate}\n\n\\item{new_values}{a matrix containing the new covariate values to inter/extrapolate to. Should be\nin the same format as the covariates used for training.}\n}\n\\value{\nReturns the \\code{\\link{MOFA}} with interpolated factor values filled in the corresponding slot (interpolatedZ)\n}\n\\description{\nFunction to interpolate factors in MEFISTO based on new covariate values.\n}\n\\details{\nThis function requires the functional MEFISTO framework to be used in training. \nUse \\code{set_covariates} and specify mefisto_options when preparing the training using \\code{prepare_mofa}. \nCurrently, only the mean of the interpolation is provided from R.\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nmodel <- interpolate_factors(model, new_values = seq(0,1.1,0.01))\n}\n" }, { "path": "man/load_model.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/load_model.R\n\\name{load_model}\n\\alias{load_model}\n\\title{Load a trained MOFA}\n\\usage{\nload_model(\n file,\n sort_factors = TRUE,\n on_disk = FALSE,\n load_data = TRUE,\n remove_outliers = FALSE,\n remove_inactive_factors = TRUE,\n verbose = FALSE,\n load_interpol_Z = FALSE\n)\n}\n\\arguments{\n\\item{file}{an hdf5 file saved by the mofa Python framework}\n\n\\item{sort_factors}{logical indicating whether factors should be sorted by variance explained (default is TRUE)}\n\n\\item{on_disk}{logical indicating whether to work from memory (FALSE) or disk (TRUE). \\cr\nThis should be set to TRUE when the training data is so big that cannot fit into memory. \\cr\nOn-disk operations are performed using the \\code{\\link{HDF5Array}} and \\code{\\link{DelayedArray}} framework.}\n\n\\item{load_data}{logical indicating whether to load the training data (default is TRUE, it can be memory expensive)}\n\n\\item{remove_outliers}{logical indicating whether to mask outlier values.}\n\n\\item{remove_inactive_factors}{logical indicating whether to remove inactive factors from the model.}\n\n\\item{verbose}{logical indicating whether to print verbose output (default is FALSE)}\n\n\\item{load_interpol_Z}{(MEFISTO) logical indicating whether to load predictions for factor values based on latent processed (only\nrelevant for models trained with covariates and Gaussian processes, where prediction was enabled)}\n}\n\\value{\na \\code{\\link{MOFA}} model\n}\n\\description{\nMethod to load a trained MOFA \\cr\nThe training of mofa is done using a Python framework, and the model output is saved as an .hdf5 file, which has to be loaded in the R package.\n}\n\\examples{\n#' # Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n}\n" }, { "path": "man/make_example_data.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/make_example_data.R\n\\name{make_example_data}\n\\alias{make_example_data}\n\\title{Simulate a data set using the generative model of MOFA}\n\\usage{\nmake_example_data(\n n_views = 3,\n n_features = 100,\n n_samples = 50,\n n_groups = 1,\n n_factors = 5,\n likelihood = \"gaussian\",\n lscales = 1,\n sample_cov = NULL,\n as.data.frame = FALSE\n)\n}\n\\arguments{\n\\item{n_views}{number of views}\n\n\\item{n_features}{number of features in each view}\n\n\\item{n_samples}{number of samples in each group}\n\n\\item{n_groups}{number of groups}\n\n\\item{n_factors}{number of factors}\n\n\\item{likelihood}{likelihood for each view, one of \"gaussian\" (default), \"bernoulli\", \"poisson\",\nor a character vector of length n_views}\n\n\\item{lscales}{vector of lengthscales, needs to be of length n_factors (default is 0 - no smooth factors)}\n\n\\item{sample_cov}{(only for use with MEFISTO) matrix of sample covariates for one group with covariates in rows and samples in columns \nor \"equidistant\" for sequential ordering, default is NULL (no smooth factors)}\n\n\\item{as.data.frame}{return data and covariates as long dataframe}\n}\n\\value{\nReturns a list containing the simulated data and simulation parameters.\n}\n\\description{\nFunction to simulate an example multi-view multi-group data set according to the generative model of MOFA2.\n}\n\\examples{\n# Generate a simulated data set\nMOFAexample <- make_example_data()\n}\n" }, { "path": "man/pipe.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/imports.R\n\\name{\\%>\\%}\n\\alias{\\%>\\%}\n\\title{Re-exporting the pipe operator\nSee \\code{magrittr::\\link[magrittr]{\\%>\\%}} for details.}\n\\usage{\nlhs \\%>\\% rhs\n}\n\\arguments{\n\\item{lhs}{see \\code{magrittr::\\link[magrittr]{\\%>\\%}}}\n\n\\item{rhs}{see \\code{magrittr::\\link[magrittr]{\\%>\\%}}}\n}\n\\value{\ndepending on lhs and rhs\n}\n\\description{\nRe-exporting the pipe operator\nSee \\code{magrittr::\\link[magrittr]{\\%>\\%}} for details.\n}\n" }, { "path": "man/plot_alignment.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/mefisto.R\n\\name{plot_alignment}\n\\alias{plot_alignment}\n\\title{Plot covariate alignment across groups}\n\\usage{\nplot_alignment(object)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object using MEFISTO with warping}\n}\n\\value{\nggplot object showing the alignment\n}\n\\description{\nFunction to plot the alignment learnt by MEFISTO for the \ncovariate values between different groups\n}\n\\details{\nThis function requires the functional MEFISTO framework to be used in training. \nUse \\code{set_covariates} and specify mefisto_options when preparing the training using \\code{prepare_mofa}.\n}\n" }, { "path": "man/plot_ascii_data.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plot_data.R\n\\name{plot_ascii_data}\n\\alias{plot_ascii_data}\n\\title{Visualize the structure of the data in the terminal}\n\\usage{\nplot_ascii_data(object, nonzero = FALSE)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object}\n\n\\item{nonzero}{a logical value specifying whether to calculate the fraction of non-zero values (non-NA values by default)}\n}\n\\value{\nNone\n}\n\\description{\nA Fancy printing method\n}\n\\details{\nThis function is helpful to get an overview of the structure of the data as a text output\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nplot_ascii_data(model)\n}\n" }, { "path": "man/plot_data_heatmap.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plot_data.R\n\\name{plot_data_heatmap}\n\\alias{plot_data_heatmap}\n\\title{Plot heatmap of relevant features}\n\\usage{\nplot_data_heatmap(\n object,\n factor,\n view = 1,\n groups = \"all\",\n features = 50,\n annotation_features = NULL,\n annotation_samples = NULL,\n transpose = FALSE,\n imputed = FALSE,\n denoise = FALSE,\n max.value = NULL,\n min.value = NULL,\n ...\n)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{factor}{a string with the factor name, or an integer with the index of the factor.}\n\n\\item{view}{a string with the view name, or an integer with the index of the view. Default is the first view.}\n\n\\item{groups}{groups to plot. Default is \"all\".}\n\n\\item{features}{if an integer (default), the total number of features to plot based on the absolute value of the weights.\nIf a character vector, a set of manually defined features.}\n\n\\item{annotation_features}{annotation metadata for features (rows). \nEither a character vector specifying columns in the feature metadata, or a data.frame that will be passed to \\code{\\link[pheatmap]{pheatmap}} as \\code{annotation_col}}\n\n\\item{annotation_samples}{annotation metadata for samples (columns). \nEither a character vector specifying columns in the sample metadata, or a data.frame that will be passed to \\code{\\link[pheatmap]{pheatmap}} as \\code{annotation_row}}\n\n\\item{transpose}{logical indicating whether to transpose the heatmap. \nDefault corresponds to features as rows and samples as columns.}\n\n\\item{imputed}{logical indicating whether to plot the imputed data instead of the original data. Default is FALSE.}\n\n\\item{denoise}{logical indicating whether to plot a denoised version of the data reconstructed using the MOFA factors.}\n\n\\item{max.value}{numeric indicating the maximum value to display in the heatmap (i.e. the matrix values will be capped at \\code{max.value} ).}\n\n\\item{min.value}{numeric indicating the minimum value to display in the heatmap (i.e. the matrix values will be capped at \\code{min.value} ).\nSee \\code{\\link{predict}}. Default is FALSE.}\n\n\\item{...}{further arguments that can be passed to \\code{\\link[pheatmap]{pheatmap}}}\n}\n\\value{\nA \\code{\\link[pheatmap]{pheatmap}} object\n}\n\\description{\nFunction to plot a heatmap of the data for relevant features, typically the ones with high weights.\n}\n\\details{\nOne of the first steps for the annotation of a given factor is to visualise the corresponding weights, \nusing for example \\code{\\link{plot_weights}} or \\code{\\link{plot_top_weights}}. \\cr\nHowever, one might also be interested in visualising the direct relationship between features and factors, rather than looking at \"abstract\" weights. \\cr\nThis function generates a heatmap for selected features, which should reveal the underlying pattern that is captured by the latent factor. \\cr\nA similar function for doing scatterplots rather than heatmaps is \\code{\\link{plot_data_scatter}}.\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nplot_data_heatmap(model, factor = 1, show_rownames = FALSE, show_colnames = FALSE)\n}\n" }, { "path": "man/plot_data_overview.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plot_data.R\n\\name{plot_data_overview}\n\\alias{plot_data_overview}\n\\title{Overview of the input data}\n\\usage{\nplot_data_overview(\n object,\n covariate = 1,\n colors = NULL,\n show_covariate = FALSE,\n show_dimensions = TRUE\n)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{covariate}{(only for MEFISTO) specifies sample covariate to order samples by in the plot. This should be\na character or a numeric index giving the name or position of a column present in the covariates slot of the object.\nDefault is the first sample covariate in covariates slot. \\code{NULL} does not order by covariate}\n\n\\item{colors}{a vector specifying the colors per view (see example for details).}\n\n\\item{show_covariate}{(only for MEFISTO) boolean specifying whether to include the covariate in the plot}\n\n\\item{show_dimensions}{logical indicating whether to plot the dimensions of the data (default is TRUE).}\n}\n\\value{\nA \\code{\\link{ggplot}} object\n}\n\\description{\nFunction to do a tile plot showing the missing value structure of the input data\n}\n\\details{\nThis function is helpful to get an overview of the structure of the data. \nIt shows the model dimensionalities (number of samples, groups, views and features) \nand it indicates which measurements are missing.\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nplot_data_overview(model)\n}\n" }, { "path": "man/plot_data_scatter.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plot_data.R\n\\name{plot_data_scatter}\n\\alias{plot_data_scatter}\n\\title{Scatterplots of feature values against latent factors}\n\\usage{\nplot_data_scatter(\n object,\n factor = 1,\n view = 1,\n groups = \"all\",\n features = 10,\n sign = \"all\",\n color_by = \"group\",\n legend = TRUE,\n alpha = 1,\n shape_by = NULL,\n stroke = NULL,\n dot_size = 2.5,\n text_size = NULL,\n add_lm = TRUE,\n lm_per_group = TRUE,\n imputed = FALSE\n)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{factor}{string with the factor name, or an integer with the index of the factor.}\n\n\\item{view}{string with the view name, or an integer with the index of the view. Default is the first view.}\n\n\\item{groups}{groups to plot. Default is \"all\".}\n\n\\item{features}{if an integer (default), the total number of features to plot. If a character vector, a set of manually-defined features.}\n\n\\item{sign}{can be 'positive', 'negative' or 'all' (default) to show only positive, negative or all weights, respectively.}\n\n\\item{color_by}{specifies groups or values (either discrete or continuous) used to color the dots (samples). This can be either: \n\\itemize{\n\\item the string \"group\": dots are coloured with respect to their predefined groups.\n\\item a character giving the name of a feature that is present in the input data \n\\item a character giving the same of a column in the sample metadata slot\n\\item a vector of the same length as the number of samples specifying the value for each sample. \n\\item a dataframe with two columns: \"sample\" and \"color\"\n}}\n\n\\item{legend}{logical indicating whether to add a legend}\n\n\\item{alpha}{numeric indicating dot transparency (default is 1).}\n\n\\item{shape_by}{specifies groups or values (only discrete) used to shape the dots (samples). This can be either: \n\\itemize{\n\\item the string \"group\": dots are shaped with respect to their predefined groups.\n\\item a character giving the name of a feature that is present in the input data \n\\item a character giving the same of a column in the sample metadata slot\n\\item a vector of the same length as the number of samples specifying the value for each sample. \n\\item a dataframe with two columns: \"sample\" and \"shape\"\n}}\n\n\\item{stroke}{numeric indicating the stroke size (the black border around the dots, default is NULL, inferred automatically).}\n\n\\item{dot_size}{numeric indicating dot size (default is 5).}\n\n\\item{text_size}{numeric indicating text size (default is 5).}\n\n\\item{add_lm}{logical indicating whether to add a linear regression line for each plot}\n\n\\item{lm_per_group}{logical indicating whether to add a linear regression line separately for each group}\n\n\\item{imputed}{logical indicating whether to include imputed measurements}\n}\n\\value{\nA \\code{\\link{ggplot}} object\n}\n\\description{\nFunction to do a scatterplot of features against factor values.\n}\n\\details{\nOne of the first steps for the annotation of factors is to visualise the weights using \\code{\\link{plot_weights}} or \\code{\\link{plot_top_weights}}.\nHowever, one might also be interested in visualising the direct relationship between features and factors, rather than looking at \"abstract\" weights. \\cr\nA similar function for doing heatmaps rather than scatterplots is \\code{\\link{plot_data_heatmap}}.\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nplot_data_scatter(model)\n}\n" }, { "path": "man/plot_data_vs_cov.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/mefisto.R\n\\name{plot_data_vs_cov}\n\\alias{plot_data_vs_cov}\n\\title{Scatterplots of feature values against sample covariates}\n\\usage{\nplot_data_vs_cov(\n object,\n covariate = 1,\n warped = TRUE,\n factor = 1,\n view = 1,\n groups = \"all\",\n features = 10,\n sign = \"all\",\n color_by = \"group\",\n legend = TRUE,\n alpha = 1,\n shape_by = NULL,\n stroke = NULL,\n dot_size = 2.5,\n text_size = NULL,\n add_lm = FALSE,\n lm_per_group = FALSE,\n imputed = FALSE,\n return_data = FALSE\n)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object using MEFISTO.}\n\n\\item{covariate}{string with the covariate name or a samples_metadata column, or an integer with the index of the covariate}\n\n\\item{warped}{logical indicating whether to show the aligned covariate (default: TRUE), \nonly relevant if warping has been used to align multiple sample groups}\n\n\\item{factor}{string with the factor name, or an integer with the index of the factor to take top features from}\n\n\\item{view}{string with the view name, or an integer with the index of the view. Default is the first view.}\n\n\\item{groups}{groups to plot. Default is \"all\".}\n\n\\item{features}{if an integer (default), the total number of features to plot (given by highest weights). If a character vector, a set of manually-defined features.}\n\n\\item{sign}{can be 'positive', 'negative' or 'all' (default) to show only features with highest positive, negative or all weights, respectively.}\n\n\\item{color_by}{specifies groups or values (either discrete or continuous) used to color the dots (samples). This can be either: \n\\itemize{\n\\item the string \"group\": dots are coloured with respect to their predefined groups.\n\\item a character giving the name of a feature that is present in the input data \n\\item a character giving the same of a column in the sample metadata slot\n\\item a vector of the same length as the number of samples specifying the value for each sample. \n\\item a dataframe with two columns: \"sample\" and \"color\"\n}}\n\n\\item{legend}{logical indicating whether to add a legend}\n\n\\item{alpha}{numeric indicating dot transparency (default is 1).}\n\n\\item{shape_by}{specifies groups or values (only discrete) used to shape the dots (samples). This can be either: \n\\itemize{\n\\item the string \"group\": dots are shaped with respect to their predefined groups.\n\\item a character giving the name of a feature that is present in the input data \n\\item a character giving the same of a column in the sample metadata slot\n\\item a vector of the same length as the number of samples specifying the value for each sample. \n\\item a dataframe with two columns: \"sample\" and \"shape\"\n}}\n\n\\item{stroke}{numeric indicating the stroke size (the black border around the dots, default is NULL, inferred automatically).}\n\n\\item{dot_size}{numeric indicating dot size (default is 5).}\n\n\\item{text_size}{numeric indicating text size (default is 5).}\n\n\\item{add_lm}{logical indicating whether to add a linear regression line for each plot}\n\n\\item{lm_per_group}{logical indicating whether to add a linear regression line separately for each group}\n\n\\item{imputed}{logical indicating whether to include imputed measurements}\n\n\\item{return_data}{logical indicating whether to return a data frame instead of a plot}\n}\n\\value{\nReturns a \\code{ggplot2} object or the underlying dataframe if return_data is set to \\code{TRUE}.\n}\n\\description{\nFunction to do a scatterplot of features against sample covariate values.\n}\n\\details{\nOne of the first steps for the annotation of factors is to visualise the weights using \\code{\\link{plot_weights}} or \\code{\\link{plot_top_weights}}\nand inspect the relationship of the factor to the covariate(s) using \\code{\\link{plot_factors_vs_cov}}.\nHowever, one might also be interested in visualising the direct relationship between features and covariate(s), rather than looking at \"abstract\" weights and\npossibly look at the interpolated and extrapolated values by setting imputed to True.\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nplot_data_vs_cov(model, factor = 3, features = 2)\n}\n" }, { "path": "man/plot_dimred.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/dimensionality_reduction.R\n\\name{plot_dimred}\n\\alias{plot_dimred}\n\\title{Plot dimensionality reduction based on MOFA factors}\n\\usage{\nplot_dimred(\n object,\n method = c(\"UMAP\", \"TSNE\"),\n groups = \"all\",\n show_missing = TRUE,\n color_by = NULL,\n shape_by = NULL,\n color_name = NULL,\n shape_name = NULL,\n label = FALSE,\n dot_size = 1.5,\n stroke = NULL,\n alpha_missing = 1,\n legend = TRUE,\n rasterize = FALSE,\n return_data = FALSE,\n ...\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{method}{string indicating which method has been used for non-linear dimensionality reduction (either 'umap' or 'tsne')}\n\n\\item{groups}{character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use samples from all groups.}\n\n\\item{show_missing}{logical indicating whether to include samples for which \\code{shape_by} or \\code{color_by} is missing}\n\n\\item{color_by}{specifies groups or values used to color the samples. This can be either:\n(1) a character giving the name of a feature present in the training data.\n(2) a character giving the same of a column present in the sample metadata.\n(3) a vector of the same length as the number of samples specifying discrete groups or continuous numeric values.}\n\n\\item{shape_by}{specifies groups or values used to shape the samples. This can be either:\n(1) a character giving the name of a feature present in the training data, \n(2) a character giving the same of a column present in the sample metadata.\n(3) a vector of the same length as the number of samples specifying discrete groups.}\n\n\\item{color_name}{name for color legend.}\n\n\\item{shape_name}{name for shape legend.}\n\n\\item{label}{logical indicating whether to label the medians of the clusters. Only if color_by is specified}\n\n\\item{dot_size}{numeric indicating dot size.}\n\n\\item{stroke}{numeric indicating the stroke size (the black border around the dots, default is NULL, inferred automatically).}\n\n\\item{alpha_missing}{numeric indicating dot transparency of missing data.}\n\n\\item{legend}{logical indicating whether to add legend.}\n\n\\item{rasterize}{logical indicating whether to rasterize plot using \\code{\\link[ggrastr]{geom_point_rast}}}\n\n\\item{return_data}{logical indicating whether to return the long data frame to plot instead of plotting}\n\n\\item{...}{extra arguments passed to \\code{\\link{run_umap}} or \\code{\\link{run_tsne}}.}\n}\n\\value{\nReturns a \\code{ggplot2} object or a long data.frame (if return_data is TRUE)\n}\n\\description{\nPlot dimensionality reduction based on MOFA factors\n}\n\\details{\nThis function plots dimensionality reduction projections that are stored in the \\code{dim_red} slot.\nTypically this contains UMAP or t-SNE projections computed using \\code{\\link{run_tsne}} or \\code{\\link{run_umap}}, respectively.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Run UMAP\nmodel <- run_umap(model)\n\n# Plot UMAP\nplot_dimred(model, method = \"UMAP\")\n\n# Plot UMAP, colour by Factor 1 values\nplot_dimred(model, method = \"UMAP\", color_by = \"Factor1\")\n\n# Plot UMAP, colour by the values of a specific feature\nplot_dimred(model, method = \"UMAP\", color_by = \"feature_0_view_0\")\n\n}\n" }, { "path": "man/plot_enrichment.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/enrichment.R\n\\name{plot_enrichment}\n\\alias{plot_enrichment}\n\\title{Plot output of gene set Enrichment Analysis}\n\\usage{\nplot_enrichment(\n enrichment.results,\n factor,\n alpha = 0.1,\n max.pathways = 25,\n text_size = 1,\n dot_size = 5\n)\n}\n\\arguments{\n\\item{enrichment.results}{output of \\link{run_enrichment} function}\n\n\\item{factor}{a string with the factor name or an integer with the factor index}\n\n\\item{alpha}{p.value threshold to filter out gene sets}\n\n\\item{max.pathways}{maximum number of enriched pathways to display}\n\n\\item{text_size}{text size}\n\n\\item{dot_size}{dot size}\n}\n\\value{\na \\code{ggplot2} object\n}\n\\description{\nMethod to plot the results of the gene set Enrichment Analysis\n}\n\\details{\nit requires \\code{\\link{run_enrichment}} to be run beforehand.\n}\n" }, { "path": "man/plot_enrichment_detailed.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/enrichment.R\n\\name{plot_enrichment_detailed}\n\\alias{plot_enrichment_detailed}\n\\title{Plot detailed output of the Feature Set Enrichment Analysis}\n\\usage{\nplot_enrichment_detailed(\n enrichment.results,\n factor,\n alpha = 0.1,\n max.genes = 5,\n max.pathways = 10,\n text_size = 3\n)\n}\n\\arguments{\n\\item{enrichment.results}{output of \\link{run_enrichment} function}\n\n\\item{factor}{string with factor name or numeric with factor index}\n\n\\item{alpha}{p.value threshold to filter out feature sets}\n\n\\item{max.genes}{maximum number of genes to display, per pathway}\n\n\\item{max.pathways}{maximum number of enriched pathways to display}\n\n\\item{text_size}{size of the text to label the top genes}\n}\n\\value{\na \\code{ggplot2} object\n}\n\\description{\nMethod to plot a detailed output of the Feature Set Enrichment Analysis (FSEA). \\cr\nEach row corresponds to a significant pathway, sorted by statistical significance, and each dot corresponds to a gene. \\cr\nFor each pathway, we display the top genes of the pathway sorted by the corresponding feature statistic (by default, the absolute value of the weight)\nThe top genes with the highest statistic (max.genes argument) are displayed and labelled in black. The remaining genes are colored in grey.\n}\n" }, { "path": "man/plot_enrichment_heatmap.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/enrichment.R\n\\name{plot_enrichment_heatmap}\n\\alias{plot_enrichment_heatmap}\n\\title{Heatmap of Feature Set Enrichment Analysis results}\n\\usage{\nplot_enrichment_heatmap(\n enrichment.results,\n alpha = 0.1,\n cap = 1e-50,\n log_scale = TRUE,\n ...\n)\n}\n\\arguments{\n\\item{enrichment.results}{output of \\link{run_enrichment} function}\n\n\\item{alpha}{FDR threshold to filter out unsignificant feature sets which are\nnot represented in the heatmap. Default is 0.10.}\n\n\\item{cap}{cap p-values below this threshold}\n\n\\item{log_scale}{logical indicating whether to plot the -log of the p.values.}\n\n\\item{...}{extra arguments to be passed to the \\link{pheatmap} function}\n}\n\\value{\nproduces a heatmap\n}\n\\description{\nThis method generates a heatmap with the adjusted p.values that\n result from the the feature set enrichment analysis. Rows are feature sets and columns are factors.\n}\n" }, { "path": "man/plot_factor.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plot_factors.R\n\\name{plot_factor}\n\\alias{plot_factor}\n\\title{Beeswarm plot of factor values}\n\\usage{\nplot_factor(\n object,\n factors = 1,\n groups = \"all\",\n group_by = \"group\",\n color_by = \"group\",\n shape_by = NULL,\n add_dots = TRUE,\n dot_size = 2,\n dot_alpha = 1,\n add_violin = FALSE,\n violin_alpha = 0.5,\n color_violin = TRUE,\n add_boxplot = FALSE,\n boxplot_alpha = 0.5,\n color_boxplot = TRUE,\n show_missing = TRUE,\n scale = FALSE,\n dodge = FALSE,\n color_name = \"\",\n shape_name = \"\",\n stroke = NULL,\n legend = TRUE,\n rasterize = FALSE\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{factors}{character vector with the factor names, or numeric vector with the indices of the factors to use, or \"all\" to plot all factors.}\n\n\\item{groups}{character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use samples from all groups.}\n\n\\item{group_by}{specifies grouping of samples:\n\\itemize{\n\\item (default) the string \"group\": in this case, the plot will color samples with respect to their predefined groups.\n\\item a character giving the name of a feature that is present in the input data \n\\item a character giving the name of a column in the sample metadata slot\n\\item a vector of the same length as the number of samples specifying the value for each sample. \n}}\n\n\\item{color_by}{specifies color of samples. This can be either: \n\\itemize{\n\\item (default) the string \"group\": in this case, the plot will color the dots with respect to their predefined groups.\n\\item a character giving the name of a feature that is present in the input data \n\\item a character giving the name of a column in the sample metadata slot\n\\item a vector of the same length as the number of samples specifying the value for each sample. \n}}\n\n\\item{shape_by}{specifies shape of samples. This can be either: \n\\itemize{\n\\item (default) the string \"group\": in this case, the plot will shape the dots with respect to their predefined groups.\n\\item a character giving the name of a feature that is present in the input data \n\\item a character giving the name of a column in the sample metadata slot\n\\item a vector of the same length as the number of samples specifying the value for each sample. \n}}\n\n\\item{add_dots}{logical indicating whether to add dots.}\n\n\\item{dot_size}{numeric indicating dot size.}\n\n\\item{dot_alpha}{numeric indicating dot transparency.}\n\n\\item{add_violin}{logical indicating whether to add violin plots}\n\n\\item{violin_alpha}{numeric indicating violin plot transparency.}\n\n\\item{color_violin}{logical indicating whether to color violin plots.}\n\n\\item{add_boxplot}{logical indicating whether to add box plots}\n\n\\item{boxplot_alpha}{numeric indicating boxplot transparency.}\n\n\\item{color_boxplot}{logical indicating whether to color box plots.}\n\n\\item{show_missing}{logical indicating whether to remove samples for which \\code{shape_by} or \\code{color_by} is missing.}\n\n\\item{scale}{logical indicating whether to scale factor values.}\n\n\\item{dodge}{logical indicating whether to dodge the dots (default is FALSE).}\n\n\\item{color_name}{name for color legend (usually only used if color_by is not a character itself).}\n\n\\item{shape_name}{name for shape legend (usually only used if shape_by is not a character itself).}\n\n\\item{stroke}{numeric indicating the stroke size (the black border around the dots).}\n\n\\item{legend}{logical indicating whether to add a legend to the plot (default is TRUE).}\n\n\\item{rasterize}{logical indicating whether to rasterize the plot (default is FALSE).}\n}\n\\value{\nReturns a \\code{ggplot2}\n}\n\\description{\nBeeswarm plot of the latent factor values.\n}\n\\details{\nOne of the main steps for the annotation of factors is to visualise and color them using known covariates or phenotypic data. \\cr\nThis function generates a Beeswarm plot of the sample values in a given latent factor. \\cr\nSimilar functions are \\code{\\link{plot_factors}} for doing scatter plots.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Plot Factors 1 and 2 and colour by \"group\"\nplot_factor(model, factors = c(1,2), color_by=\"group\")\n\n# Plot Factor 3 and colour by the value of a specific feature\nplot_factor(model, factors = 3, color_by=\"feature_981_view_1\")\n\n# Add violin plots\nplot_factor(model, factors = c(1,2), color_by=\"group\", add_violin = TRUE)\n\n# Scale factor values from -1 to 1\nplot_factor(model, factors = c(1,2), scale = TRUE)\n\n}\n" }, { "path": "man/plot_factor_cor.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plot_factors.R\n\\name{plot_factor_cor}\n\\alias{plot_factor_cor}\n\\title{Plot correlation matrix between latent factors}\n\\usage{\nplot_factor_cor(object, method = \"pearson\", ...)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{method}{a character indicating the type of correlation coefficient to be computed: pearson (default), kendall, or spearman.}\n\n\\item{...}{arguments passed to \\code{\\link[corrplot]{corrplot}}}\n}\n\\value{\nReturns a symmetric matrix with the correlation coefficient between every pair of factors.\n}\n\\description{\nFunction to plot the correlation matrix between the latent factors.\n}\n\\details{\nThis method plots the correlation matrix between the latent factors. \\cr \nThe model encourages the factors to be uncorrelated, so this function usually yields a diagonal correlation matrix. \\cr \nHowever, it is not a hard constraint such as in Principal Component Analysis and correlations between factors can occur, \nparticularly with large number factors. \\cr\nGenerally, correlated factors are redundant and should be avoided, as they make interpretation harder. Therefore, \nif you have too many correlated factors we suggest you try reducing the number of factors.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Plot correlation between all factors\nplot_factor_cor(model)\n\n}\n" }, { "path": "man/plot_factors.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plot_factors.R\n\\name{plot_factors}\n\\alias{plot_factors}\n\\title{Scatterplots of two factor values}\n\\usage{\nplot_factors(\n object,\n factors = c(1, 2),\n groups = \"all\",\n show_missing = TRUE,\n scale = FALSE,\n color_by = NULL,\n shape_by = NULL,\n color_name = NULL,\n shape_name = NULL,\n dot_size = 2,\n alpha = 1,\n legend = TRUE,\n stroke = NULL,\n return_data = FALSE\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{factors}{a vector of length two with the factors to plot. Factors can be specified either as a characters}\n\n\\item{groups}{character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use samples from all groups.}\n\n\\item{show_missing}{logical indicating whether to include samples for which \\code{shape_by} or \\code{color_by} is missing}\n\n\\item{scale}{logical indicating whether to scale factor values.}\n\n\\item{color_by}{specifies groups or values used to color the samples. This can be either:\n(1) a character giving the name of a feature present in the training data.\n(2) a character giving the name of a column present in the sample metadata.\n(3) a vector of the same length as the number of samples specifying discrete groups or continuous numeric values.}\n\n\\item{shape_by}{specifies groups or values used to shape the samples. This can be either:\n(1) a character giving the name of a feature present in the training data, \n(2) a character giving the name of a column present in the sample metadata.\n(3) a vector of the same length as the number of samples specifying discrete groups.}\n\n\\item{color_name}{name for color legend.}\n\n\\item{shape_name}{name for shape legend.}\n\n\\item{dot_size}{numeric indicating dot size (default is 2).}\n\n\\item{alpha}{numeric indicating dot transparency (default is 1).}\n\n\\item{legend}{logical indicating whether to add legend.}\n\n\\item{stroke}{numeric indicating the stroke size (the black border around the dots, default is NULL, inferred automatically).}\n\n\\item{return_data}{logical indicating whether to return the data frame to plot instead of plotting}\n}\n\\value{\nReturns a \\code{ggplot2} object\n}\n\\description{\nScatterplot of the values of two latent factors.\n}\n\\details{\nOne of the first steps for the annotation of factors is to visualise and group/color them using known covariates such as phenotypic or clinical data.\nThis method generates a single scatterplot for the combination of two latent factors.\nTO-FINISH...\n\\code{\\link{plot_factors}} for doing Beeswarm plots for factors.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Scatterplot of factors 1 and 2\nplot_factors(model, factors = c(1,2))\n\n# Shape dots by a column in the metadata\nplot_factors(model, factors = c(1,2), shape_by=\"group\")\n\n# Scale factor values from -1 to 1\nplot_factors(model, factors = c(1,2), scale = TRUE)\n\n}\n" }, { "path": "man/plot_factors_vs_cov.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/mefisto.R\n\\name{plot_factors_vs_cov}\n\\alias{plot_factors_vs_cov}\n\\title{Scatterplots of a factor's values against the sample covariates}\n\\usage{\nplot_factors_vs_cov(\n object,\n factors = \"all\",\n covariates = NULL,\n warped = TRUE,\n show_missing = TRUE,\n scale = FALSE,\n color_by = NULL,\n shape_by = NULL,\n color_name = NULL,\n shape_name = NULL,\n dot_size = 1.5,\n alpha = 1,\n stroke = NULL,\n legend = TRUE,\n rotate_x = FALSE,\n rotate_y = FALSE,\n return_data = FALSE,\n show_variance = FALSE\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object using MEFISTO.}\n\n\\item{factors}{character or numeric specifying the factor(s) to plot, default is \"all\"}\n\n\\item{covariates}{specifies sample covariate(s) to plot against:\n(1) a character giving the name of a column present in the sample covariates or sample metadata.\n(2) a character giving the name of a feature present in the training data.\n(3) a vector of the same length as the number of samples specifying continuous numeric values per sample.\nDefault is the first sample covariates in covariates slot}\n\n\\item{warped}{logical indicating whether to show the aligned covariate (default: TRUE), \nonly relevant if warping has been used to align multiple sample groups}\n\n\\item{show_missing}{(for 1-dim covariates) logical indicating whether to include samples for which \\code{shape_by} or \\code{color_by} is missing}\n\n\\item{scale}{logical indicating whether to scale factor values.}\n\n\\item{color_by}{(for 1-dim covariates) specifies groups or values used to color the samples. This can be either:\n(1) a character giving the name of a feature present in the training data.\n(2) a character giving the same of a column present in the sample metadata.\n(3) a vector of the same length as the number of samples specifying discrete groups or continuous numeric values.}\n\n\\item{shape_by}{(for 1-dim covariates) specifies groups or values used to shape the samples. This can be either:\n(1) a character giving the name of a feature present in the training data, \n(2) a character giving the same of a column present in the sample metadata.\n(3) a vector of the same length as the number of samples specifying discrete groups.}\n\n\\item{color_name}{(for 1-dim covariates) name for color legend.}\n\n\\item{shape_name}{(for 1-dim covariates) name for shape legend.}\n\n\\item{dot_size}{(for 1-dim covariates) numeric indicating dot size.}\n\n\\item{alpha}{(for 1-dim covariates) numeric indicating dot transparency.}\n\n\\item{stroke}{(for 1-dim covariates) numeric indicating the stroke size}\n\n\\item{legend}{(for 1-dim covariates) logical indicating whether to add legend.}\n\n\\item{rotate_x}{(for spatial, 2-dim covariates) Rotate covariate on x-axis}\n\n\\item{rotate_y}{(for spatial, 2-dim covariates) Rotate covariate on y-axis}\n\n\\item{return_data}{logical indicating whether to return the data frame to plot instead of plotting}\n\n\\item{show_variance}{(for 1-dim covariates) logical indicating whether to show the marginal variance of inferred factor values \n(only relevant for 1-dimensional covariates)}\n}\n\\value{\nReturns a \\code{ggplot2} object\n}\n\\description{\nScatterplots of a factor's values against the sample covariates\n}\n\\details{\nTo investigate the factors pattern along the covariates (such as time or a spatial coordinate) \nthis function an be used to plot a scatterplot of the factor against the values of each covariate\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nplot_factors_vs_cov(model)\n}\n" }, { "path": "man/plot_group_kernel.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/mefisto.R\n\\name{plot_group_kernel}\n\\alias{plot_group_kernel}\n\\title{Heatmap plot showing the group-group correlations per factor}\n\\usage{\nplot_group_kernel(object, factors = \"all\", groups = \"all\", ...)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object using MEFISTO.}\n\n\\item{factors}{character vector with the factors names, or numeric vector indicating the indices of the factors to use}\n\n\\item{groups}{character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use samples from all groups.}\n\n\\item{...}{additional parameters that can be passed to \\code{pheatmap}}\n}\n\\value{\nReturns a \\code{ggplot,gg} object containing the heatmaps\n}\n\\description{\nHeatmap plot showing the group-group correlations inferred by the model per factor\n}\n\\details{\nThe heatmap gives insight into the clustering of the patterns that factors display along the covariate in each group. \nA correlation of 1 indicates that the module captured by a factor shows identical patterns across groups, a correlation of zero that it shows distinct patterns,\na negative correlation that the patterns go in opposite directions.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nplot_group_kernel(model)\n}\n" }, { "path": "man/plot_interpolation_vs_covariate.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/mefisto.R\n\\name{plot_interpolation_vs_covariate}\n\\alias{plot_interpolation_vs_covariate}\n\\title{Plot interpolated factors versus covariate (1-dimensional)}\n\\usage{\nplot_interpolation_vs_covariate(\n object,\n covariate = 1,\n factors = \"all\",\n only_mean = TRUE,\n show_observed = TRUE\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object using MEFISTO.}\n\n\\item{covariate}{covariate to use for plotting}\n\n\\item{factors}{character or numeric specifying the factor(s) to plot, default is \"all\"}\n\n\\item{only_mean}{show only mean or include uncertainties?}\n\n\\item{show_observed}{include observed factor values as dots on the plot}\n}\n\\value{\nReturns a \\code{ggplot2} object\n}\n\\description{\nmake a plot of interpolated covariates versus covariate\n}\n\\details{\nto be filled\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nmodel <- interpolate_factors(model, new_values = seq(0,1.1,0.1))\nplot_interpolation_vs_covariate(model, covariate = \"time\", factors = 1)\n}\n" }, { "path": "man/plot_sharedness.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/mefisto.R\n\\name{plot_sharedness}\n\\alias{plot_sharedness}\n\\title{Barplot showing the sharedness per factor}\n\\usage{\nplot_sharedness(object, factors = \"all\", color = \"#B8CF87\")\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object using MEFISTO.}\n\n\\item{factors}{character vector with the factors names, or numeric vector indicating the indices of the factors to use}\n\n\\item{color}{for the shared part of the bar}\n}\n\\value{\nReturns a \\code{ggplot2} object\n}\n\\description{\nBarplot indicating a sharedness score (between 0 (non-shared) and 1 (shared)) per factor\n}\n\\details{\nThe sharedness score is calculated as the distance of the learnt group correlation matrix to the identity matrix\n in terms of the mean absolute distance on the off-diagonal elements.\n}\n" }, { "path": "man/plot_smoothness.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/mefisto.R\n\\name{plot_smoothness}\n\\alias{plot_smoothness}\n\\title{Barplot showing the smoothness per factor}\n\\usage{\nplot_smoothness(object, factors = \"all\", color = \"cadetblue\")\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object using MEFISTO.}\n\n\\item{factors}{character vector with the factors names, or numeric vector indicating the indices of the factors to use}\n\n\\item{color}{for the smooth part of the bar}\n}\n\\value{\nReturns a \\code{ggplot2} object\n}\n\\description{\nBarplot indicating a smoothness score (between 0 (non-smooth) and 1 (smooth)) per factor\n}\n\\details{\nThe smoothness score is given by the scale parameter for the underlying Gaussian process of each factor.\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nsmoothness_bars <- plot_smoothness(model)\n}\n" }, { "path": "man/plot_top_weights.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plot_weights.R\n\\name{plot_top_weights}\n\\alias{plot_top_weights}\n\\title{Plot top weights}\n\\usage{\nplot_top_weights(\n object,\n view = 1,\n factors = 1,\n nfeatures = 10,\n abs = TRUE,\n scale = TRUE,\n sign = \"all\"\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{view}{a string with the view name, or an integer with the index of the view.}\n\n\\item{factors}{a character string with factors names, or an integer vector with factors indices.}\n\n\\item{nfeatures}{number of top features to display.\nDefault is 10}\n\n\\item{abs}{logical indicating whether to use the absolute value of the weights (Default is FALSE).}\n\n\\item{scale}{logical indicating whether to scale all weights from -1 to 1 (or from 0 to 1 if abs=TRUE). Default is TRUE.}\n\n\\item{sign}{can be 'positive', 'negative' or 'all' to show only positive, negative or all weights, respectively. Default is 'all'.}\n}\n\\value{\nReturns a \\code{ggplot2} object\n}\n\\description{\nPlot top weights for a given factor and view.\n}\n\\details{\nAn important step to annotate factors is to visualise the corresponding feature weights. \\cr\nThis function displays the top features with highest loading whereas the function \\code{\\link{plot_weights}} plots all weights for a given latent factor and view. \\cr\nImportantly, the weights of the features within a view have relative values and they should not be interpreted in an absolute scale.\nTherefore, for interpretability purposes we always recommend to scale the weights with \\code{scale=TRUE}.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Plot top weights for Factors 1 and 2 and View 1\nplot_top_weights(model, view = 1, factors = c(1,2))\n\n# Do not take absolute value\nplot_weights(model, abs = FALSE)\n\n}\n" }, { "path": "man/plot_variance_explained.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/calculate_variance_explained.R\n\\name{plot_variance_explained}\n\\alias{plot_variance_explained}\n\\title{Plot variance explained by the model}\n\\usage{\nplot_variance_explained(\n object,\n x = \"view\",\n y = \"factor\",\n split_by = NA,\n plot_total = FALSE,\n factors = \"all\",\n min_r2 = 0,\n max_r2 = NULL,\n legend = TRUE,\n use_cache = TRUE,\n ...\n)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object}\n\n\\item{x}{character specifying the dimension for the x-axis (\"view\", \"factor\", or \"group\").}\n\n\\item{y}{character specifying the dimension for the y-axis (\"view\", \"factor\", or \"group\").}\n\n\\item{split_by}{character specifying the dimension to be faceted (\"view\", \"factor\", or \"group\").}\n\n\\item{plot_total}{logical value to indicate if to plot the total variance explained (for the variable in the x-axis)}\n\n\\item{factors}{character vector with a factor name(s), or numeric vector with the index(es) of the factor(s). Default is \"all\".}\n\n\\item{min_r2}{minimum variance explained for the color scheme (default is 0).}\n\n\\item{max_r2}{maximum variance explained for the color scheme.}\n\n\\item{legend}{logical indicating whether to add a legend to the plot (default is TRUE).}\n\n\\item{use_cache}{logical indicating whether to use cache (default is TRUE)}\n\n\\item{...}{extra arguments to be passed to \\code{\\link{calculate_variance_explained}}}\n}\n\\value{\nA list of \\code{\\link{ggplot}} objects (if \\code{plot_total} is TRUE) or a single \\code{\\link{ggplot}} object\n}\n\\description{\nplots the variance explained by the MOFA factors across different views and groups, as specified by the user.\nConsider using cowplot::plot_grid(plotlist = ...) to combine the multiple plots that this function generates.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Calculate variance explained (R2)\nr2 <- calculate_variance_explained(model)\n\n# Plot variance explained values (view as x-axis, and factor as y-axis)\nplot_variance_explained(model, x=\"view\", y=\"factor\")\n\n# Plot variance explained values (view as x-axis, and group as y-axis)\nplot_variance_explained(model, x=\"view\", y=\"group\")\n\n# Plot variance explained values for factors 1 to 3\nplot_variance_explained(model, x=\"view\", y=\"group\", factors=1:3)\n\n# Scale R2 values\nplot_variance_explained(model, max_r2=0.25)\n}\n" }, { "path": "man/plot_variance_explained_by_covariates.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/mefisto.R\n\\name{plot_variance_explained_by_covariates}\n\\alias{plot_variance_explained_by_covariates}\n\\title{Plot variance explained by the smooth components of the model}\n\\usage{\nplot_variance_explained_by_covariates(\n object,\n factors = \"all\",\n x = \"view\",\n y = \"factor\",\n split_by = NA,\n min_r2 = 0,\n max_r2 = NULL,\n compare_total = FALSE,\n legend = TRUE\n)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object}\n\n\\item{factors}{character vector with a factor name(s), or numeric vector with the index(es) of the factor(s). Default is \"all\".}\n\n\\item{x}{character specifying the dimension for the x-axis (\"view\", \"factor\", or \"group\").}\n\n\\item{y}{character specifying the dimension for the y-axis (\"view\", \"factor\", or \"group\").}\n\n\\item{split_by}{character specifying the dimension to be faceted (\"view\", \"factor\", or \"group\").}\n\n\\item{min_r2}{minimum variance explained for the color scheme (default is 0).}\n\n\\item{max_r2}{maximum variance explained for the color scheme.}\n\n\\item{compare_total}{plot corresponding variance explained in total in addition}\n\n\\item{legend}{logical indicating whether to add a legend to the plot (default is TRUE).}\n}\n\\value{\nA list of \\code{\\link{ggplot}} objects (if \\code{compare_total} is TRUE) or a single \\code{\\link{ggplot}} object. \nConsider using cowplot::plot_grid(plotlist = ...) to combine the multiple plots that this function generates.\n}\n\\description{\nThis function plots the variance explained by the smooth components (Gaussian processes) underlying the factors in MEFISTO across different views and groups, as specified by the user.\n}\n\\details{\nNote that this function requires the use of MEFISTO. \nTo activate the functional MEFISTO framework, specify mefisto_options when preparing the training using \\code{prepare_mofa}\n}\n\\examples{\n# load_model\nfile <- system.file(\"extdata\", \"MEFISTO_model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nplot_variance_explained_by_covariates(model)\n\n# compare to total variance explained\nplist <- plot_variance_explained_by_covariates(model, compare_total = TRUE)\ncowplot::plot_grid(plotlist = plist)\n}\n" }, { "path": "man/plot_variance_explained_per_feature.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/calculate_variance_explained.R\n\\name{plot_variance_explained_per_feature}\n\\alias{plot_variance_explained_per_feature}\n\\title{Plot variance explained by the model for a set of features}\n\\usage{\nplot_variance_explained_per_feature(\n object,\n view,\n features = 10,\n split_by_factor = FALSE,\n group_features_by = NULL,\n groups = \"all\",\n factors = \"all\",\n min_r2 = 0,\n max_r2 = NULL,\n legend = TRUE,\n return_data = FALSE,\n ...\n)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{view}{a view name or index.}\n\n\\item{features}{a vector with indices or names for features from the respective view, \nor number of top features to be fetched by their loadings across specified factors. \n\"all\" to plot all features.}\n\n\\item{split_by_factor}{logical indicating whether to split R2 per factor or plot R2 jointly}\n\n\\item{group_features_by}{column name of features metadata to group features by}\n\n\\item{groups}{a vector with indices or names for sample groups (default is all)}\n\n\\item{factors}{a vector with indices or names for factors (default is all)}\n\n\\item{min_r2}{minimum variance explained for the color scheme (default is 0).}\n\n\\item{max_r2}{maximum variance explained for the color scheme.}\n\n\\item{legend}{logical indicating whether to add a legend to the plot (default is TRUE).}\n\n\\item{return_data}{logical indicating whether to return the data frame to plot instead of plotting}\n\n\\item{...}{extra arguments to be passed to \\code{\\link{calculate_variance_explained}}}\n}\n\\value{\nggplot object\n}\n\\description{\nReturns a tile plot with a group on the X axis and a feature along the Y axis\n}\n\\examples{\n# Using an existing trained model\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nplot_variance_explained_per_feature(model, view = 1)\n}\n" }, { "path": "man/plot_weights.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plot_weights.R\n\\name{plot_weights}\n\\alias{plot_weights}\n\\title{Plot distribution of feature weights (weights)}\n\\usage{\nplot_weights(\n object,\n view = 1,\n factors = 1,\n nfeatures = 10,\n color_by = NULL,\n shape_by = NULL,\n abs = FALSE,\n manual = NULL,\n color_manual = NULL,\n scale = TRUE,\n dot_size = 1,\n text_size = 5,\n legend = TRUE,\n return_data = FALSE\n)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{view}{a string with the view name, or an integer with the index of the view.}\n\n\\item{factors}{character vector with the factor name(s), or numeric vector with the index of the factor(s).}\n\n\\item{nfeatures}{number of top features to label.}\n\n\\item{color_by}{specifies groups or values (either discrete or continuous) used to color the dots (features). This can be either: \n\\itemize{\n\\item (default) the string \"group\": in this case, the plot will color the dots with respect to their predefined groups.\n\\item a character giving the name of a feature that is present in the input data \n\\item a character giving the same of a column in the features metadata slot\n\\item a vector of the same length as the number of features specifying the value for each feature \n\\item a dataframe with two columns: \"feature\" and \"color\"\n}}\n\n\\item{shape_by}{specifies groups or values (only discrete) used to shape the dots (features). This can be either: \n\\itemize{\n\\item (default) the string \"group\": in this case, the plot will shape the dots with respect to their predefined groups.\n\\item a character giving the name of a feature that is present in the input data \n\\item a character giving the same of a column in the features metadata slot\n\\item a vector of the same length as the number of features specifying the value for each feature \n\\item a dataframe with two columns: \"feature\" and \"shape\"\n}}\n\n\\item{abs}{logical indicating whether to take the absolute value of the weights.}\n\n\\item{manual}{A nested list of character vectors with features to be manually labelled (see the example for details).}\n\n\\item{color_manual}{a character vector with colors, one for each element of 'manual'}\n\n\\item{scale}{logical indicating whether to scale all weights from -1 to 1 (or from 0 to 1 if abs=TRUE).}\n\n\\item{dot_size}{numeric indicating the dot size.}\n\n\\item{text_size}{numeric indicating the text size.}\n\n\\item{legend}{logical indicating whether to add legend.}\n\n\\item{return_data}{logical indicating whether to return the data frame to plot instead of plotting}\n}\n\\value{\nA \\code{\\link{ggplot}} object or a \\code{data.frame} if return_data is TRUE\n}\n\\description{\nAn important step to annotate factors is to visualise the corresponding feature weights. \\cr\nThis function plots all weights for a given latent factor and view, labeling the top ones. \\cr\nIn contrast, the function \\code{\\link{plot_top_weights}} displays only the top features with highest loading.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Plot distribution of weights for Factor 1 and View 1\nplot_weights(model, view = 1, factors = 1)\n\n# Plot distribution of weights for Factors 1 to 3 and View 1\nplot_weights(model, view = 1, factors = 1:3)\n\n# Take the absolute value and highlight the top 10 features\nplot_weights(model, view = 1, factors = 1, nfeatures = 10, abs = TRUE)\n\n# Change size of dots and text\nplot_weights(model, view = 1, factors = 1, text_size = 5, dot_size = 1)\n\n}\n" }, { "path": "man/plot_weights_heatmap.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plot_weights.R\n\\name{plot_weights_heatmap}\n\\alias{plot_weights_heatmap}\n\\title{Plot heatmap of the weights}\n\\usage{\nplot_weights_heatmap(\n object,\n view = 1,\n features = \"all\",\n factors = \"all\",\n threshold = 0,\n ...\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{view}{character vector with the view name(s), or numeric vector with the index of the view(s) to use. \nDefault is the first view.}\n\n\\item{features}{character vector with the feature name(s), or numeric vector with the index of the feature(s) to use. \nDefault is 'all'.}\n\n\\item{factors}{character vector with the factor name(s), or numeric vector with the index of the factor(s) to use. \nDefault is 'all'.}\n\n\\item{threshold}{threshold on absolute weight values, so that weights with a magnitude below this threshold (in all factors) are removed}\n\n\\item{...}{extra arguments passed to \\code{\\link[pheatmap]{pheatmap}}.}\n}\n\\value{\nA \\code{\\link{pheatmap}} object\n}\n\\description{\nFunction to visualize the weights for a given set of factors in a given view. \\cr \nThis is useful to visualize the overall pattern of the weights but not to individually characterise the factors. \\cr\nTo inspect the weights of individual factors, use the functions \\code{\\link{plot_weights}} and \\code{\\link{plot_top_weights}}\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nplot_weights_heatmap(model)\n}\n" }, { "path": "man/plot_weights_scatter.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plot_weights.R\n\\name{plot_weights_scatter}\n\\alias{plot_weights_scatter}\n\\title{Scatterplots of weights}\n\\usage{\nplot_weights_scatter(\n object,\n factors,\n view = 1,\n color_by = NULL,\n shape_by = NULL,\n dot_size = 1,\n name_color = \"\",\n name_shape = \"\",\n show_missing = TRUE,\n abs = FALSE,\n scale = TRUE,\n legend = TRUE\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{factors}{a vector of length two with the factors to plot. Factors can be specified either as a characters\nusing the factor names, or as numeric with the index of the factors}\n\n\\item{view}{character vector with the view name, or numeric vector with the index of the view to use. Default is the first view.}\n\n\\item{color_by}{specifies groups or values used to color the features. This can be either \n\\itemize{\n\\item a character giving the same of a column in the feature metadata slot\n\\item a vector specifying the value for each feature. \n\\item a dataframe with two columns: \"feature\" and \"color\"\n}}\n\n\\item{shape_by}{specifies groups or values used to shape the features. This can be either \n\\itemize{\n\\item a character giving the same of a column in the feature metadata slot\n\\item a vector specifying the value for each feature. \n\\item a dataframe with two columns: \"feature\" and \"shape\"\n}}\n\n\\item{dot_size}{numeric indicating dot size.}\n\n\\item{name_color}{name for color legend (usually only used if color_by is not a character itself)}\n\n\\item{name_shape}{name for shape legend (usually only used if shape_by is not a character itself)}\n\n\\item{show_missing}{logical indicating whether to include dots for which \\code{shape_by} or \\code{color_by} is missing}\n\n\\item{abs}{logical indicating whether to take the absolute value of the weights.}\n\n\\item{scale}{logical indicating whether to scale all weights from -1 to 1 (or from 0 to 1 if \\code{abs=TRUE}).}\n\n\\item{legend}{logical indicating whether to add a legend to the plot (default is TRUE).}\n}\n\\value{\nReturns a \\code{ggplot2} object\n}\n\\description{\nScatterplot of the weights values for two factors\n}\n\\details{\nOne of the first steps for the annotation of factors is to visualise and group/color them using known covariates such as phenotypic or clinical data.\nThis method generates a single scatterplot for the combination of two latent factors.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nplot_weights_scatter(model, factors = 1:2)\n}\n" }, { "path": "man/predict.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/predict.R\n\\name{predict}\n\\alias{predict}\n\\title{Do predictions using a fitted MOFA}\n\\usage{\npredict(\n object,\n views = \"all\",\n groups = \"all\",\n factors = \"all\",\n add_intercept = TRUE\n)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{views}{character vector with the view name(s), or numeric vector with the view index(es).\nDefault is \"all\".}\n\n\\item{groups}{character vector with the group name(s), or numeric vector with the group index(es).\nDefault is \"all\".}\n\n\\item{factors}{character vector with the factor name(s) or numeric vector with the factor index(es).\nDefault is \"all\".}\n\n\\item{add_intercept}{add feature intercepts to the prediction (default is TRUE).}\n}\n\\value{\nReturns a list with the data reconstructed by the model predictions.\n}\n\\description{\nThis function uses the latent factors and the weights to do data predictions.\n}\n\\details{\nMOFA generates a denoised and condensed low-dimensional representation of the data that captures the main sources of heterogeneity of the data.\nThis representation can be used to reconstruct a denoised representation of the data, simply using the equation \\code{Y = WX}. \nFor more mathematical details read the supplementary methods of the manuscript.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Predict observations for all data modalities\npredictions <- predict(model)\n}\n" }, { "path": "man/prepare_mofa.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/prepare_mofa.R\n\\name{prepare_mofa}\n\\alias{prepare_mofa}\n\\title{Prepare a MOFA for training}\n\\usage{\nprepare_mofa(\n object,\n data_options = NULL,\n model_options = NULL,\n training_options = NULL,\n stochastic_options = NULL,\n mefisto_options = NULL\n)\n}\n\\arguments{\n\\item{object}{an untrained \\code{\\link{MOFA}}}\n\n\\item{data_options}{list of data_options (see \\code{\\link{get_default_data_options}} details). \nIf NULL, default options are used.}\n\n\\item{model_options}{list of model options (see \\code{\\link{get_default_model_options}} for details). \nIf NULL, default options are used.}\n\n\\item{training_options}{list of training options (see \\code{\\link{get_default_training_options}} for details). \nIf NULL, default options are used.}\n\n\\item{stochastic_options}{list of options for stochastic variational inference (see \\code{\\link{get_default_stochastic_options}} for details). \nIf NULL, default options are used.}\n\n\\item{mefisto_options}{list of options for mefisto (see \\code{\\link{get_default_mefisto_options}} for details). \nIf NULL, default options are used.}\n}\n\\value{\nReturns an untrained \\code{\\link{MOFA}} with specified options filled in the corresponding slots\n}\n\\description{\nFunction to prepare a \\code{\\link{MOFA}} object for training. \nIt requires defining data, model and training options.\n}\n\\details{\nThis function is called after creating a \\code{\\link{MOFA}} object (using \\code{\\link{create_mofa}}) \nand before starting the training (using \\code{\\link{run_mofa}}). Here, we can specify different options for\nthe data (data_options), the model (model_options) and the training (training_options, stochastic_options). Take a look at the\nindividual default options for an overview using the get_default_XXX_options functions above.\n}\n\\examples{\n# Using an existing simulated data with two groups and two views\nfile <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\n\n# Load data dt (in data.frame format)\nload(file) \n\n# Create the MOFA object\nMOFAmodel <- create_mofa(dt)\n\n# Prepare MOFA object using default options\nMOFAmodel <- prepare_mofa(MOFAmodel)\n\n# Prepare MOFA object changing some of the default model options values\nmodel_opts <- get_default_model_options(MOFAmodel)\nmodel_opts$num_factors <- 10\nMOFAmodel <- prepare_mofa(MOFAmodel, model_options = model_opts)\n}\n" }, { "path": "man/run_enrichment.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/enrichment.R\n\\name{run_enrichment}\n\\alias{run_enrichment}\n\\title{Run feature set Enrichment Analysis}\n\\usage{\nrun_enrichment(\n object,\n view,\n feature.sets,\n factors = \"all\",\n set.statistic = c(\"mean.diff\", \"rank.sum\"),\n statistical.test = c(\"parametric\", \"cor.adj.parametric\", \"permutation\"),\n sign = c(\"all\", \"positive\", \"negative\"),\n min.size = 10,\n nperm = 1000,\n p.adj.method = \"BH\",\n alpha = 0.1,\n verbose = TRUE\n)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{view}{a character with the view name, or a numeric vector with the index of the view to use.}\n\n\\item{feature.sets}{data structure that holds feature set membership information. \nMust be a binary membership matrix (rows are feature sets and columns are features). See details below for some pre-built gene set matrices.}\n\n\\item{factors}{character vector with the factor names, or numeric vector with the index of the factors for which to perform the enrichment.}\n\n\\item{set.statistic}{the set statistic computed from the feature statistics. Must be one of the following: \"mean.diff\" (default) or \"rank.sum\".}\n\n\\item{statistical.test}{the statistical test used to compute the significance of the feature set statistics under a competitive null hypothesis.\nMust be one of the following: \"parametric\" (default), \"cor.adj.parametric\", \"permutation\".}\n\n\\item{sign}{use only \"positive\" or \"negative\" weights. Default is \"all\".}\n\n\\item{min.size}{Minimum size of a feature set (default is 10).}\n\n\\item{nperm}{number of permutations. Only relevant if statistical.test is set to \"permutation\". Default is 1000}\n\n\\item{p.adj.method}{Method to adjust p-values factor-wise for multiple testing. Can be any method in p.adjust.methods(). Default uses Benjamini-Hochberg procedure.}\n\n\\item{alpha}{FDR threshold to generate lists of significant pathways. Default is 0.1}\n\n\\item{verbose}{boolean indicating whether to print messages on progress}\n}\n\\value{\na list with five elements: \n\\item{\\strong{pval}:}{ matrices with nominal p-values. }\n\\item{\\strong{pval.adj}:}{ matrices with FDR-adjusted p-values. }\n\\item{\\strong{feature.statistics}:}{ matrices with the local (feature-wise) statistics. }\n\\item{\\strong{set.statistics}:}{ matrices with the global (gene set-wise) statistics. }\n\\item{\\strong{sigPathways}}{ list with significant pathways per factor. }\n}\n\\description{\nMethod to perform feature set enrichment analysis. Here we use a slightly modified version of the \\code{\\link[PCGSE]{pcgse}} function.\n}\n\\details{\nThe aim of this function is to relate each factor to pre-defined biological pathways by performing a gene set enrichment analysis on the feature weights. \\cr\n This function is particularly useful when a factor is difficult to characterise based only on the genes with the highest weight. \\cr\n We provide a few pre-built gene set matrices in the MOFAdata package. See \\code{https://github.com/bioFAM/MOFAdata} for details. \\cr\n The function we implemented is based on the \\code{\\link[PCGSE]{pcgse}} function with some modifications. \n Please read this paper https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4543476 for details on the math.\n}\n" }, { "path": "man/run_mofa.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/run_mofa.R\n\\name{run_mofa}\n\\alias{run_mofa}\n\\title{Train a MOFA model}\n\\usage{\nrun_mofa(object, outfile = NULL, save_data = TRUE, use_basilisk = FALSE)\n}\n\\arguments{\n\\item{object}{an untrained \\code{\\link{MOFA}} object}\n\n\\item{outfile}{output file for the model (.hdf5 format). If \\code{NULL}, a temporary file is created.}\n\n\\item{save_data}{logical indicating whether to save the training data in the hdf5 file. \nThis is useful for some downstream analysis (mainly functions with the prefix \\code{plot_data}), but it can take a lot of disk space.}\n\n\\item{use_basilisk}{use \\code{basilisk} to automatically install a conda environment with mofapy2 and all dependencies? \nIf \\code{FALSE} (default), you should specify the right python binary when loading R with \\code{reticulate::use_python(..., force=TRUE)}\nor the right conda environment with \\code{reticulate::use_condaenv(..., force=TRUE)}.}\n}\n\\value{\na trained \\code{\\link{MOFA}} object\n}\n\\description{\nFunction to train an untrained \\code{\\link{MOFA}} object.\n}\n\\details{\nThis function is called once a MOFA object has been prepared (using \\code{\\link{prepare_mofa}})\nIn this step the R package calls the \\code{mofapy2} Python package, where model training is performed. \\cr\nThe interface with Python is done with the \\code{\\link{reticulate}} package. \nIf you have several versions of Python installed and R is not detecting the correct one, \nyou can change it using \\code{reticulate::use_python} when loading the R session. \nAlternatively, you can let us install mofapy2 for you using \\code{basilisk} if you set use_basilisk to \\code{TRUE}\n}\n\\examples{\n# Load data (in data.frame format)\nfile <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\nload(file) \n\n# Create the MOFA object\nMOFAmodel <- create_mofa(dt)\n\n# Prepare the MOFA object with default options\nMOFAmodel <- prepare_mofa(MOFAmodel)\n\n# Run the MOFA model\n\\dontrun{ MOFAmodel <- run_mofa(MOFAmodel, use_basilisk = TRUE) }\n}\n" }, { "path": "man/run_tsne.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/dimensionality_reduction.R\n\\name{run_tsne}\n\\alias{run_tsne}\n\\title{Run t-SNE on the MOFA factors}\n\\usage{\nrun_tsne(object, factors = \"all\", groups = \"all\", ...)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{factors}{character vector with the factor names, or numeric vector with the indices of the factors to use, or \"all\" to use all factors (default).}\n\n\\item{groups}{character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use all groups (default).}\n\n\\item{...}{arguments passed to \\code{\\link{Rtsne}}}\n}\n\\value{\nReturns a \\code{\\link{MOFA}} object with the \\code{MOFAobject@dim_red} slot filled with the t-SNE output\n}\n\\description{\nRun t-SNE on the MOFA factors\n}\n\\details{\nThis function calls \\code{\\link[Rtsne]{Rtsne}} to calculate a TSNE representation from the MOFA factors.\nSubsequently, you can plot the TSNE representation with \\code{\\link{plot_dimred}} or fetch the coordinates using \\code{plot_dimred(..., method=\"TSNE\", return_data=TRUE)}. \nRemember to use set.seed before the function call to get reproducible results.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Run\n\\dontrun{ model <- run_tsne(model, perplexity = 15) }\n\n# Plot\n\\dontrun{ model <- plot_dimred(model, method=\"TSNE\") }\n\n# Fetch data\n\\dontrun{ tsne.df <- plot_dimred(model, method=\"TSNE\", return_data=TRUE) }\n\n}\n" }, { "path": "man/run_umap.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/dimensionality_reduction.R\n\\name{run_umap}\n\\alias{run_umap}\n\\title{Run UMAP on the MOFA factors}\n\\usage{\nrun_umap(\n object,\n factors = \"all\",\n groups = \"all\",\n n_neighbors = 30,\n min_dist = 0.3,\n metric = \"cosine\",\n ...\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{factors}{character vector with the factor names, or numeric vector with the indices of the factors to use, or \"all\" to use all factors (default).}\n\n\\item{groups}{character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use all groups (default).}\n\n\\item{n_neighbors}{number of neighbouring points used in local approximations of manifold structure. Larger values will result in more global structure being preserved at the loss of detailed local structure. In general this parameter should often be in the range 5 to 50.}\n\n\\item{min_dist}{This controls how tightly the embedding is allowed compress points together. Larger values ensure embedded points are more evenly distributed, while smaller values allow the algorithm to optimise more accurately with regard to local structure. Sensible values are in the range 0.01 to 0.5}\n\n\\item{metric}{choice of metric used to measure distance in the input space}\n\n\\item{...}{arguments passed to \\code{\\link[uwot]{umap}}}\n}\n\\value{\nReturns a \\code{\\link{MOFA}} object with the \\code{MOFAobject@dim_red} slot filled with the UMAP output\n}\n\\description{\nRun UMAP on the MOFA factors\n}\n\\details{\nThis function calls \\code{\\link[uwot]{umap}} to calculate a UMAP representation from the MOFA factors\nFor details on the hyperparameters of UMAP see the documentation of \\code{\\link[uwot]{umap}}.\nSubsequently, you can plot the UMAP representation with \\code{\\link{plot_dimred}} or fetch the coordinates using \\code{plot_dimred(..., method=\"UMAP\", return_data=TRUE)}. \nRemember to use set.seed before the function call to get reproducible results.\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Change hyperparameters passed to umap\n\\dontrun{ model <- run_umap(model, min_dist = 0.01, n_neighbors = 10) }\n# Plot\n\\dontrun{ model <- plot_dimred(model, method=\"UMAP\") }\n\n# Fetch data\n\\dontrun{ umap.df <- plot_dimred(model, method=\"UMAP\", return_data=TRUE) }\n\n}\n" }, { "path": "man/samples_metadata.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/set_methods.R\n\\name{samples_metadata}\n\\alias{samples_metadata}\n\\alias{samples_metadata<-}\n\\alias{samples_metadata,MOFA-method}\n\\alias{samples_metadata<-,MOFA,data.frame-method}\n\\title{samples_metadata: retrieve sample metadata}\n\\usage{\nsamples_metadata(object)\n\nsamples_metadata(object) <- value\n\n\\S4method{samples_metadata}{MOFA}(object)\n\n\\S4method{samples_metadata}{MOFA,data.frame}(object) <- value\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{value}{data frame with sample metadata, it must at least contain the columns \\code{sample} and \\code{group}.\nThe order of the rows must match the order of \\code{samples_names(object)}}\n}\n\\value{\na data frame with sample metadata\n}\n\\description{\nsamples_metadata: retrieve sample metadata\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nsamples_metadata(model)\n}\n" }, { "path": "man/samples_names.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/set_methods.R\n\\name{samples_names}\n\\alias{samples_names}\n\\alias{samples_names<-}\n\\alias{samples_names,MOFA-method}\n\\alias{samples_names<-,MOFA,list-method}\n\\title{samples_names: set and retrieve sample names}\n\\usage{\nsamples_names(object)\n\nsamples_names(object) <- value\n\n\\S4method{samples_names}{MOFA}(object)\n\n\\S4method{samples_names}{MOFA,list}(object) <- value\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{value}{list of character vectors with the sample names for every group}\n}\n\\value{\nlist of character vectors with the sample names for each group\n}\n\\description{\nsamples_names: set and retrieve sample names\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nsamples_names(model)\n}\n" }, { "path": "man/select_model.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/compare_models.R\n\\name{select_model}\n\\alias{select_model}\n\\title{Select a model from a list of trained \\code{\\link{MOFA}} objects based on the best ELBO value}\n\\usage{\nselect_model(models, plot = FALSE)\n}\n\\arguments{\n\\item{models}{a list containing \\code{\\link{MOFA}} objects.}\n\n\\item{plot}{boolean indicating whether to show a plot of the ELBO for each model instance}\n}\n\\value{\nA \\code{\\link{MOFA}} object\n}\n\\description{\nDifferent objects of \\code{\\link{MOFA}} are compared in terms of the final value of the ELBO statistics\nand the model with the highest ELBO value is selected.\n}\n" }, { "path": "man/set_covariates.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/mefisto.R\n\\name{set_covariates}\n\\alias{set_covariates}\n\\title{Add covariates to a MOFA model}\n\\usage{\nset_covariates(object, covariates)\n}\n\\arguments{\n\\item{object}{an untrained \\code{\\link{MOFA}}}\n\n\\item{covariates}{Sample-covariates to be passed to the model.\nThis can be either:\n\\itemize{\n \\item{a character, specifying columns already present in the samples_metadata of the object}\n \\item{a data.frame with columns \"sample\", \"covariate\", \"value\". Sample names need to match those present in the data}\n \\item{a matrix with samples in columns and covariate(s) in row(s)}\n }\nNote that the covariate should be numeric and continuous.}\n}\n\\value{\nReturns an untrained \\code{\\link{MOFA}} with covariates filled in the corresponding slots\n}\n\\description{\nFunction to add continuous covariate(s) to a \\code{\\link{MOFA}} object for training with MEFISTO\n}\n\\details{\nTo activate the functional MEFISTO framework, specify mefisto_options when preparing the training using \\code{prepare_mofa}\n}\n\\examples{\n#' # Simulate data\ndd <- make_example_data(sample_cov = seq(0,1,length.out = 100), n_samples = 100, n_factors = 4)\n\n# Create MOFA object\nsm <- create_mofa(data = dd$data)\n\n# Add a covariate\nsm <- set_covariates(sm, covariates = dd$sample_cov)\nsm\n}\n" }, { "path": "man/subset_factors.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/subset.R\n\\name{subset_factors}\n\\alias{subset_factors}\n\\title{Subset factors}\n\\usage{\nsubset_factors(object, factors, recalculate_variance_explained = TRUE)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{factors}{character vector with the factor names, or numeric vector with the index of the factors.}\n\n\\item{recalculate_variance_explained}{logical indicating whether to recalculate variance explained values. Default is \\code{TRUE}.}\n}\n\\value{\nA \\code{\\link{MOFA}} object\n}\n\\description{\nMethod to subset (or sort) factors\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Subset factors 1 to 3\nmodel <- subset_factors(model, factors = 1:3)\n}\n" }, { "path": "man/subset_features.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/subset.R\n\\name{subset_features}\n\\alias{subset_features}\n\\title{Subset features}\n\\usage{\nsubset_features(object, view, features)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{view}{character vector with the view name or integer with the view index}\n\n\\item{features}{character vector with the sample names, numeric vector with the feature indices \nor logical vector with the samples to be kept as TRUE.}\n}\n\\value{\nA \\code{\\link{MOFA}} object\n}\n\\description{\nMethod to subset (or sort) features\n}\n" }, { "path": "man/subset_groups.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/subset.R\n\\name{subset_groups}\n\\alias{subset_groups}\n\\title{Subset groups}\n\\usage{\nsubset_groups(object, groups)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{groups}{character vector with the groups names, numeric vector with the groups indices\nor logical vector with the groups to be kept as TRUE.}\n}\n\\value{\nA \\code{\\link{MOFA}} object\n}\n\\description{\nMethod to subset (or sort) groups\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Subset the first group\nmodel <- subset_groups(model, groups = 1)\n}\n" }, { "path": "man/subset_samples.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/subset.R\n\\name{subset_samples}\n\\alias{subset_samples}\n\\title{Subset samples}\n\\usage{\nsubset_samples(object, samples)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{samples}{character vector with the sample names or numeric vector with the sample indices.}\n}\n\\value{\nA \\code{\\link{MOFA}} object\n}\n\\description{\nMethod to subset (or sort) samples\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# (TO-DO) Remove a specific sample from the model (an outlier)\n}\n" }, { "path": "man/subset_views.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/subset.R\n\\name{subset_views}\n\\alias{subset_views}\n\\title{Subset views}\n\\usage{\nsubset_views(object, views)\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{views}{character vector with the views names, numeric vector with the views indices,\nor logical vector with the views to be kept as TRUE.}\n}\n\\value{\nA \\code{\\link{MOFA}} object\n}\n\\description{\nMethod to subset (or sort) views\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\n\n# Subset the first view\nmodel <- subset_views(model, views = 1)\n}\n" }, { "path": "man/summarise_factors.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/correlate_covariates.R\n\\name{summarise_factors}\n\\alias{summarise_factors}\n\\title{Summarise factor values using external groups}\n\\usage{\nsummarise_factors(\n object,\n df,\n factors = \"all\",\n groups = \"all\",\n abs = FALSE,\n return_data = FALSE\n)\n}\n\\arguments{\n\\item{object}{a trained \\code{\\link{MOFA}} object.}\n\n\\item{df}{a data.frame with the columns \"sample\" and \"level\", where level is a factor with discrete group assignments for each sample.}\n\n\\item{factors}{character vector with the factor name(s), or numeric vector with the index of the factor(s) to use. Default is 'all'.}\n\n\\item{groups}{character vector with the groups names, or numeric vector with the indices of the groups of samples to use, or \"all\" to use samples from all groups.}\n\n\\item{abs}{logical indicating whether to take the absolute value of the factors (default is \\code{FALSE}).}\n\n\\item{return_data}{logical indicating whether to return the fa instead of plotting}\n}\n\\value{\nA \\code{\\link{ggplot}} object or a \\code{data.frame} if return_data is TRUE\n}\n\\description{\nFunction to summarise factor values using a discrete grouping of samples.\n}\n" }, { "path": "man/views_names.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/set_methods.R\n\\name{views_names}\n\\alias{views_names}\n\\alias{views_names<-}\n\\alias{views_names,MOFA-method}\n\\alias{views_names<-,MOFA,character-method}\n\\title{views_names: set and retrieve view names}\n\\usage{\nviews_names(object)\n\nviews_names(object) <- value\n\n\\S4method{views_names}{MOFA}(object)\n\n\\S4method{views_names}{MOFA,character}(object) <- value\n}\n\\arguments{\n\\item{object}{a \\code{\\link{MOFA}} object.}\n\n\\item{value}{character vector with the names for each view}\n}\n\\value{\ncharacter vector with the names for each view\n}\n\\description{\nviews_names: set and retrieve view names\n}\n\\examples{\n# Using an existing trained model on simulated data\nfile <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(file)\nviews_names(model)\nviews_names(model) <- c(\"viewA\", \"viewB\")\n}\n" }, { "path": "setup.py", "content": "import sys\nimport os\nfrom setuptools import setup\nfrom setuptools import find_packages\n\nexec(open(os.path.join(os.path.dirname(__file__), 'mofapy2', 'version.py')).read())\n\ndef setup_package():\n install_requires = ['pandas', 'scipy>=1.5.1', 'numpy', 'sklearn', 'argparse', 'h5py', 'dtw-python>=1.1.5']\n metadata = dict(\n name = 'mofapy2',\n version = __version__,\n description = 'Multi-Omics Factor Analysis v2, a statistical framework for the integration of multi-group and multi-omics data',\n url = 'http://github.com/bioFAM/MOFA2',\n author = 'Ricard Argelaguet , Damien Arnol, Danila Bredikhin, Britta Velten ',\n license = 'LGPL-3.0',\n packages = find_packages(),\n install_requires = install_requires\n )\n\n setup(**metadata)\n\n\nif __name__ == '__main__':\n if sys.version_info < (2,7):\n sys.exit('Sorry, Python < 2.7 is not supported')\n \n setup_package()\n\n\n" }, { "path": "tests/testthat/barcodes.tsv", "content": "CACCGGGACGTGTA-1\nCGTGTAGAGTTCAG-1\nCCTGCAACACGTTG-1\nCCGATAGACCTAAG-1\nGATATAACACGCAT-1\nTACTACTGATGTCG-1\nAGCCTCACTGTCAG-1\nCGGAATTGCACTAG-1\nACGTCCTGATAAGG-1\nGAAACCTGGACTAC-1\nTACATCACTGAACC-1\nAAGTAACTCTGAAC-1\nGCAAGACTACTGGT-1\nATTGATGAAGGTTC-1\nTGAACCGAAAACGA-1\nGAAGGTCTGAAAGT-1\nTGATACCTCACTAG-1\nCGCCATTGAGAGGC-1\nCAGTTTACCCCAAA-1\nTCCCACGATCATTC-1\nCGATACGACAGGAG-1\nAGCCAATGTATCTC-1\nAAAGTTTGATCACG-1\nTCAGAGACTCCAGA-1\nATGTTCACCGTAGT-1\nAGCGCCGACAGAGG-1\nCCCTCAGACACTTT-1\nTTACACACGTGTTG-1\nGTGTACGATCAGTG-1\nCATCATACGGAGCA-1\nGCTCAGCTGTCTAG-1\nACAAATTGATTCTC-1\nAGTTAAACCACTTT-1\nGGCGGACTCTGACA-1\nCGGTAAACTCGCAA-1\nGAATGCACCTTCGC-1\nATCCAGGACGCTAA-1\nGTTCAACTTATGCG-1\nTAGGAGCTTGCATG-1\nCGTTAGGATCATTC-1\nTGATACCTTATGCG-1\nATACGGACAGACTC-1\nTCGGACCTATAAGG-1\nGTTAGGTGCCAGTA-1\nACCAGTGAGGGATG-1\nGTGATTCTGTCGAT-1\nTTCAGTACTCCTAT-1\nCTATTGTGGCAAGG-1\nTACCATTGTGAGGG-1\nCTCGCATGCTTAGG-1\nGAAACAGACATTCT-1\nTTAACCACTAAGGA-1\nATTGCACTGGAGCA-1\nAAATGTTGAACGAA-1\nTATCCAACCAGCTA-1\nGGTATCGATGAACC-1\nGAGCGCACGCGTAT-1\nCCAACCTGTTCGCC-1\nTTCAGTTGCCAAGT-1\nCCTGACTGTGTCTT-1\nGAACCAACCACAAC-1\nATGAGCACACAGCT-1\nTGATTCTGCCGAAT-1\nGAGATAGAAAAAGC-1\nAATCTCTGCTTTAC-1\nACACAGACACCTGA-1\nGTACCCTGTGAACC-1\nCATGTTACCTGAGT-1\nTCCACTCTGAGCTT-1\nCAAGACTGACCTGA-1\nAGCATCGAGTGAGG-1\nCGTACCACGCTACA-1\nCATTTGTGGGATCT-1\nTCGACCTGCCGATA-1\nACGTGATGTAACCG-1\nCACGGGACGTAGGG-1\nCCCAGTTGGGTACT-1\nATTTCTCTCACTTT-1\nTATGAATGTTTGCT-1\nATTCGACTGAATAG-1\nTAGTCTTGGGACTT-1\nACTTAAGACCACAA-1\nAGGAAATGAGGAGC-1\nCGAGGGCTACGACT-1\nGTTAGGTGCCCAAA-1\nAACCTTACGCGAGA-1\nTTACTCGAAGAATG-1\nCTCAGCACTCTAGG-1\nCGACCGGATGGAAA-1\nGTCGACCTGTTCAG-1\nTTTCGAACTCTCAT-1\nGAAATACTTCCTCG-1\nCGAGAACTAAGGCG-1\nGAAGTCTGTCGCAA-1\nTTCGTATGTCCTTA-1\nACTTGGGATTGACG-1\nGCACCACTGTTTGG-1\nAGACTGACCCTTTA-1\nTCCTAAACATCGAC-1\nACTTAAGAACCACA-1\nGCTAGAACGGATCT-1\nTATTTCCTATTGGC-1\nTAACATGACACTAG-1\nTACTTGACTCCTCG-1\nACAATTGATGACTG-1\nGGATGTACCAAAGA-1\nATTGGTCTGACTAC-1\nAGGATGCTTTAGGC-1\nTGCACAGACGACAT-1\nGCCTACACCTTGAG-1\nCAACCAGAGTTCAG-1\nTACGATCTCACTGA-1\nGGCGCATGCTCCAC-1\nGACTCCTGGGTTAC-1\nCATACTACCTGAAC-1\nTTGAGGTGGACGGA-1\nGAAAGATGCTGATG-1\nTTTCAGTGTCACGA-1\nCCAAGATGTTTCAC-1\nAGGATGCTTTACCC-1\nAGAAACGAAAGTAG-1\nCACCTGACTCGTAG-1\nACTTGTACCCGAAT-1\nACACGATGACGCAT-1\nCCACTGACCCGCTT-1\nGGCATATGTGTGAC-1\nGAAAGATGATTTCC-1\nCACCGGGATTCGGA-1\nAGTTATGAACAGTC-1\nCCAACCTGACGTAC-1\nAAGAGATGGGTAGG-1\nGGGATGGATACTTC-1\nGCCTCAACTCTTTG-1\nTGTATCTGTTAGGC-1\nTATTTCCTATTCCC-1\nGATTTAGACACTCC-1\nAGTACTCTCGGTAT-1\nCCAGTCTGCGGAGA-1\nTTAGAATGTGGTGT-1\nCGATACGAACAGTC-1\nGCAGGGCTAAGGGC-1\nGGAACTTGAAGGTA-1\n" }, { "path": "tests/testthat/genes.tsv", "content": "ENSGXXXXXX\tTDRG1\nENSGXXXXXX\tTCTE1\nENSGXXXXXX\tCCDC106\nENSGXXXXXX\tTIGD6\nENSGXXXXXX\tMSANTD3-TMEFF1\nENSGXXXXXX\tQRSL1\nENSGXXXXXX\tCDK18\nENSGXXXXXX\tCTB-25B13.6\nENSGXXXXXX\tELAVL1\nENSGXXXXXX\tTRPC5OS\nENSGXXXXXX\tAC016995.3\nENSGXXXXXX\tRP11-899L11.1\nENSGXXXXXX\tGAS1\nENSGXXXXXX\tRP5-1077H22.1\nENSGXXXXXX\tLINC00566\nENSGXXXXXX\tRP11-383C5.3\nENSGXXXXXX\tRP1-59D14.1\nENSGXXXXXX\tRPP40\nENSGXXXXXX\tRP11-74C3.1\nENSGXXXXXX\tRGCC\nENSGXXXXXX\tOLIG3\nENSGXXXXXX\tAP2B1\nENSGXXXXXX\tELL3\nENSGXXXXXX\tCTD-2521M24.5\nENSGXXXXXX\tANKLE1\nENSGXXXXXX\tODF2L\nENSGXXXXXX\tRP11-128M1.1\nENSGXXXXXX\tRP11-71H9.2\nENSGXXXXXX\tHOXB-AS3\nENSGXXXXXX\tACSBG2\nENSGXXXXXX\tRP11-261P24.2\nENSGXXXXXX\tIL3\nENSGXXXXXX\tSLC10A4\nENSGXXXXXX\tAHSP\nENSGXXXXXX\tPROSER1\nENSGXXXXXX\tTPRXL\nENSGXXXXXX\tLINC00659\nENSGXXXXXX\tHOXC5\nENSGXXXXXX\tACYP2\nENSGXXXXXX\tGALR3\nENSGXXXXXX\tTFF2\nENSGXXXXXX\tPIM2\nENSGXXXXXX\tSTMN3\nENSGXXXXXX\tRP11-73M7.6\nENSGXXXXXX\tRP11-350G8.5\nENSGXXXXXX\tRP11-26P13.2\nENSGXXXXXX\tRP11-692N5.1\nENSGXXXXXX\tRP11-1030E3.1\nENSGXXXXXX\tCTC-360P9.2\nENSGXXXXXX\tNEURL1\nENSGXXXXXX\tIAH1\nENSGXXXXXX\tRP1-102E24.8\nENSGXXXXXX\tRP11-197N18.7\nENSGXXXXXX\tC11orf21\nENSGXXXXXX\tRPA4\nENSGXXXXXX\tRP11-271K21.11\nENSGXXXXXX\tBMP7\nENSGXXXXXX\tLINC00502\nENSGXXXXXX\tRP11-50B3.2\nENSGXXXXXX\tLINC00112\nENSGXXXXXX\tRP1-137K2.2\nENSGXXXXXX\tLIPC\nENSGXXXXXX\tEIF2AK4\nENSGXXXXXX\tRP4-753F5.1\nENSGXXXXXX\tLRTM2\nENSGXXXXXX\tAC003051.1\nENSGXXXXXX\tRP11-87G24.6\nENSGXXXXXX\tRP11-573G6.8\nENSGXXXXXX\tCOPRS\nENSGXXXXXX\tTRMT6\nENSGXXXXXX\tHOXD-AS2\nENSGXXXXXX\tRP11-203E8.1\nENSGXXXXXX\tLL0XNC01-116E7.2\nENSGXXXXXX\tZMYND12\nENSGXXXXXX\tTARSL2\nENSGXXXXXX\tWDR6\nENSGXXXXXX\tRP11-302F12.3\nENSGXXXXXX\tKCNH5\nENSGXXXXXX\tRP11-78A19.4\nENSGXXXXXX\tRP11-232D9.3\nENSGXXXXXX\tGTF2H3\nENSGXXXXXX\tRP11-173P15.3\nENSGXXXXXX\tLRRC27\nENSGXXXXXX\tMBTD1\nENSGXXXXXX\tRP11-24F11.2\nENSGXXXXXX\tGUCY2D\nENSGXXXXXX\tPDS5B\nENSGXXXXXX\tPIH1D1\nENSGXXXXXX\tCFLAR-AS1\nENSGXXXXXX\tZNF202\nENSGXXXXXX\tERRFI1\nENSGXXXXXX\tRPS12\nENSGXXXXXX\tH1FNT\nENSGXXXXXX\tRP11-514P8.7\nENSGXXXXXX\tDNAJA2\nENSGXXXXXX\tAC073409.1\nENSGXXXXXX\tCCDC181\nENSGXXXXXX\tAC108056.1\nENSGXXXXXX\tRP11-626H12.1\nENSGXXXXXX\tRP11-127B20.3\nENSGXXXXXX\tPER3\nENSGXXXXXX\tMAGEL2\nENSGXXXXXX\tLCE1E\nENSGXXXXXX\tRP1-266L20.2\nENSGXXXXXX\tMMP16\nENSGXXXXXX\tNKX2-1\nENSGXXXXXX\tTAOK2\nENSGXXXXXX\tRP11-498C9.15\nENSGXXXXXX\tRP11-492A10.1\nENSGXXXXXX\tAQP6\nENSGXXXXXX\tRP1-12G14.7\nENSGXXXXXX\tOR5B21\nENSGXXXXXX\tTYRP1\nENSGXXXXXX\tCTC-297N7.11\nENSGXXXXXX\tPTPLA\nENSGXXXXXX\tRP11-53A1.2\nENSGXXXXXX\tGOLGA6L6\nENSGXXXXXX\tTKTL1\nENSGXXXXXX\tCEP70\nENSGXXXXXX\tRP11-178L8.9\nENSGXXXXXX\tJTB\nENSGXXXXXX\tZNF493\nENSGXXXXXX\tC4orf27\nENSGXXXXXX\tLAMA2\nENSGXXXXXX\tPYCR2\nENSGXXXXXX\tPOLR3C\nENSGXXXXXX\tTNNT3\nENSGXXXXXX\tCTD-2139B15.5\nENSGXXXXXX\tAP000593.7\nENSGXXXXXX\tOR56A4\nENSGXXXXXX\tRP11-944L7.5\nENSGXXXXXX\tRP11-293M10.1\nENSGXXXXXX\tRP11-160H22.3\nENSGXXXXXX\tLCA5\nENSGXXXXXX\tHOXD10\nENSGXXXXXX\tFCGR1A\nENSGXXXXXX\tRP11-223C24.2\nENSGXXXXXX\tLINC00500\nENSGXXXXXX\tPLSCR5\nENSGXXXXXX\tFAM3A\nENSGXXXXXX\tAC100802.3\nENSGXXXXXX\tN4BP2L2\nENSGXXXXXX\tRP11-513G19.1\nENSGXXXXXX\tMETTL4\nENSGXXXXXX\tAC011518.1\nENSGXXXXXX\tRP11-344B5.2\nENSGXXXXXX\tRP11-265D19.6\nENSGXXXXXX\tNKX2-1-1\nENSGXXXXXX\tSIGLECL1\nENSGXXXXXX\tRP11-455F5.5\nENSGXXXXXX\tRP11-348J24.1\nENSGXXXXXX\tFRRS1L\nENSGXXXXXX\tINTS1\nENSGXXXXXX\tAC073236.3\nENSGXXXXXX\tMSTO1\nENSGXXXXXX\tDGCR6L\nENSGXXXXXX\tRP11-97C16.1\nENSGXXXXXX\tRP11-16P20.3\nENSGXXXXXX\tSMAD7\nENSGXXXXXX\tMARS\nENSGXXXXXX\tRP11-179A16.2\nENSGXXXXXX\tELOF1\nENSGXXXXXX\tLINC00654\nENSGXXXXXX\tRP11-440L14.3\nENSGXXXXXX\tRREB1\nENSGXXXXXX\tTBC1D19\nENSGXXXXXX\tFAT3\nENSGXXXXXX\tCTC-436K13.5\nENSGXXXXXX\tINTS8\nENSGXXXXXX\tKIAA1549L\nENSGXXXXXX\tEFCAB7\nENSGXXXXXX\tSPOPL\nENSGXXXXXX\tNAA50\nENSGXXXXXX\tCBLN3\nENSGXXXXXX\tCANT1\nENSGXXXXXX\tC17orf74\nENSGXXXXXX\tLINC00265\nENSGXXXXXX\tRP11-157P1.4\nENSGXXXXXX\tPRRT4\nENSGXXXXXX\tOAT\nENSGXXXXXX\tAC145212.1\nENSGXXXXXX\tSLC6A6\nENSGXXXXXX\tWDR55\nENSGXXXXXX\tRAPGEF3\nENSGXXXXXX\tRP11-321M21.3\nENSGXXXXXX\tRBFOX1\nENSGXXXXXX\tTMEM249\nENSGXXXXXX\tCTD-2357A8.3\nENSGXXXXXX\tKCNT2\nENSGXXXXXX\tUBE2E1\nENSGXXXXXX\tRP11-162D16.2\nENSGXXXXXX\tCD244\nENSGXXXXXX\tXX-FW80269A6.1\nENSGXXXXXX\tRP5-1065P14.2\nENSGXXXXXX\tTREX2\nENSGXXXXXX\tRIC8B\nENSGXXXXXX\tGTSF1\nENSGXXXXXX\tGS1-166A23.2\nENSGXXXXXX\tTAF1A\nENSGXXXXXX\tRP11-149I9.2\nENSGXXXXXX\tNARS\nENSGXXXXXX\tPRKG1\nENSGXXXXXX\tCT47A9\nENSGXXXXXX\tCDC25B\nENSGXXXXXX\tLA16c-325D7.1\nENSGXXXXXX\tMOBP\nENSGXXXXXX\tCCDC85C\nENSGXXXXXX\tRP11-603J24.5\nENSGXXXXXX\tMBTPS1\nENSGXXXXXX\tARL1\nENSGXXXXXX\tAC104135.3\nENSGXXXXXX\tRP1-59D14.5\nENSGXXXXXX\tRP11-244H18.3\nENSGXXXXXX\tCTD-2521M24.10\nENSGXXXXXX\tMID1IP1\nENSGXXXXXX\tRP11-262K1.1\nENSGXXXXXX\tMYL6\nENSGXXXXXX\tHOXD11\nENSGXXXXXX\tGTF3C6\nENSGXXXXXX\tPPP1R9B\nENSGXXXXXX\tNMI\nENSGXXXXXX\tCTD-2015A6.1\nENSGXXXXXX\tSPRY1\nENSGXXXXXX\tAC004014.3\nENSGXXXXXX\tRP11-110I1.6\nENSGXXXXXX\tHK1\nENSGXXXXXX\tPEX5L-AS2\nENSGXXXXXX\tRP11-109A6.3\nENSGXXXXXX\tERI1\nENSGXXXXXX\tDOCK5\nENSGXXXXXX\tAC012506.2\nENSGXXXXXX\tTTC23L\nENSGXXXXXX\tHLA-DRA\nENSGXXXXXX\tMON1A\nENSGXXXXXX\tRP11-667M19.10\nENSGXXXXXX\tAC138472.6\nENSGXXXXXX\tRP11-339B21.11\nENSGXXXXXX\tRP11-130C19.3\nENSGXXXXXX\tAPAF1\nENSGXXXXXX\tBACH1\nENSGXXXXXX\tATF5\nENSGXXXXXX\tIL1RAP\nENSGXXXXXX\tCTD-2227C6.2\nENSGXXXXXX\tRARB\nENSGXXXXXX\tRP11-465L10.10\nENSGXXXXXX\tFADS6\nENSGXXXXXX\tNDST4\nENSGXXXXXX\tTAF9\nENSGXXXXXX\tRP11-38M8.1\nENSGXXXXXX\tPIAS1\nENSGXXXXXX\tSCN9A\nENSGXXXXXX\tCTD-3105H18.16\n" }, { "path": "tests/testthat/matrix.csv", "content": "V1,V2,V3,V4,V5,V6,V7,V8,V9,V10,V11,V12,V13,V14,V15,V16,V17,V18,V19,V20,V21,V22,V23,V24,V25,V26,V27,V28,V29,V30,V31,V32,V33,V34,V35,V36,V37,V38,V39,V40,V41,V42,V43,V44,V45,V46,V47,V48,V49,V50\n5.6677905966163795,-4.772962322864686,-10.841580908135525,-2.209881300903652,-5.786124286357204,-9.447302083519922,-2.9608701221548905,5.180268422373425,0.9757778734454816,-2.767401772182076,-6.985494772072344,-2.788594807404795,-1.5926001949818696,0.0569611711405516,-0.9120965995131036,-4.80543375707097,-2.3234423144181644,8.95609509255886,-3.4936927768203905,5.422067761524336,6.383754556270587,3.985268674703266,0.6572030533705839,1.094535937479605,-10.026315159810164,-3.6674609727917407,-2.1679147907017406,-9.691009576633661,0.2667420385134678,-2.317717569008728,-2.914704667769489,5.314974026907998,-0.21997020012709623,2.1234113415946023,-9.08547311012854,-3.0390059841327064,2.4073014944776623,0.32007278736315004,-1.8231019136195825,-0.5601161170648448,-2.5375225634632717,-4.480048558430584,7.304791020003927,-1.7565655946155458,-9.228884629768455,-1.1853010986448131,-5.696114606003398,-10.644524438514612,0.36508187279680104,-9.511060963252003\n-4.903912005007914,-6.255865830401945,-1.2828594591251896,-2.6994999171645593,1.529776884849898,-0.14805958887925552,-4.92429577976289,2.3932623195918916,0.04092726272616587,-2.7530019546075204,0.61423408246408,-1.2124733858988244,-4.81186218596541,-3.48213375877448,-2.376363448809085,-5.976695335662106,0.20133142135774473,2.075791479461702,-2.1967454189313114,-1.3788860954278188,-2.0126929339463464,-9.641250225821105,-0.9809086946453254,0.956352054712345,0.2060141774783424,0.6989806526715334,-7.3964748720647,0.6457450797672339,-0.8692632648273646,-1.8350737491863878,-1.4908961736042357,0.8483323482193889,-1.3560557560546607,9.30923436841894,0.8179448312462206,-2.7156160912058596,1.6618772737520005,-2.2758791605211166,-1.2681515032665613,3.545410055854629,-1.6325673859737837,-3.7934024153830035,-2.8656158962174256,-2.1857552277735977,-1.941415445182147,-1.1045638835979548,-0.6582882956601042,-2.597403689128013,3.23273311560339,1.1954938411668325\n-1.6630564425359273,1.4660716767816937,-3.3543708667169643,-4.747852390173787,5.175772089943396,3.8647270684090316,0.3716776169760889,3.446919138917524,-3.5766947142248773,-1.4419821185285617,-1.883008503777993,6.241386766249099,-1.0560629299575153,-5.988097488789856,-3.4858383619320357,-6.428117425646453,-0.8275758947296596,-1.1756116329158848,-1.4287283014493717,4.322595033687989,-1.798026011344816,-3.703995208194979,-0.5823149380497668,1.5275131409009983,-6.382582234836498,-4.521955787849564,0.7095672730843253,0.22446533629229726,-2.5628226796379034,-2.7700592934308896,-1.9004833941498762,-7.092578410827339,1.1564805951843644,-4.844473422152349,-3.3302250274741025,0.7102415224579148,-2.3461192928264167,-0.6281103326952658,1.3513274965655961,1.250559581486804,-2.2203944926057972,-7.339100532389258,-4.649385822631681,0.3473741924722748,7.725143505943829,-4.292240163442733,-0.7677091745620812,6.984631412067042,-0.22326398047643436,2.1416377744113118\n0.91180136905286,0.9172208892013556,-6.341103562254801,-2.712200203241552,0.6301528084008212,-1.932886388073422,-0.49245210509387405,2.561514831311895,-0.9392122850317073,-3.3959610544843377,-2.540271367626355,0.9560560808325851,-2.389739137988473,-1.2417283427375296,-1.4758875658716923,-3.8001190366526014,-1.436789818946997,0.3907781084471065,-3.886228727232629,4.085194860330388,1.1650476460208514,1.0739843915520324,-1.5677006307394257,2.032472203741211,-5.455501634036393,-6.863536366221897,2.207695188207163,-2.7280517207880486,-1.043100425064087,-0.6195472334853985,-4.344020451346337,-2.84581109951762,1.1013788026307507,-0.1704271395614656,-6.419786313610798,0.5684252600382795,-2.6080949738437633,-1.9555675532365857,-1.6761251005513411,1.7713609613085821,-1.6089224871487207,-6.6393024269971,3.1534633633320146,2.026464312871349,-0.0807129000582767,-2.22730982505314,-2.2332694605417047,3.1726489961867665,-1.3027917575160086,-3.909438657619539\n-5.650783670228126,-13.206756840062786,-15.180409784465045,-13.385459399509731,-9.986801816307642,-6.0217695193489105,-11.169679719702794,-1.0470442252466197,-9.600281398940627,-5.248414512721558,-11.250155880389261,-2.856946166105229,-11.572870683299113,-11.867274747149718,-6.408393740823626,-13.443813766610003,-10.192448420413958,-3.510886494117525,-10.094614437105244,-0.3491639512437712,-6.910476174846227,-5.173769302344667,-11.129381117196502,-6.784228081016155,-13.29421055221947,-8.163620331221738,-9.589798704784803,-10.625607654095647,-13.66332304755879,-8.735631860056195,-6.239187148874542,-4.995787869624762,-11.070241991674033,-4.679393202878272,-13.073336342891952,-15.687421253152435,-4.87452619224537,-8.563082649566036,-3.8113947357729474,-6.008152775302346,-4.00163464013357,-17.850850740771115,-3.217091919228515,-11.367912124947017,-6.875782144319771,-11.454032748697802,-5.706258592676169,-12.904687526666036,-6.968064133381645,-12.968826518259661\n-2.0922015467642647,-4.460490099538217,-9.939945572272872,-9.996193948891046,-0.17845774121156804,-5.0846466868317775,-8.351213060011988,5.481742894398112,-4.040090255458912,-5.554537714934751,-6.978337419977086,-2.07807869757172,-5.928119587857869,-4.105514167443129,-3.1516011623389826,-11.64834803988012,-6.921652588262575,1.705080162230331,-3.8634208285744744,4.974499856562232,0.2867360064691953,-3.651256084005299,-6.668596991867458,0.36671699960464776,-8.018599942335182,-10.514031518846455,-3.813720907583003,-4.623013637722218,-4.931513652421778,-4.893200015123526,-6.639125633205192,-2.280572260808277,-8.637281506070742,1.322042106661276,-12.261747434790639,-6.879031940399698,-2.619125300097242,-4.8791910439254575,-2.654205098248424,6.135466920985012,-5.383512889138441,-18.2573354678096,-2.7846669331134444,-3.1137481289386018,0.6698262258492209,-8.104178112759108,-7.065200552036771,-1.5142325020837475,2.0745410602722174,-5.485779501010603\n-3.5329845039997125,4.327812476500276,-2.158727213477263,-0.09061579609665885,2.639408847603761,2.747240253913329,-0.08908551029777667,5.633869994269129,-2.280101508210608,-5.722845827472765,-0.43810943171572936,7.880795242134933,-2.1521252647205356,-2.174866274412867,-2.618391606900421,2.7279733146509133,3.1242022407769428,-3.5915899450294466,-1.339939437686014,6.7321402785198865,-3.2308144793104603,-2.216180757136446,1.2486026034705615,2.8218622859578115,-0.08324338823408484,0.7454335555153223,4.633249188817489,1.601325424860412,-2.426288501845983,-0.08247447423574952,-1.3826420832755881,-5.95005489646438,7.489196554540411,1.9697005300815358,3.0350984753930756,3.561692432359125,-2.2998018067509327,0.5659200121866553,4.2712583676388105,2.6096983474401667,3.7984769010629553,-3.7791329132714306,2.0645169079688253,3.6879022590107695,10.980173234744454,-0.14391854587383157,-0.638736306704018,7.075024547566713,-4.070024418800087,2.3597356151686664\n4.242078651433553,3.81418380907584,-0.6149330261662165,-1.700187019643458,3.329452777554978,-4.422578376412592,3.954766692143302,0.6524921465075579,-1.6574800731960702,-1.5884324660055968,-3.390955347501111,2.4708029600922328,3.6813002372310906,0.5468124559189754,-2.523562167986373,-3.4782467589756028,-3.74060813753078,1.5766230435227824,-1.6825359371328543,5.81661108574976,1.5901311556552282,2.5169243357594304,-0.12744826313023885,-0.8009555475228924,-8.327920673349047,-5.923960876607239,3.7112186607096813,-3.1535193998638102,-1.677590213719901,-0.8918052199379751,-3.4940466375450363,-3.0804711397762503,0.34156902781619525,-9.056160375336606,-9.928122572188766,3.2352786242992706,-3.686354991857656,1.083664769337687,-1.747246581435131,-2.8103232389492616,-2.6549203044487086,-4.253898397960296,-1.1098648258032637,4.295932036483787,1.2170544150485212,-1.3635540921589546,-2.7016041280466565,3.171891254773744,-1.761454303069832,-2.368699653538454\n-11.269259583670772,-9.805389621495818,-11.320887968499255,-11.386905414612784,-1.6997200691807655,1.6036626508479046,-8.995308428567107,5.676938578862654,-6.695111639127362,-4.825077334979873,-7.054327943009575,1.2677316334300535,-4.524039014638808,-13.12597972801467,-8.610203305862875,-13.061861202259205,-3.8675535255391997,-3.708927033918332,-1.3376059893014118,-1.381297864170823,-6.382511163993435,-8.01585370141623,-5.28224395959748,-3.3508040190136095,-5.343406300539025,-2.505427194007444,-7.840981427096676,-6.567719659127713,-4.492830022277239,-5.4467297067209675,0.16726654706477262,-4.762521292152137,-3.0888282127681066,4.9242144764666556,2.6324014639350546,-10.606655789019785,0.8735099614083388,-5.879485596355457,1.3433343210956044,-0.7498585827496083,-5.001064912600257,-10.138061657199412,-5.86600472044212,-11.867849701716185,5.428672527125926,-10.295935269522102,-5.661607040830257,-7.386449148358813,2.33091183707016,-1.5150795425479426\n-1.8708502192641796,-1.0563884885571009,-3.928403544208017,-2.4990378185148696,3.2853688210668346,2.6333061280601577,-4.014383369169726,3.518572660110852,0.9681058674207005,-3.6243365980491173,1.5410950037860718,-0.03231361900762989,-7.839447746136001,-1.7215279818358526,0.6914828501220225,-3.917532862537868,1.4262360972300465,0.8389166007068969,-3.9834445058766152,1.1463606742490233,0.45544485977969984,-5.10998407579212,-2.2626928951417566,5.233315789658328,-0.13830673811762528,-6.169725316920115,-2.0971189737773366,2.938753246871368,0.06069401590645551,-0.9433064127116013,-5.464040922374904,-2.360789348873897,0.15726826897342372,7.549027357816509,-2.4617085409481803,0.5152930202375566,-0.8765359214945394,-3.3221789728230275,-1.6375911103207335,8.40287194216557,-0.8794995021672488,-7.948433326720323,0.7061787909841213,2.4398810002396525,0.13885313759427498,-1.2612474017812014,0.40430097817145016,7.309883084101909,2.1259975263527027,0.21119970403906385\n-6.148196274854828,-2.95573773424717,-7.434825178407012,-10.586805796335877,4.734321128347609,-6.028555144625939,-10.520026753361945,11.684858588777617,-2.2595138461826685,-12.268164762915944,-7.884292069342257,-2.7935352267846443,-4.582269067309762,-3.220204777119691,-6.062055396863398,-10.560532534801602,-6.022067183405763,0.7526999561201322,-0.087119070812129,4.7877946717498014,-0.03825496378743498,-4.0732596334147235,-7.917282282061605,0.6455669745453152,-3.3465945692784302,-12.5232774960027,-3.9100823551928805,-4.7492374439893315,-0.7801420738038134,-3.953335843115299,-9.21794747734672,-2.0109098779775474,-4.102675254376376,9.126087383371551,-5.995034045212805,-3.8672914797091895,-0.8185843424907762,-5.911562123222572,-1.5672254123413663,9.717443865848264,-6.719729951070626,-17.639824182872523,-4.25590757171175,-0.9774679972612526,6.813850405447417,-8.210699533642929,-10.97754763636377,1.5096555149277586,7.53091240164572,-1.8640342146296716\n-4.977590533181835,-5.829826268650475,-9.34030317031672,-4.769669667894739,-1.0814368826739587,1.345044414826222,-5.302857249261143,5.705908727989611,-0.7166936304530749,-4.512514372451035,-3.291768140000639,-0.145882244477514,-5.124415292137225,-6.863082813357308,-3.7969131883610165,-6.125042925098645,0.9102630327400953,0.25158954514542486,-2.141836993651646,-1.1379814798985564,-0.8287667014509159,-2.775021929468083,-1.9388041888107415,1.3481505515712984,-2.7304585335087412,-3.3002356864277527,-4.371976211878159,-4.501731664649789,0.991465111919785,-2.069506851265815,-1.9069521951105837,-1.2166689160083424,3.1130229295565495,8.456547837874348,3.497355618214588,-3.739662796506711,2.3970945022352677,-3.8266247926071877,0.26643994889170775,1.6861409466985118,-2.493615089788988,-3.582814648201344,1.7334363180493697,-4.887083667737707,-0.17335993991803567,-4.000244725423498,-2.773844700631755,-2.7739000157863254,2.710966778716278,-2.2166975417986743\n-6.914238282173409,-3.4180373767043593,-10.89437200313452,-7.966408124672669,-1.9705670561934086,8.299242798683316,-6.17563457366253,1.2174198207178413,-3.688658382546098,1.427523321222092,-1.3320541253060312,-0.7914809301541916,-5.502829033619394,-8.03929318643968,-0.4599451109211056,-7.536006681801844,-1.1303280140186307,-6.2362264204218185,-0.4545872471804787,-3.981219803666048,-2.476152150731508,-0.5705409866168056,-5.3341598891062985,1.425482879944565,0.6698956938859146,-6.186086373016167,-0.9299593685952302,-0.1826751427924137,-0.7160143711475266,-1.6528826038808182,0.9649385580627909,-5.1182581815666115,-5.353897735640558,2.9085349580874293,2.9653512730052545,-8.218638514409232,-0.49623116507765663,-6.292926095148688,0.5713998296490775,5.254859424947489,-3.200520909771338,-8.89458665554238,-1.2442868495395725,-8.98750326480766,4.749337487393482,-8.531021181858836,-0.4645078905037694,2.8755271754847564,2.4624292552663682,-0.66471310070299094\n2.1992770749410173,7.527202100482432,-4.770751316011317,1.6408560676391277,3.1886242445082122,-4.164169037159468,6.683645413951781,3.8287613901982884,-0.4970283097351549,-4.318851976752217,-1.546792561517606,6.213221382341321,5.445942966855494,1.9071899757850608,-3.79762357126175,-0.5316674653270067,0.6546431518291499,0.206311787829903,-2.9448932955191607,10.327552126929746,1.7351836311639723,3.4643611997393546,4.303324998474329,2.911577475892535,-6.444210121867549,-3.2556409887637088,10.2756049515217,-3.5514921563855926,0.8932304632444097,3.1894308435609666,-1.526344763415603,-3.9591227439584014,8.974263468862542,-1.5192478400527119,-5.548073771220433,7.417426330442902,-4.130975754484164,2.036007146816278,0.07434827387823872,-0.9909053435968684,0.38737865944180483,-1.6687151134307592,7.947710473218518,7.349337964349928,5.149609149503878,1.2033672777786444,-2.790790202352269,5.515604891072159,-4.147905984424455,-2.493468600279579\n-6.400858276836673,-3.971918848880579,-7.668317113879781,-3.8758423024220385,-3.7401091427578894,-6.39998689328078,-1.0411817600523747,-3.802585556388485,-4.836733175530718,-8.081021785221806,-3.104597719535782,-0.38538947801102874,-5.562038368256837,-4.356336565458507,-7.1223248859359,-5.688187851243359,-4.613636185653403,-6.972033894361416,-11.696921664687029,1.1367359479941803,-7.7683666599063175,-4.892471833911242,-5.3140331529419935,-3.651027556672148,-6.373100695295879,-5.759595584224411,0.18955123523791878,-5.943516426149251,-8.126071160831705,-0.004047953302063645,-6.324754705496171,-6.351637406617513,1.683864765184173,2.240639068876841,-8.17996396827435,-2.68120278472841,-8.28892160607579,-6.74119173769451,-5.7857977497467425,-6.679247951308963,-0.20679574804472806,-7.064606205684229,5.050894726517137,0.7184725714744438,-5.219595464249089,-2.8388738710978587,-1.9354359937154229,-2.605556166469805,-9.726928794814778,-9.415908848483252\n-5.00764413966239,-3.4042046589189896,-3.9461648618914626,-7.7049587553100105,3.6045361159650477,-5.720587709421868,-3.595307779062502,4.621981242925948,-1.0759565274687468,-12.5588511869458,-8.744910720847516,-5.0467901482720485,-1.4763964877448155,-5.493532183449378,-9.182887051359046,-6.598496645879689,-5.971455247725868,-4.228094934297063,-1.5463437178716206,-4.832761661136431,-2.6280228675801536,3.5478323553111797,-9.706676170793974,-5.749312610660546,-4.994077028297058,-15.175688115038847,-3.5953006236892238,-10.071678368435883,1.7522547195965628,-2.374461237092486,-11.031470179998172,-4.197451416103401,4.448069277223551,1.4867712924005319,-0.6959632853343718,-0.3920674250328382,-1.6769858737842784,-7.797142653056947,-4.794798530392056,-5.789584524330861,-7.8618554262374065,-3.0290688123817544,-3.286417618379971,-0.4941388217510271,-1.059612957240962,-6.309822329774938,-8.268065019529242,0.28395979772751945,4.166944285052217,-5.12922042088373\n-8.169887981541617,-4.226162948600265,-9.010959123857146,-10.346641482744616,1.0328688856150672,-2.4458461964459444,-4.119635223496607,-0.3481925406196953,-6.682328246819828,-3.9724834210316162,-4.320889894751572,-0.6979032228558194,-2.160900945271431,-7.258891050037022,-7.2696992111074374,-14.653826740362538,-7.793067281425629,-5.526431112080415,-5.510067747373918,1.4228579328457243,-5.718211271095136,-7.0144000668136375,-6.594161583802514,-2.7594422704531034,-6.865468500291676,-8.968486368982074,-1.5871718316157812,-4.223961543365697,-6.138741349903939,-2.1749813358419243,-3.344753101269456,-6.940312538925636,-7.340962173362754,0.33448718762292917,-9.395171086142838,-6.947977603414576,-6.245946014571138,-7.04127898052226,-4.440886956363049,0.43494396073359853,-6.2248576933386985,-14.901668543966684,-3.8834792549126,-4.805125420781335,2.51611478315021,-9.259892189921517,-4.835986488312402,-0.3370350945243028,-0.7883791580487348,-4.208710334810881\n-6.1095423536280435,-4.0244114431552696,-4.813531964495341,-8.001096355925595,2.7111212481082547,-3.2764653825059,-6.205771621934939,4.400217348031142,-2.506325081380238,-6.851045045153516,-4.758350901209804,-2.9771705336536614,-2.601680437649217,-4.262061891581126,-5.517111183056262,-9.485707205615874,-5.22450993553377,-1.6892639573582926,-1.1756576582705702,-0.22267986203554146,-2.2853559742197054,-4.224696389289736,-6.336702975684059,-1.747373471813288,-2.655871070707856,-8.475169100852339,-4.088717319941357,-3.842762397379113,-1.2755197303288417,-2.4819075571367577,-5.34452947151569,-2.4415472311781796,-3.8762593127422496,5.001881880849014,-3.6463622977569288,-4.175838852127862,-1.4500872532604505,-5.531392629553625,-2.7583719306622485,3.078064445089545,-5.79501731494204,-10.28404686043447,-4.389809369714058,-2.801477172777651,2.2859215829826667,-6.5072484622012645,-6.2714008684864435,-0.4837179072954607,4.448586567602295,-1.7547687638453786\n-5.264473936249475,-9.925503105015565,-17.201439291275932,-13.670768797931387,-2.9283221026612796,-8.295578096509029,-6.766775296578629,3.1755444659021723,-5.620557536480526,-8.820577672649588,-11.932681930233809,-5.003275835572521,-4.812427754562492,-10.718597093716221,-10.315661839609737,-18.252290003382626,-10.09241450067341,-1.5607052657880773,-8.11129202097381,-0.6574254113370506,-2.394973738771557,-0.777990997107791,-9.93607417045559,-4.96324793143947,-14.994127953882312,-16.471979254639756,-5.834959931550701,-14.83595127829961,-4.2435163100994835,-5.026797965976535,-8.921452028197322,-4.737642393247538,-4.005273896859109,0.44383536484595165,-12.179918024952961,-9.330412075862345,-3.7321932841075154,-9.84709833175664,-7.105699740168557,-5.250281235355655,-10.390029944744754,-14.26089722364572,-0.2823029602719682,-7.631175723194573,-6.75281591739793,-11.76544510656663,-9.61647939750781,-8.068228378485843,0.7382912223383209,-12.637275488933268\n-1.6419037159266296,-4.291809050424256,-4.599743949138573,-2.186419664835814,-1.2239993102532616,3.1793640139671866,-5.054245204052447,3.7317909087816257,-1.2693793566803753,-0.10236659096717204,0.06951384934566818,3.086965745765499,-7.084513250445558,-4.281548636142984,0.7301303285190883,-3.022707202491465,2.280181596367356,2.9175468216997413,-2.449948349330062,2.6319251481620354,-0.5769626795790623,-7.015900287448649,0.8310053428606132,3.545215244676733,-1.9140047554257795,2.6134823156332034,-4.825861914711093,1.830226867942564,-3.115316759407578,-3.3409707111751703,0.20172158326041767,-0.49691112899118317,-1.1825453570540236,4.495036286820058,-0.02946359639185281,-3.4076347849945425,1.826022235477731,0.02451314261052745,2.408827816187874,5.0843659156036605,1.6272187170102783,-6.048282467316049,-0.7323886571355196,-2.6822246570050177,1.0128131302475136,-1.2360112048968246,1.0654130458816495,-1.0375168127997862,-0.32131993982480056,0.766374981867507\n-2.870844813701693,4.915075921949868,-9.849594988932191,-4.746602974614281,0.10399526786130978,-7.550148866639983,4.8153973440193285,-4.609834686793067,-2.9120398645841643,-1.9380054040531558,-2.2643623134604254,-4.562779848916039,7.895888297602289,2.399610097936058,-5.036935903622656,-9.91350905920969,-8.421466734982607,-7.296123092325683,-4.6723937065632315,2.8560133869908073,-0.3461367479393125,6.111512322892823,-3.907273219199091,-1.8929931225848,-4.673951812908566,-13.154780974769288,11.699067808872671,-6.702620997907105,0.6168221410934339,6.110364996691527,-1.9599145323895844,-4.568570144875768,-4.17874200954972,-0.9959824606763916,-12.714935729951,-0.6063195508634975,-9.47099600630182,-6.226156401078378,-8.285894262247059,-1.241003583775519,-6.852062397072143,-8.384056899768138,7.802478992354825,1.1960645040207896,-0.7952686008027876,-5.740841933962981,-5.694198011932023,2.793629532788611,-1.9104038332661595,-8.650149752509828\n-4.598712167667982,1.0883576975609301,-7.499460545299732,-3.191068042279849,-2.7869329998345895,-2.831177282394651,-2.263871672127932,1.9789433924163697,-3.81887336846963,-1.7986654850881982,-1.7703812198491322,1.5522240056370407,1.284551582272555,-0.08759919682437763,-2.2138891210854506,-3.7109044247283327,-2.5296806732698203,-3.27853789367239,-1.459138868951553,6.3287843939481085,-1.961826046454001,-1.503517573803855,-0.22226517518999622,0.6807385860734465,-0.5287654188193116,0.27033115106810135,5.003164826050384,-1.688623705240758,-3.3432315925783143,1.3955435198434287,2.3747322772209176,-1.8086976877689378,-3.489887265502772,3.7991320881328443,-3.695958235149819,-3.7966639947050362,-3.4010246708239382,-1.4196114663600066,0.7136983455329552,3.959385303527003,0.37871646574464235,-9.031326819115177,4.288251155495134,-2.2806011626789404,5.9699004184604725,-3.5499926563321376,-3.8153796059465055,-2.024002712979427,-2.753446592780553,-2.6047951745096416\n0.25190543740861504,1.1606224393731681,0.8204823691278014,1.557946956398079,1.8618236911012334,4.389740551936775,-2.027256447697206,5.84849984761271,2.3078567680593314,-4.404608264834073,-0.32620491686555886,2.565180819032581,-4.800112598242837,-1.3576394561904366,0.9771110593277117,6.12593783639822,5.133063611872048,0.3361276806887896,1.53056820118509,-0.6707531208069584,0.7559529466841337,2.070743898970901,-0.15278163574300319,2.753987334208381,2.676872997273189,-0.6333680210705219,-1.0281132720688908,1.3387390995146744,2.666514741837366,-1.333944664605149,-3.2644051272711683,-0.988179511094408,8.171470049328486,3.3396466445396986,8.120464551173065,3.559053931729218,3.1886111446927647,0.40264453528475064,3.7129186505300322,2.190767541614462,2.6505216231021125,3.1566281978885478,0.6695642990945805,2.417256255166494,3.697397985858652,1.7206746174769878,0.7290212463870382,5.172388149575215,1.3370653048183436,2.6908671830235127\n-1.279728156089312,4.421589607955573,-0.9912908835298233,-0.33869386945915553,9.816368191274156,5.060434260931503,2.9209213403668004,8.608503453703175,0.35900691687030983,-3.7206884921783416,1.0688042992118079,9.439107773461526,0.906951750537603,-3.881543244187998,-3.750846845941137,-3.2781850433666735,4.841242099321505,2.371467315015006,0.44116661364278376,7.120513928857955,0.6516547240031509,-5.2062202623684115,4.859785965318508,5.9166303832775196,-3.6761359979797703,-1.1654936388671355,2.4185536958099068,2.295784194517002,2.828330290123453,-0.36358567646137935,-1.2265052141325077,-5.466083758297529,10.174093635084152,2.7807538350802385,2.7844011995578786,7.554917195142502,0.7816250619494827,2.432566110070697,3.582334087294785,4.655129885186527,-0.5621205440843833,-1.858636363094898,-1.4842252250174566,5.275960081375719,10.90343077060764,0.21961888014321418,-0.1836603295798087,10.85730149495244,2.803958237311144,6.603973347175566\n-0.029233728639695533,-1.5159574463882497,-0.8078791734745221,-2.0036516878452755,2.1628435537610313,-3.47706307854045,-3.3269425455309634,8.063282905392402,-0.39462586682510437,-8.257912342341996,-5.384763680901254,2.908631489504872,-3.084546815413728,-2.6442930790109465,-3.9359884076992637,0.05309507338391706,0.2157654809185925,3.189643458561418,-0.34959316373019145,4.143039387847075,-0.09690828264457085,-1.4225192623938785,-1.0731664746790417,-0.2736873302880909,-4.524000782033003,-1.931743833935334,-3.54646767396689,-3.827078483566049,-1.183467361820779,-3.891694908697267,-5.490985944676526,-0.8471497947469484,5.7934856460999615,1.2948233188392755,0.13511934605509723,1.7621692686432515,1.668289860401938,0.5402975821346947,2.2034630731244755,-0.614973248160692,-0.06858833059184444,-2.6284800800809376,-1.9186289613944134,2.1130468318629205,2.979638437692591,-0.543163106976386,-4.357488265814592,-0.9404520255738337,0.6259134875022698,-0.41514404583527065\n-2.425552214783761,-5.450374997964338,-10.762951401209614,-7.610316016080095,0.6029749516031115,0.9114940706789696,-0.4329810289328784,0.01602300915867305,-3.5255620189560117,-0.22885689930091457,-4.047844195229571,0.6098029112760627,-2.069907322533945,-9.4994342122451,-5.665460899584012,-13.73689759479869,-3.615707006799343,-0.3273398254069444,-5.491592034035366,-0.9180738233993484,-1.2754139936382112,-2.9566201058860733,-2.695957282122637,-0.7562506629879615,-11.142266608670173,-8.392844928645834,-3.183422328311761,-6.38322842882747,-1.696369566497882,-2.8247534964054086,-2.3145635233257353,-5.263445143909542,-0.9803728642558753,-2.589364533928876,-6.392202430058328,-4.253535493691393,-1.9104107480723134,-4.630916691598316,-3.7025674453044846,-3.679735781915117,-6.67094424865177,-6.459033603962853,-1.4820010556884973,-5.157747621452045,-3.424945051757896,-6.906439804730328,-1.6908382670586495,-1.1134981386300549,0.5115177903076635,-4.731187285413622\n5.712976621401008,4.11426232698083,-5.072817048632197,0.9802629344304328,2.5476051385134335,-0.026631723943411956,0.7895563964730787,5.524075057499319,4.440086318291591,-0.09269290307049749,0.3681671139435241,-0.942218723817218,0.26170622381053965,3.7943204680514944,3.5424983003256116,-0.5677167605314595,2.3951473548636337,5.798023455788057,0.9009135471249153,4.112306943016095,8.350653042990153,5.8302122502412645,2.2293622391229952,6.943931691341856,-1.2942861905649519,-6.409016448209117,4.368995962876447,-0.1498025623315793,6.697341198410188,1.859475766987238,-2.358358989041268,2.3982325073625237,2.444470478830812,4.140003028886492,-3.0062136387934064,4.120954647872868,2.049366449998594,0.9104407401454679,-0.5001609637740483,8.309429776750468,-1.8806300043314388,-2.3484624090430697,6.327200360530032,4.093539085798107,-0.6234871388307119,0.8768919751884388,-1.498687518748683,6.020430837078351,5.1593225918272125,-0.9530657325669405\n-7.040761596698446,-4.196037148516803,-8.377231588566865,-9.453276688657368,-2.571400883574737,-0.43368281655500596,-6.949353013225078,0.44346780677526154,-6.197581744202307,-7.1383759795687025,-6.574524467603235,-1.5373804035590666,-7.677176709161656,-7.703569489743624,-5.113563525880314,-6.331090725604002,-6.101478380806049,-8.50447666999284,-5.1179092085113185,-2.1323697537276676,-6.551317164183004,-0.6513038112914145,-10.424498475516064,-4.1379512435088674,-4.1814092526850155,-10.560637153071712,-2.3255112195715677,-4.940582692525461,-6.871753814105796,-3.9905185884317413,-6.971560890657577,-7.645635374861211,-3.914711032585516,-1.9869878850040947,-4.1060632162118225,-7.271309837439166,-5.30066536329661,-8.291099309709615,-2.2881841391217432,-1.986640560669674,-2.912356721767098,-11.923188844871184,-2.759979918478274,-4.790596541570249,2.082719047344838,-8.700928983262077,-4.134418394205061,0.5783457496112947,-3.466058779777512,-6.017830330859811\n-1.8660364900693285,-4.490083149521396,-1.3806351218242576,-4.29973352316924,0.5639477823831307,-0.8331844114206173,-3.0537618425892563,2.77513903539264,-3.3698613013530974,-3.126549908692906,-4.3616985528913945,2.921568389953934,-3.1029905403309392,-6.148359042125595,-4.223789421982114,-4.57697535062531,-1.9624507662459347,1.0351393112438858,-1.672559206771762,1.3673403577820906,-3.0002524649968096,-5.084562937379233,-1.8544106239762677,-2.4581935582300565,-6.213975675726214,-0.284260778921893,-5.8121597904744515,-2.911960724127121,-4.633050771920309,-4.990229238264126,-2.2745656646398675,-2.660739902679604,-0.08574393074342052,-3.2389576943652276,-1.9346850439115424,-2.751237476991633,0.17660560815735138,-0.49454754003042445,1.1169740032301094,-3.3224869380179656,-1.246790848431182,-4.178995265675768,-5.8172323394504435,-2.5783828203257575,1.401788931675355,-3.062702538955925,-1.9511650348166403,-3.280891937192886,-1.013917289290502,-0.38288503269775087\n-10.044935644029398,-12.102053783124964,-13.620254071396609,-13.466873491342342,-4.094223722502415,-3.6610126282941913,-13.283817110470984,6.094547338911014,-7.333623792689982,-11.657165962541553,-10.639547797558702,-1.4737927876326438,-12.706318500183151,-12.844031925976292,-8.88707905030483,-12.463757748796851,-6.699040967778458,-3.9281638407404538,-7.459036466330505,-0.5316443611991035,-7.367323351663802,-7.715771865622549,-11.143268456720836,-4.25064803221302,-8.81102933121733,-9.508316312992651,-10.513820537101607,-9.134364075802168,-9.155707544103159,-8.146623588857429,-8.848912907097933,-5.924633029106532,-3.936477104154731,4.871009932345924,-4.822606652214283,-11.678971189461752,-2.3222886589422616,-9.45136751104754,-1.8418532175145257,-1.1233808505240273,-4.4207701273313855,-16.762571526347276,-4.232634571247212,-8.810756552676166,-0.27501013943005614,-10.937914045463629,-7.605930117759539,-7.356840597864626,-1.6433626138137702,-8.004133167080035\n-3.379577106141671,-3.6839515753391603,-9.732749870398173,-6.974386196786922,-4.128491673821321,-6.906079243705532,-2.51822379310126,-5.316626291914871,-4.553487884674181,0.49691182671855827,-2.333793952412946,-5.508747639706794,-0.5785443931833376,-0.8022516545336842,-2.5889209377061553,-12.481862980870122,-8.890731508402805,-2.972983443127238,-6.94193837777372,1.6448355460776507,-1.9399966669439506,-3.040788842137508,-5.151935549706077,-2.090357592331916,-5.696630655528355,-7.638857340619408,1.079438898899786,-4.279820467168019,-5.573983964622187,0.6889857687413207,-1.432688023802304,-1.6204880111917883,-12.313479551249234,0.5484298082323511,-15.08543002241588,-7.994803626644673,-6.966157505676064,-6.072258239305662,-7.393620762002926,1.1743922163918643,-5.137269362033961,-13.74280471728881,2.4623329925949644,-4.041628196882175,-5.899374144767545,-6.448116334001494,-3.7079322176093688,-4.779620645270024,-2.5872400298237026,-8.749884697495727\n-2.9832372644834617,-4.276535791001166,-9.241940640184726,-7.8615796224567855,-1.0409120758399888,-2.818066912960285,-6.654412082847156,2.142090242772108,-3.0172158790453825,-5.152356026574752,-4.42656168619172,-2.887711878418511,-7.4898103546362655,-4.082288574962955,-2.4124703506631278,-9.059154681289362,-5.086844312866846,-1.2191351127227499,-5.826033083699944,1.321392473542716,-1.2118054668462381,-2.881078817968595,-6.993434053536195,0.39971108169467007,-5.545165686986355,-10.539793094422883,-2.9879331675777,-3.4676372608674666,-4.209725852100943,-3.1060010224959975,-6.970010970828006,-3.3047867285309507,-5.806321294695086,2.6516361908046426,-9.280212324805124,-5.585623305189814,-3.5349239595579403,-6.293921072440583,-3.9040410148107356,4.064750233786827,-3.975719758149685,-14.044939439609927,-0.22985410133814632,-2.173284372763215,-2.1609137802031624,-6.4097441317071455,-4.066480978136914,0.5035510378047323,0.004239186582957188,-6.04843052748459\n-6.928023697699993,-1.2441922249573771,0.3960459416627179,-0.6905560205891976,2.15388159665837,0.6676406000250887,-3.3040096323382424,-0.5219856551542866,-1.548533080174244,-3.578952446246117,4.512494449133173,1.523861271274849,-6.16000537414732,-0.23769584520246648,-1.0509950685903278,-2.678458116738057,0.6759894621421823,-3.0188475481359687,-5.442367096065299,2.509342916710107,-5.355115990398296,-12.246096260626876,-0.8775964671531084,2.8251252390145707,3.688033875855386,1.6098597919380822,-1.4545635472820362,5.92386884393516,-4.777700992855304,0.8484847761959315,-1.8826632193348045,-2.9212269121550922,-1.9041713297746958,9.904593320031898,-2.0065314630767186,-0.428931492620491,-3.980695121991596,-2.672358959645028,-1.5160696553131996,6.874996625704347,2.483004983356441,-7.989619971283295,-0.004431450562042416,2.7145745626862294,2.4498690777434766,0.5348526763581201,1.6716554847910878,4.292289420951891,-2.69166879564497,1.8819692313654557\n-0.6317923607564113,0.03523751601222169,-6.326568795927896,-1.9542105980758304,-0.43395107390538235,4.699754580573758,-2.450328393386727,2.9132301789249784,-0.6785367636219446,1.3819297914146824,0.7534949856317827,2.4193703128389803,-3.973236636378671,-2.4458287543493813,1.9010428316712464,-2.38589905863922,2.0765952670114727,0.4693623017091224,-1.0765706084779874,2.5342213872339316,1.2454039794822007,-1.2972400457555688,0.6217824524535396,4.649225244436869,-0.6832361337802433,-1.2292550129967246,0.9359841387285533,1.9145272329067862,-0.18363415218283374,-0.7260918687376887,0.7917121798615392,-1.7744801407109192,-0.9103660640008506,2.7783309661288254,-0.14478391269709223,-1.822425437378505,0.43750555395452984,-0.6592896858582911,1.8091580906546,6.3570439895515305,0.5215549354430022,-5.720900589903688,2.0722104262326684,-1.7040003591656392,3.126065709873898,-2.087067547930699,0.9107756185539502,3.5638209487246777,0.4855513913048075,0.41099581467174984\n-6.693787299933747,-9.599823301348533,-8.91128662367198,-10.419422209872435,-4.943475085522362,-3.686448933347482,-6.599545378466568,1.1105970568587356,-6.456234337899636,-5.929715633008902,-10.62176979956369,-2.753029492509664,-3.1758766523653694,-11.017771074269245,-8.741760528577334,-9.320593811496718,-7.459346703694812,-4.899974622598003,-2.498238960869684,-4.826376948908846,-5.9885617167013825,0.1314066798955467,-8.818598325052593,-8.71422291054778,-8.31173320476884,-6.647175365476363,-7.362285998174858,-11.522291999359245,-5.450360584837054,-5.891195911916901,-3.65942686726952,-4.004215315469639,-2.9036362131930575,-3.9931988768655766,-1.2560943996176195,-10.082262184305417,-0.9655006718112458,-6.712249336708442,-1.707592738009667,-9.882500647981345,-5.712125488513234,-5.58312878595676,-5.2062662124484005,-10.486664939249511,-1.9272358251724844,-9.560293984328311,-6.563878023491003,-10.796247405635805,-1.0491664040841138,-7.2256069922630575\n-6.947195647640122,-6.897478103632185,-7.883298688393742,-7.528743460425029,4.361473692495339,0.34214450286487663,-1.0860531401875617,2.022635161721583,-1.2816197141803958,-9.356636294547878,-5.143222047123476,-1.7692832760573425,-4.773879866176475,-11.651232988289463,-10.466662703100342,-11.678528039888443,-2.4041970531629078,-4.155387921195758,-6.630018512626031,-7.187289507886158,-4.546721483157627,-2.7196621514749877,-6.8508963830510385,-3.1729515179479524,-8.47886966292451,-13.747841116164365,-6.161263884086727,-8.97271494284716,1.579683984744698,-2.3396678611293087,-9.316616551363655,-7.420693797361372,8.504576353107423,3.6314759494827467,1.0287230023203882,-0.15034640652889064,-1.6006515732295936,-8.841380834668492,-5.914366312506525,-7.900969271289894,-8.069895110665318,-0.563308810831282,-2.035362560779738,-2.0983958912491647,-4.846512834480008,-6.025057325296851,-3.049982761760855,2.043921433268447,2.439471526226406,-4.64377445704373\n8.046187463791929,2.513588500727353,-6.620705359050154,1.9868801668275884,2.480236160004778,-14.704044860483513,10.68119995635415,-2.6058404470749004,4.176335497491387,0.6755996406823614,-0.8846871986937084,-5.004053715580204,11.869851274547885,6.8183989494366966,-3.8436328431131614,-11.296231263314143,-4.909822845389117,9.009777350219668,-5.8560592105612,6.471929532973272,8.900679733331435,4.386672470724631,5.503265045675352,1.6013166538592674,-12.321732594263736,-8.601332401183932,7.066521333668345,-9.590743997040812,6.527834391685503,6.3572212952793805,-1.902126729851517,4.716259487273763,1.9627427899704248,1.166848466256417,-18.00685328277566,6.506972080249308,-3.3526680176859163,0.7804360936939836,-10.600886910791418,-3.780484903495655,-8.238020326106469,1.0429876247064964,11.376908296510853,6.967264116546871,-14.277836029325274,2.379085734108223,-4.640325886707037,-3.9996595577027225,2.0536096424440182,-9.588518758643751\n-7.015334223560936,-3.025109080175101,-8.577230476483665,-11.893330158245142,0.5302487050553091,-5.928487490905601,-3.815455372533766,-0.9870547565279084,-8.085940542742367,-9.223478288063397,-8.845804165125658,-1.7072551196109909,-3.336189181926893,-7.7309155934463245,-9.609255622089611,-12.441649899469867,-11.010421971310492,-8.95776132809522,-7.4075428556414415,0.5537713322854088,-7.431481816035163,-1.5751884413375523,-11.576178717130166,-6.708331137126665,-10.128759093386924,-15.589061630752722,-0.5029515821182654,-8.401363473322846,-8.407313517161157,-3.621986125624831,-9.515565534101412,-10.087985505405493,-5.119554523608317,-6.312240974077174,-12.470777343011326,-5.880218304647321,-9.402656963981512,-9.326910711994856,-6.107252860803644,-5.564213699436985,-6.872931585119818,-15.440824504006105,-4.423298587951023,-2.4719205556624515,1.4781107997702507,-10.61247859172624,-7.170046741784502,0.9541528835877313,-4.195396402974122,-8.408847273158523\n-10.88889458406532,-3.1822606628085657,-6.81077944560293,-6.393014613314544,-1.5138302241199495,2.992118916008733,-4.641607713085715,-2.3221136876740216,-5.438049764742652,-4.214244833970522,-0.3941463509632684,-0.17932229188214324,-6.202331028761344,-6.578787469410011,-4.461645988014444,-6.058976578424353,-2.915262849273735,-10.630953455856462,-5.659834953589491,-2.7341692076746513,-8.626376767161597,-5.996402411937139,-6.693486903072883,-1.7771794858945387,1.2281193467344118,-4.825747049497695,-0.27632463082253067,-0.07846471031873561,-5.764303574162556,-0.19346552425217284,-2.2203142573558865,-7.717889909838677,-2.8916839651982666,4.667463304688882,0.12816351927268416,-5.924923150294725,-5.858578434758434,-7.817432980665817,-2.237897343826556,0.7302885969434538,-0.8075034617051269,-9.127139665794427,-0.39386829636259446,-4.2702924480961,3.6391827822092417,-6.2039189524587695,-0.4818667158297443,2.628288069460074,-4.01622767412357,-2.4304219549927373\n3.171804673223744,10.210296451822872,-1.2823983596631652,3.3529704553233857,2.349209364846774,-5.210173251472921,3.5980406330101977,0.5271145498838843,1.1024348492331593,-2.340297712094894,3.4035119792009314,1.4637238441892502,2.100677553869573,9.956653203322897,3.037503202438935,2.6113947811093383,-0.4651870736394783,-0.28202551476414506,-3.487250993243367,11.213171798410817,3.1540857029459684,1.909259217862679,2.257867871163225,6.090130114930284,1.3502370280506808,-3.906854735389399,12.266827587548704,4.027843716724438,-0.5231881955161677,5.485956744660566,-2.6079302722183417,-1.0097459676669966,-0.6216157075098145,3.003034034911749,-10.97257916692792,6.351433015623735,-6.797329826636816,1.1288483594897911,-2.164956785629034,9.419953557399818,2.7579956811764763,-8.581348548695116,9.40515073797441,10.73924217550124,3.8286891792745474,3.0702146954667437,-1.1744024340099117,9.765224231468483,-3.975559026080253,-2.049236024934567\n2.076042783334671,7.277480273907379,3.3574901319247985,6.497728403729722,2.959085318799209,-0.8529894413199075,2.346909499425578,0.9105739690297994,3.5901049993125946,2.0910857366403026,8.195060945929473,1.9230762319431363,1.6476303438826994,10.158985210509014,5.793197058444499,4.2537908074455295,4.133148327131987,3.5296207099471593,-0.15229707562809758,8.620345057252203,3.7313745383435624,-4.270566011799207,6.6811856595320975,8.287544317135147,7.0210622812754835,5.439390817944272,7.23588539623631,9.20168742169335,1.8259429220993386,5.567149451904252,2.823527492247716,3.4326533792800276,-1.0608635574365752,9.410067450877293,-3.288351580974595,5.870628993304685,-1.478900709905655,4.128457100783841,0.5810268779371776,12.962045633317034,4.821117463119503,-3.2997265204869417,6.8258077326901585,8.458541267444247,3.5674521763605958,6.337803454218854,2.449629812146418,7.068883386483478,-0.10599995601759171,4.096745120562474\n-3.762593497992012,1.8805692783434047,-11.086203340862465,-3.8943279249983815,-0.014845803271620495,2.9168706479749207,-2.976299847013826,7.774610783934082,-2.5858790892085692,-0.9028849346287502,-1.4322108205563397,5.281862410967542,-0.12740615799631616,-3.0424114181678212,-1.2364473490073162,-5.018195011248153,1.530745480796058,-0.23671964408764712,0.5877740379450543,8.230907399310368,1.0859324663312258,-1.5304689475734496,2.4260188504715967,5.524980972527206,-1.5473693205183452,-0.21380046511169026,4.951890797899668,-0.4180563955983123,0.14637670099448874,0.3272052918179542,3.3606582104892624,-2.67661907314657,0.2731628176608587,6.133120327190376,0.34299721703911645,-2.3786377425122787,0.1236845248893732,-0.05582643788257946,4.086987732352867,8.94071985077262,-0.04669962019787777,-9.668424699396956,4.418343885449603,-2.950022992318261,10.55974343934477,-4.354992817205261,-3.2369713040746855,2.3787619686413803,1.1320994131384934,0.7481709286922094\n3.2103352406722054,0.13005246939556758,-1.4554469701813426,-0.8684130200716456,5.987990813448036,2.990811987701159,1.3242978743215015,4.315611444414213,0.9037889034048079,5.2646991777731955,2.6340097183377766,4.8652591183455645,1.686417319591796,-1.3709618425297703,1.1578616475272896,-8.239605727956112,2.097531269782538,9.08837080755869,0.9562252935429252,6.631286788797967,4.893689854734893,-7.656767054239764,6.519488161463312,6.479050410160541,-5.240089175491322,2.1903645260014057,-1.8091690603194746,3.7035565943712854,1.8231165080457592,-1.413638584651508,3.2971798524835525,1.0169190215098816,-2.234369586535126,1.044925453956788,-4.926978705200638,1.6378295546831185,2.8195335813122417,4.2935286463389595,1.4530978648464214,7.841574743438371,-2.4603153838153173,-5.059941609280764,-3.317383007290497,0.6875189803722772,2.7084122204127175,-0.04950338307058477,1.1279717342918256,3.0654298495956773,5.440047569663381,5.190695234104885\n-7.554209466594839,-8.285723067026689,-11.88858718523325,-7.753897725207418,-3.0338982638054137,3.772305810884731,-10.072413451176933,4.111733696381326,-3.730319499012949,1.2981757775119025,-0.18632357115582932,0.3072519429063408,-8.230187693277497,-7.104812433266381,-0.38285325186443103,-11.752627784073221,-0.644880932424017,1.163875436755526,-2.99454820607997,2.1498267612809254,-1.8240244237768706,-11.61683498531475,-1.4085356976011258,4.259302960154287,-1.0532891934365072,1.029946939878847,-6.34105866471295,1.401182404534639,-4.106276232427856,-3.2438742701791803,2.7890326458504835,-0.5215281818636646,-9.270879746773058,11.18180644327341,-1.8991454161661918,-10.671815595185713,1.2773611142381056,-3.7622117482462123,0.9790853741743673,10.938106389242192,-1.6730989213233025,-14.753444497747479,-1.0284626239043955,-9.329361199353292,2.2810364525869966,-6.6557521739543075,-1.2586779889393924,-4.165491653345672,2.739887005856594,-0.28438718867147506\n-3.4748276217737555,-1.2403165519346562,-5.59081246813985,-5.767307738348996,0.999564501231382,-1.6049391628152931,-5.578764055871952,4.343716308476247,-4.625797664050756,-3.597892396217396,-2.1716616855981146,3.704241470787067,-5.219690238810669,-2.7764743855002685,-1.981431777749128,-7.071632115883489,-2.929297265488367,0.29271729032495086,-3.952604294045526,8.361926532739473,-2.4058084636622117,-8.58194223254891,-1.919647309433491,2.4605729366494034,-4.402384539778496,-2.127146594391939,-1.0331599922803938,1.2438611158161708,-7.062766244928589,-3.2393529478165446,-2.515601594134307,-3.787045383521278,-5.773612066287463,2.139513025404549,-8.761476853898115,-3.8062127849191767,-3.6020772324201955,-1.4602742927665586,0.6377664572831163,7.437850190445136,-0.09107134117772064,-15.936521374386581,-2.2149945231553425,-0.25275891809139706,6.098054156546235,-4.3548586050973315,-3.0309603325747974,1.7367968405537764,-2.011790890473515,-0.7220492596927999\n-11.184875949806285,-9.43792539916453,-4.798132125820539,-7.991659963690572,-2.1707194855707996,-5.897521094808245,-9.319170345491445,1.9101009639360575,-5.729568081948696,-14.371188169308398,-6.725970928189548,-1.488754614816321,-11.402210877740396,-8.544061414130374,-9.59363568873102,-5.975230484124075,-5.272280797526939,-6.944312567141145,-9.083495943213515,-2.038989438920838,-10.8710427609914,-9.838648002435624,-10.237338210577699,-6.115233890672722,-3.982798203550255,-6.000770960437904,-8.952053647325906,-6.133563888880784,-9.752461553370514,-5.071240561362407,-10.291386584444144,-6.140480260433251,0.9019984820206988,6.46842919679397,-2.4666324059201736,-6.076719492448624,-4.902827277767846,-8.756027623775426,-3.45502312100792,-4.9952992543495665,-0.9472987798294491,-9.980185051345394,-3.291799342239423,-2.408045534926377,-1.7690300957960927,-5.388671030869511,-5.021163098907956,-5.0005314578970665,-5.493560845509165,-6.408349750076943\n-1.6137093962438924,0.38113061302706563,-4.720133762521122,-1.359260679812205,1.1769475068147592,2.2151504480670976,-0.8066168708124679,4.788201574085052,-1.2519760419300228,-4.83445998785843,-1.9452320545297754,5.049147285600128,-4.083023959272304,-4.359290585449762,-2.6495793197628332,-0.2686610114610475,2.4249985852029607,-1.0145489868409805,-2.863087655404946,3.3140265758392236,-1.4844452404606643,-1.0790638852027499,0.02578698779278632,2.169714873191377,-3.5440462351935715,-2.1584825319222816,0.7110751536319544,-1.4675177944922795,-1.270611277968246,-1.5665707867396494,-3.0122243682824834,-4.510865008781342,7.017720382071136,1.3205238945998075,1.5707607965927375,1.813594988192136,-0.619746313348146,-0.7972037060173973,2.0881324378713897,0.08961678626595293,1.2863088858547007,-2.4251420194867332,2.019215140896403,1.4656053694279536,4.076809194919521,-1.0008994547441477,-0.49804405099258986,3.877234469929896,-2.4646659677840193,-0.5432036758861605\n-5.959477879495048,-8.792386223375445,-7.1272141567206235,-6.6040402792740025,-5.322518059456642,2.3867081035888136,-7.80968099209353,-0.4985574997025304,-3.338164642828461,-5.120279598253152,-4.9896060637413875,-3.1362206046949237,-10.95841489508213,-9.262891976776546,-3.1144497759801455,-3.1100356656969796,-2.1133370829496743,-5.8238626436216085,-4.930317503434487,-7.895103193817922,-5.732974281330749,-0.9128236107280389,-8.936985011121804,-3.989429703321507,-2.175178974450451,-6.159901239847494,-7.851617245085208,-4.854952799102254,-4.566667601431585,-4.799404616009593,-5.665843523731415,-4.112826487928211,-0.6251324233159857,1.1962409659034414,2.840275437489472,-7.87958904039661,-0.5501359852253952,-7.617320687376932,-1.5003374099446243,-4.660154539043272,-1.3050773930512836,-3.7306004811099163,-1.9651592802841742,-7.199689532906659,-4.5180823139637445,-5.798155397543122,-0.7251649180207322,-3.7931754261618487,-2.4216524556726884,-5.618987348605578\n-2.409211530987373,-6.1467465572758,-6.502185486427029,-6.635103755559682,0.7650415881797575,-1.7067020678962346,-0.18674355019841726,0.16246726849120097,-4.398336384342725,-0.9615527768343748,-4.877566190351484,2.093808183929491,-0.3460875724004071,-8.992717582184985,-7.057681590856988,-12.318740900896193,-4.233980170724056,0.9421268411285872,-4.456979682963339,0.606727012319842,-2.7904274123570025,-5.565848123513017,-1.4676330688128136,-3.0883755202105574,-11.627155224369316,-3.7855109767178594,-5.092765837498278,-6.523532062540322,-3.916189011152562,-3.998310235699043,-1.336461464791528,-4.180934288062561,-0.9372986238010661,-4.549129845289676,-6.326111050372278,-3.944504316861045,-1.4639131922661188,-2.332471345537931,-2.399708334338221,-6.471751683744684,-5.412609783980106,-4.941353131128884,-4.471925406906852,-4.722596846147836,-2.4293445403171416,-5.527796790749497,-2.3218856465868165,-4.788428206550718,-0.721246243474372,-3.3609774734356783\n-0.46050425965767294,-3.0375668739612975,-4.751382860596547,-5.700331676077348,-0.816845970578663,-9.322393044301712,-6.195877047962728,7.955814846326355,-3.9611596187200666,-9.827567071407083,-8.981356885649443,2.2468782741329347,-3.9250872679384594,-2.4923844404290567,-5.384392497964638,-4.174732016377709,-4.857708640846796,3.2826540764196093,-3.162610222274547,8.89269554224684,-1.1823370473591472,-3.2040688586903934,-3.4396242021456023,-1.9829416380527158,-8.93448538292246,-3.630863163338045,-3.4855790877364408,-6.53848309641122,-6.811268959899394,-5.61713909760091,-6.7661208565227415,-1.2356032309611735,-0.8153907992496192,-0.8769045401116946,-9.108924001567877,-2.623768147155987,-1.6540569346777336,-0.5362972397865051,0.8058778357527141,-0.03335346821492946,-0.8464052587955307,-11.94577218737174,-1.9423708026682567,0.7257033288290673,2.6282435725933104,-3.598838730467087,-7.931795886606168,-5.400471481285752,-2.4337778558295584,-4.899075864262878\n-10.085954847938853,-4.738014766141009,-8.607776073649543,-9.670039163765134,-2.088029692510925,-3.410446604535756,-6.322336013541976,-1.798918580581874,-4.079578636386769,-8.070369541930246,-5.548532742103587,-8.111106531920349,-3.8117217351629757,-5.193234683295481,-6.614370239808706,-8.784285796667398,-8.165781842357058,-10.794166529130996,-4.1375744344855,-7.062754719190012,-6.163840903656885,1.3936869707787738,-12.322476916174477,-5.785722725754818,-0.08020013658673486,-14.077582069454971,-1.2072361280922657,-6.988758582689389,-2.1335810926823253,-0.05740459463700337,-6.995285315564806,-5.271025108506153,-5.036540287257658,4.561791381725529,-2.5686756084601297,-7.518318619035343,-5.580525766092526,-11.631909573253218,-6.629542650428977,-1.9991170754141625,-6.651488402110453,-9.180822257790538,-0.37504932857638806,-5.607972700954413,-1.6227674407456623,-9.208588871272974,-6.2074747284424,-1.007670968266313,0.7331565809229557,-7.476992917718296\n-3.2452265263788864,-1.7939758130270467,-3.105345286675024,-7.03202663812565,2.4667089055840643,-8.843406655008637,-4.640825058048544,-0.11888450574244969,-4.003498913585898,-5.884796201026271,-2.688343278163879,-2.851450553261056,-3.3962484984846126,0.7636555739477052,-3.705570951152397,-11.015095799977507,-8.664702527102426,-0.45348500204741304,-6.616643139410356,6.047902738900974,-2.6208982947224997,-8.576500146448716,-6.047872552551064,-0.7833957863553878,-5.46965985240872,-8.890002566020463,-1.5271535297295498,-0.8503198061173671,-7.291517118050111,-1.732921487857014,-7.28611335546254,-2.804904642300095,-10.430379920896225,1.9044524292473919,-17.10481880719342,-3.5095772375963588,-7.427353761238864,-4.73597888583779,-6.307087966052337,5.5071359099262525,-4.221088871805229,-18.211322657134232,-3.108270322725895,2.5258845472497273,-0.8352183775524712,-4.80668641513234,-5.384607944059866,1.0150417555182933,-1.075206643009459,-4.603909842159341\n-10.286420778490715,-6.837569081454224,-1.259291568473524,-5.875683725942936,2.084852576774099,-1.3638527948430144,-7.367316465147879,-0.3078520229902133,-4.722175939312509,-5.832978578598273,1.3500797285539137,0.7481391759881117,-9.279356906069578,-5.027663837082593,-4.727276244096021,-9.506672010674016,-3.2206814522671903,-3.12608372328598,-7.800774525329498,1.7324576506878917,-8.652535357420062,-18.326269713203352,-4.4857604828792805,-0.1212045009025291,-0.5173610365763337,-0.284611887598851,-7.667500591030159,3.5959522294724704,-9.242962291755418,-2.8937340126398357,-4.179859543041255,-4.515305106059172,-6.318252259649952,9.299372821946616,-5.918788988491402,-5.163147211368155,-4.923178386816412,-5.240322021834099,-3.0843179800026475,5.2383475987538946,-0.25078385961039107,-14.046578139389917,-5.61498220267874,-0.8678107272997422,1.1829675248763754,-3.3420644007830362,-0.48828465586268655,0.1991294072771298,-2.5238684326217524,0.428123130130824\n-8.992456343343694,-13.873519566127671,-8.83402243325979,-15.164517052750952,-4.041433971832255,-11.343257345036358,-13.850806813786352,1.6705098195745007,-8.172051333500686,-15.448700607312588,-13.525017893911066,-6.9196178249616604,-13.272063443743873,-10.711284033325336,-10.890789415311056,-13.609237173036453,-13.115092839195164,-5.123744200403326,-10.209055857695876,-3.229952821456267,-9.389039392504817,-7.387962520054891,-17.071807756566624,-10.01971165746181,-11.235183065642346,-15.244741180777662,-13.592919086266535,-11.932250070959103,-12.722518089032777,-9.542579273741499,-15.346015844606935,-5.774117531831898,-8.480278077126679,-0.20967629907309648,-12.979397763563574,-12.350206501244037,-6.122116454152545,-12.198224765010137,-7.2885896703785,-6.544011963016835,-6.936898070847747,-18.827161785381342,-8.247414671954271,-6.401900606925696,-6.9996164725163466,-11.487846820562986,-9.970697071224082,-9.838733633417311,-3.2812843451140776,-12.32601221920471\n-2.816729221012802,5.32658948590529,-4.17297829354328,1.3896004742434953,9.45407218290934,4.0300163271892,4.472479939572938,5.618494041222016,2.541757536858791,-1.4238794346917523,6.00872919185986,5.974128500064455,2.2607585605917717,0.055198927001653436,-2.0587951406254863,-6.245765434799246,5.351214037521221,2.131048590924205,-2.1092172519136314,7.1967678066018,2.248599033256326,-7.033783511737824,6.7430749908284815,9.482318233728002,-0.19750585710996926,-1.8136525032920416,6.087705763421892,4.3620730393364315,5.706848637426043,4.76190924491573,0.7732134565096416,-3.3818448203114895,7.9246992377184355,11.763349680265005,0.29540174551283327,7.948242177895633,-0.9395306940349508,0.7050029965541406,-0.33940673521130404,10.082857104773606,-1.3413090462615749,-3.104922370234064,5.344853316198958,6.522811771693078,6.983427785024245,1.596799000349297,0.9932082667462532,12.115513981538287,3.914090959431277,5.1693802774170585\n-7.864604452316811,-4.623511301082251,-4.045510338692232,-6.972166328688149,-1.8826774510121664,-7.726752056648331,-7.109022331149229,3.027375932708688,-7.612544836800958,-9.415861223809284,-6.024073709142415,2.9377560334956927,-5.242542433634374,-4.438357512837138,-7.409879013035931,-6.342151121871667,-6.276622001300887,-3.5041771808422757,-6.09843269838465,7.389065244930707,-8.276319714571887,-10.692873861250858,-4.979908645738722,-4.006758081021091,-5.475610168029414,-0.19063793162985432,-3.608296387858229,-3.424042104027832,-11.934355957357031,-4.432094943725913,-4.379460819492369,-4.702885037762384,-4.524526537297897,1.7292803927126101,-8.502634777832176,-5.958857996187328,-5.801724670846991,-3.2029277151546585,-0.24540957392456816,-0.49357256247566483,0.7131540504146306,-15.033183981328747,-3.5214417965178617,-1.46582281628464,4.9869887816396945,-4.953278976257737,-5.985852382797814,-5.6325400600222855,-6.611923367653348,-3.940958264799418\n-4.053753198312593,-11.526198119379059,-11.090657180756834,-12.316181681683801,-3.976212293642832,-2.675293382326384,-9.45057293485513,-2.8784782597009766,-6.364706337961671,-2.917620593304255,-6.177637640049521,-4.815106564669545,-12.561853563006038,-9.771806569770243,-3.6494807288508446,-15.639128468039523,-9.034205392367996,-1.6951913575835618,-10.370779278352197,-2.8560601524108384,-4.611434237207671,-7.993625914931831,-11.024825650701212,-3.212003982164852,-11.00774364985153,-12.191268399785251,-10.444981233882867,-5.1123883570680695,-10.141805796142073,-7.316276061132063,-8.454056839051416,-5.02279181110328,-12.616253812219833,-2.5234257621658154,-14.91098321742231,-12.073116398856655,-5.068227842491491,-9.276114554792002,-6.9166833115957775,-0.639586099063324,-6.195428123943477,-18.11734598049635,-5.695223528319456,-7.356561648091347,-9.123876801909384,-9.914284348990623,-2.563239184429099,-4.537046235200306,-2.362049233088529,-9.399415241369502\n-5.973967522542111,-5.405942541304203,-6.39579021526364,-4.83270556305396,2.2557023292631984,-3.0326755386667306,1.6430316703521006,-3.4106416184035426,-2.3323049555942226,-5.554788319034531,-1.5001388407097949,-1.3803036756132447,-2.697990957621532,-7.198388548216324,-8.652147968944394,-11.885511156972434,-3.7185100517455627,-3.857064945638153,-9.788259454767475,-3.133620226053657,-5.383185594260257,-6.631777404275649,-3.9054880662300233,-2.638480930389196,-8.234091836858692,-8.872245070656216,-3.032358491755991,-6.015622318639029,-2.309430780553856,0.14806267880968288,-6.071045165035338,-6.186141298698014,3.527248315966438,3.042659813778463,-6.0618416550265835,-0.3886962099357221,-5.345321748051242,-7.024381888759757,-7.778662919677963,-7.0337246394336015,-5.581076923445491,-2.949195571241771,0.8575411282702676,0.037048154454485116,-7.317169525826941,-3.4952217958170655,-0.9476047916763606,0.1553649915443328,-2.485002034940421,-5.916940229075898\n-3.5815676098547353,-0.3950564427029083,-3.5659798033531236,-3.901778050655931,0.9944671842954499,0.8644061439445274,1.0489068160047654,-3.8486782654757756,-4.337249951373425,-1.4660948970268044,-0.3524971963082617,2.0849745463257237,-2.746074032333341,-4.530629573254332,-3.6038827229508503,-6.038285104556519,-3.207387511776126,-5.613842679555842,-6.415488402934749,0.5836426863304026,-5.184018757107788,-4.138572009355928,-3.3717181780173173,-1.3459795232494887,-4.980338314839072,-5.335167644901004,1.12122426491232,-0.4944124642270785,-5.569029320076479,-0.6694281120901733,-3.0076399603298873,-7.3529999649953,-1.4153180689012386,-4.033653508750057,-6.492358171981054,-1.3136134677511213,-6.426306435910752,-3.974548118866,-3.204972236345562,-2.8151489814257435,-1.3900789132850524,-6.641191903254074,-1.2312773011503624,0.31502437692216445,0.44772937997567974,-3.566970083902769,0.882491298249322,4.219682202038037,-5.249685058920397,-2.739769720253792\n0.6083766679735495,-1.574207940021655,-4.928751380104611,-0.04455786573300097,2.7247405509223874,-0.5641060293211912,3.4983583769610402,1.622253462578048,1.0268899423306448,-0.40305576926932063,0.4527790782204637,2.570643515077615,0.8532718435682599,-3.185532724137283,-3.3722953241319726,-6.690472604396377,1.6866917829349255,4.034210981977018,-4.059534933605225,2.4368760205493403,1.5989166106486916,-3.627952094024936,3.889719571232392,2.7878605019322307,-6.850967414366674,-1.5052277448678106,-0.47059579726336465,-2.8914349322422472,2.1290480018017233,0.6382874191238885,-0.4354404586554783,-1.0475781104565813,5.749400196250916,3.083735574014192,-2.6846568295130386,2.932873128652986,0.35439336022064905,0.2503451607622419,-2.0554267229801866,-1.4576717183303542,-2.537317021286793,0.963514960958467,3.219313188535848,1.45981041573731,-3.5724270448809916,0.5478722969213495,0.356643414173029,0.2857750830175465,0.6745474735124015,-1.3292036101694817\n-8.90713942337615,-3.7554500769686694,-6.754638460515207,-4.976138763794888,0.5544146479626733,7.072238594705798,-7.844168263210881,8.736975681481828,-1.9024550826866966,-6.809061606910573,-2.6009380009667034,3.3785026773822686,-7.7077878572661,-8.626363692989337,-3.525463798616503,-1.226720006318153,3.6418112281727324,-4.225500623647959,0.7938106400528626,-1.58061333952493,-4.099528063209988,-3.6802420966555,-3.144363836538071,1.902471552472913,2.7437250209924016,-1.1507963929864642,-3.8430866552842877,-0.5820745018172369,0.1678574966125379,-2.9716329950507063,-1.6357291947049586,-4.412078964956937,5.681686767530697,9.600323502063864,11.564707915546913,-3.281887753746872,2.9524020390200656,-3.900077135368891,4.833588952152607,4.429054618880993,0.6211499903423371,-3.85685545255036,-1.2531270103012755,-5.067707425608918,9.138033003034533,-4.559900898456317,-1.9557218029966785,2.396164395540878,2.477650132713112,2.7326605176924694\n-13.634960459695323,-10.421269659248777,-9.697133745681736,-11.897614869167343,-0.5110302445002843,-5.531588073075317,-8.202833466863439,3.6961839264792853,-6.273470407365006,-11.294560972989444,-8.664655283788871,-3.1442273354480035,-3.538810637498657,-11.312006721796845,-12.935959221330204,-14.433688113597878,-7.590703203169191,-6.4469846568628775,-4.5385456969568105,-3.4240539906096976,-8.757360433823079,-7.915699410740648,-9.111283769740062,-7.106998287741096,-5.777038322244193,-7.932351557523775,-7.86919599957583,-10.4086385903429,-4.603162987948088,-3.728757918241413,-5.377363757470933,-5.2280381854123545,-1.329774551177968,7.634239190804035,-0.7089000906143736,-8.780486131041402,-2.5797944198211162,-9.494370754574513,-3.9394063045507908,-5.039021395439556,-7.389528554110284,-9.648217955126052,-4.65130305539671,-8.493250687578517,0.8371491816223955,-10.027045220475268,-8.7313608356483,-8.407919417828001,1.5019687175344163,-5.451801773899619\n3.335596982410327,8.437807683541246,-0.670812651516228,4.293725849159362,4.62808752308888,7.686736343130516,4.4187275493372695,4.009084186230692,4.078722931899185,6.817964167316108,6.207632766956438,3.8859934169228274,5.851087394276057,4.571137373305591,5.740019576367855,2.5736855664498766,6.50863997217803,3.231710640437384,6.289123360972438,4.486220324376345,7.068808934976632,3.705065488802358,7.861450858684627,8.895467415337567,5.476996808810816,2.8622879408330437,8.639543365365546,6.672104830238277,8.543281651250087,4.790865753393792,6.877652762905953,1.6979768578036467,2.5926229472504194,4.0164188875524545,5.298161258185286,5.535215832011583,3.381604812922075,4.765492270763841,4.2395140464015775,11.055810223499565,1.0911625972075323,2.4096308427256607,4.6191226946959,2.6810772090052426,8.51860742838192,2.5509693750951103,2.643119093943485,9.621553575207242,5.896975104732698,7.249994262720576\n-2.158010534213452,-2.427268160027485,-8.201976624702613,-7.364153933224479,-6.0565145599511885,-1.6084761064123996,-8.454389213284513,2.7863080161281895,-5.4532844450668,-4.912109623061697,-7.542429428513923,-0.7711587911175217,-7.596634832530524,-3.878957640375365,-0.5988215047820331,-1.0128002116573223,-4.9662278387214505,-4.561287798872339,-2.2712475407364003,1.9889382285575787,-2.721580425750468,3.311731170791008,-8.239218827715487,-2.4373450539307386,-3.2804719626509584,-6.525751230425007,-0.8331111237231885,-4.016910270452575,-7.31938223185478,-4.892232233470024,-4.806103208116551,-3.739261977085688,-6.2237078709762175,-4.160087695175469,-4.958059384570919,-8.056838465141952,-3.003075395793309,-4.4517600582997785,1.258144893766416,1.2023584202017847,0.2915117314782981,-12.72412853733964,-0.7508995182146758,-4.760757900213946,3.275046938242803,-7.012117114299776,-4.610287366044299,-2.15843538405114,-4.124351666767309,-6.201030018979541\n1.322492546162537,-3.6840452286458256,-4.883037570054301,-4.637892054781712,-1.9692875608603495,-7.615914752648039,-4.236139993783813,-0.19987357474912493,-1.3275802811719055,-3.560329452448331,-3.985862631781782,-4.725420962718958,-4.393448398191093,0.4852614394215994,-0.9399585571074849,-6.583380202885288,-5.9992670882280414,2.3722303883738682,-5.368116066207754,2.172362875585203,0.9736679247847224,-1.493751511901182,-5.043964251001055,-0.894062377415235,-6.034716582760114,-7.875932129078185,-3.0082177636717864,-3.8792935090668323,-3.9953486777739244,-2.328710608481174,-6.442084140975963,0.6950045542388184,-7.0192921090345,0.17976473452781372,-12.714220215699031,-3.885125680617923,-3.1681404568208467,-3.589342284431942,-5.176119237959892,1.6518666533072937,-3.336817422437928,-10.565302282110462,0.40872659420156543,0.2637532807258176,-6.985192067472285,-3.067516248091323,-3.9407540385082687,-3.274444012788762,-0.6617294601354327,-7.11404059390768\n-15.286535144178803,-6.519121901704113,-10.555853389881271,-9.969391578421302,3.992042347956597,0.7405758311335129,-4.656525483304414,4.544238147696028,-6.881048832812058,-5.596489976575812,-1.821363532077509,4.343677010083991,-1.0933704300215927,-11.390094990084165,-11.521964563782044,-17.949301720539825,-3.222001874934429,-4.929650815124685,-4.727141837446396,3.4669564138853577,-8.560445348617176,-16.452562172850076,-1.4136273998041897,-0.19935812289672383,-4.749549189132131,-1.3346871397493558,-3.4948436367223836,-2.8769632972264736,-4.487122495775209,-1.1463222101518147,1.4459669683536243,-7.463764627820022,-1.2513047726588382,11.451976046018077,-0.7982746945010553,-6.101451727095413,-3.3132534533699296,-5.837104256698291,-1.174276626488636,3.033692994850375,-5.312653467472748,-12.94983117356348,-3.6535753425489084,-6.733131884790879,8.72676903982495,-8.569701809240282,-4.680254882728522,-1.6972585996283236,1.4821929260303346,1.2081347289296795\n-10.69179829741132,-0.6253060626441068,-8.139633346227754,-7.576665047168744,-1.328612186708466,-3.9656967754563643,-5.607157732342566,0.5833333931569409,-4.517307591589591,-10.849567614514218,-4.566670685531744,-4.241377917195824,-3.907399725973984,-2.8063067281647207,-6.499838060623312,-4.817511656040364,-6.2747980883582,-11.993391947076518,-4.786501418980497,-1.4872451564376172,-7.043041506610672,0.6651967546786184,-10.395213430412715,-3.5916040919811065,1.582159677831699,-11.826779733986855,3.277462717885294,-4.86096839248186,-3.5911390392941898,1.2908144961703374,-7.141092324108061,-6.784945529624967,-1.6853988808991698,6.527337441477599,-2.3660133884837258,-4.4357259023923605,-7.428906576567887,-10.035408505362868,-4.397731706433075,0.8101115378455115,-2.9720820127875616,-11.059181745737654,2.8399797376956526,-1.4832931498142363,3.9401858454764516,-7.267779081432085,-6.417711743742028,2.574716742442561,-2.5479377191151737,-6.384940900926946\n-7.935448600210236,-4.85115407654922,-6.118155852302122,-7.445841504887703,4.69445752047382,3.571464139968706,-4.392490195639987,2.286532959546379,-0.7889088550893466,-4.1289448517187815,-0.799288269596124,-3.1568946327760545,-4.277143278078024,-7.31098525662761,-4.890859719572984,-11.32311745450883,-1.9415703173193277,-3.482632933419988,-2.2177240679936383,-5.607236273958332,-2.6037819690461643,-5.390060142372762,-5.723758420932352,0.5781384039018924,-0.774569898329041,-10.023511425889769,-4.741136480904549,-1.5784069035931343,2.3218597166373898,-0.9048790032685043,-4.462314256529328,-4.374871930649975,-0.8059107027109633,8.19018992781231,1.4481449797011283,-3.042205385353898,-0.513598794696073,-7.546452527366029,-3.9570124400528295,3.546679391253792,-6.9383129663870085,-6.2095440396027115,-3.6568961386911494,-3.795702631569623,0.40790466717350693,-6.397987180824883,-2.1509953039854617,4.33916070029095,6.509100474507605,0.23869995295883206\n-0.936168249703647,-4.2001540690058405,-10.601886138872064,-3.9298753496282615,0.7842261872812455,2.7782004785195156,-1.4205354654342948,4.198132148900821,0.8866382125933043,-0.9108051169084672,-1.835244771014941,-0.006743548601560165,-3.299504979487276,-6.492297376093685,-2.4025919327992282,-8.55490554937997,1.5052485743633304,2.8464081377681665,-2.963840858802458,-1.0356831508711624,2.612196347915468,-0.635199594964561,0.0695095529989227,3.556759319230447,-6.044092942489971,-6.240994480932775,-2.5746190678120837,-4.4391043933775425,3.700510671588064,-1.0825747085292143,-1.7587093514210181,-1.3807995847368044,3.749567905843403,5.386089949811943,0.17246197887844916,-1.3485016642847993,2.370194589380066,-3.037141350619949,-1.5142842901741458,1.6081852438219013,-4.514166841458233,-2.176110784005661,3.092787560647923,-3.308838984547929,-3.3130322327816124,-3.4527170007551597,-0.9779189350427924,0.4237072106538926,3.991955840138081,-2.662141929626336\n-9.10871451073854,-9.909731976419565,-8.53351010701348,-8.768842983662894,1.744364061926817,-3.3948338223462238,-5.15217484575674,2.189052205429258,-4.421230426792009,-8.479802582199298,-4.526621492927047,0.012909380198054368,-6.936549779114789,-10.773004178797645,-10.189054504357056,-14.929508084942492,-4.310382978165381,-1.601414234968976,-8.978588214162658,-0.7235233325839583,-6.730995392405331,-12.51902617512536,-5.199327674992448,-2.4742692096194325,-9.221248349074614,-6.768977577621099,-8.830981731891445,-6.39980110518586,-5.409818139220484,-4.011653256041741,-6.526716155619278,-5.6303885041073,0.694977767222628,6.830265812491261,-5.382303554644421,-4.847833488539608,-3.0290811137297915,-7.174535907124568,-4.956193435335653,-3.1718357605791883,-5.568810747301724,-9.576168877281933,-3.3667677004969994,-3.6792009793757527,-3.584256926801501,-6.239906624698822,-3.8037305097858933,-3.8640009096745933,-0.5859042337855684,-4.621763426106328\n-5.443164862667945,-10.316906332716995,-9.60366141203787,-8.9176477729131,-4.834247073646126,-5.6413701401342475,-3.4767490035995676,-10.119273911194918,-4.693075947288248,-2.5573551315836194,-3.279891907507761,-8.87005573675074,-7.843736506517106,-6.8890121286071615,-5.4601213958771915,-14.832933978456401,-9.868070257887307,-6.063372270983299,-13.063126978947663,-7.724043232861963,-6.29130859586575,-5.196798847739515,-10.86709942018541,-5.970834103818813,-8.801503725029832,-13.34931674019462,-6.485144703546523,-7.1281192852151865,-7.512467622482566,-1.8505842787589761,-7.954857315597954,-4.82038651124717,-9.445022778806667,-0.755528278459761,-14.38497933419088,-9.272453995486602,-8.178364509523355,-11.522131755681611,-12.1622368425924,-7.223968407942709,-7.131578629058638,-10.208662269003046,-0.23798683544347865,-5.21926379305456,-15.885812571019395,-7.35852373124673,-1.0362278409659955,-5.3395799256707095,-4.7158513906012685,-12.58269893725782\n1.255766002879084,-1.5113879751616937,-3.878116244189829,-0.5741484536796778,3.7585271507119495,-0.7130116699554683,-0.7922397078319174,4.419313820231582,2.6297804276976757,0.6343164296184551,2.0579512256356614,0.2633819146125042,-0.8414455607050664,0.36689149888499784,0.43387206508008136,-7.189175176677443,1.6937177824046388,7.614179784631681,-1.4946295805823013,4.2949028873898865,4.667983191126636,-6.031406247080584,3.8200595814732514,6.119628109103813,-2.83757699765293,-1.0703616274532806,-1.9876866117879293,1.1905899585580042,3.232090807083566,0.3551179514108911,-0.1800229099354005,2.6586991208793087,-0.4625231018257949,8.417054903322002,-4.272733544530895,1.3746552301596167,2.2503655029242338,0.9319946344572021,-1.4372602977015199,8.146640846075233,-2.6594290440365107,-4.645231428308381,1.798232574866713,1.5704051333157754,-2.0450183406028475,0.5667615993924209,-0.6392051762300239,1.2433216118986798,5.400398312645244,1.152732031137753\n2.1611685934471616,0.010804808026578905,-0.10998423856517414,-1.3376352272148289,0.8303278499819969,-5.593235660166272,-3.301737662798353,4.630807486634525,0.7456883506122245,-4.967423547836372,-3.3900353958531744,-1.5367188306344304,-1.74472222665272,2.4763967876876,-0.19443426333400063,-0.05170188994989666,-1.9935345392421517,3.6974254362835035,-0.006444923052492557,3.8604946964798623,2.4003370494954948,0.6211262184396721,-1.8875903349707013,0.47802386538343367,-1.8920061148950973,-3.5439297909517844,-1.3344115421187497,-1.8314122572505822,-0.5234209062404014,-1.8008261198916213,-4.841692221635926,2.0026308011039564,-1.1174298258615962,1.524560433495988,-4.892945889489397,0.5215602641149054,0.26609277285836286,0.11113965109548685,-0.4569261066098628,3.253955000308916,-0.7930816705288671,-5.221738597101137,-0.267105851821114,2.750196036536411,-0.2583132734297112,-0.18813956312001062,-4.1965963390274945,-0.7736236091493834,1.6814896852049168,-1.8553921067558448\n0.6300058556089572,1.5296700056324892,1.5590171491832634,0.3361083692525337,4.476363689871827,-6.178463682952254,-0.2564521235394456,4.043216199361571,-0.7749595311683108,-4.944878745013207,0.41062776714671356,4.400909287099413,-1.3625174043875616,2.632631841644263,-2.0619311483940943,-3.0653650402597026,-0.7291446739888593,4.981290028619727,-4.241709437658833,10.712166147820902,-0.17897871693418121,-9.437613617417892,2.7614655264439083,3.2182247987229458,-4.350056531335546,1.1706083627445063,-0.029484443803964422,2.1422662963607486,-4.438731087174852,-0.8887952017866936,-3.5553295185504386,-0.5982863050389136,0.2389296672832184,3.3969389795210576,-9.712655054991297,3.786191922680552,-3.0072146080858406,2.43869249366537,-0.5762202073627374,5.2184626206832325,1.4118457119225263,-8.798830119128171,-0.2351666154383505,7.281224939536419,2.5304763145398814,2.2286594492406793,-2.0163866340739047,2.272531011185459,-2.2219258632979653,0.7088648774129065\n-5.79711194524251,-6.612031715176755,-5.422644681895455,-7.517593715938296,-3.746038451615285,-4.366032249222548,-6.8983242559834475,-1.4889607144976775,-5.517785495780723,-1.0843534719282375,-3.494808588840317,-2.931936138190216,-3.326269093419892,-3.6415938185838135,-3.0821947947550283,-9.579832767478274,-7.037535355492072,-2.081882373673837,-3.421813581862636,0.875691219374973,-4.4038090026660806,-7.389803197813846,-5.237439687488392,-3.4193988063894563,-3.1067686942595687,-1.5783483416657376,-4.85593532108818,-2.3769858066807013,-7.513083347600554,-3.059112325760563,-0.37837379117458003,-0.9397872698592381,-11.733707531735059,1.374701197331372,-8.146590360125154,-9.784173419652973,-3.234143685551074,-4.248651112739375,-2.605944052421142,1.5053422481182006,-2.831525666847011,-12.736345145595475,-3.9793140034380015,-6.645118496056785,-0.9742876879048122,-6.3747178621116145,-3.798198588503527,-7.497609877912785,-1.2531461232800667,-4.002697329554693\n4.501795227079165,-3.797856722269149,-4.917340717069216,-4.142392850621615,0.24295194437565593,-1.2682927562397468,-3.1949060307042743,2.4778838976085273,-1.0073531312905908,2.210621765444139,-2.3681712607776335,0.6226398815184304,-4.296014127688362,-2.513008137413566,1.3641365464246793,-8.098387858281129,-2.2137268480555394,7.69377623895491,-2.8486199466710196,4.4947029632415605,3.8231714977478326,-4.195032278837573,0.004832131057723288,2.8998001597846104,-8.727497263081611,-3.307802658685026,-5.000772538506325,-0.7473195809191235,-2.9090942091686296,-4.661790015214612,-2.2053262015251227,0.8479579522048293,-6.4897419297511565,-3.020384115060815,-10.725495677330795,-3.3387927820646204,0.7966901616225841,0.7008457086365731,-1.0236673108862275,4.302474441543135,-2.828836439068322,-9.718872369271185,-2.9827617335108654,-1.4128147041070411,-3.804840500933106,-2.689596211480693,-0.8888987565023758,-1.576983819637632,1.7629967134840139,-2.140642113332695\n2.968487780515906,6.389653357413825,-4.058617080066083,-1.7666573858686148,3.699493756413152,-5.639845307755697,3.292624929860595,4.581820174139961,-1.2726283414179487,-3.291494161904586,-3.5291274893984994,3.2358306200884357,5.646705685731791,2.5731611015992626,-2.7361253840658755,-3.6797692241158675,-3.032282393459801,1.7809234751577359,-0.3857227936761996,10.079912152650035,3.22059557264244,3.5456291234206683,1.4331560429139771,1.8364601829488372,-6.676904790292362,-5.991789813196137,7.8423239180084625,-3.403218915357356,0.2661016411372694,1.1385674821342344,-2.273119509351617,-2.3860834605976997,1.2899355283228486,-3.698342506055302,-9.446690510827146,3.9550476955507623,-3.6010395208448704,1.4469067879950281,-0.5143388684759985,2.2449135351577687,-2.4413618940939554,-7.166272292989753,2.9878754729597525,5.0618964234308725,5.746839410576374,-1.7433963828683647,-5.300666029151062,4.202513128067871,-0.3461384406327255,-2.1514643775710236\n-6.2673755787042555,-4.019575069338683,-4.579993821466237,-6.429867255647408,3.0901548872272717,-1.4374335932824212,-6.641463688528069,2.923425603128485,-2.1037169780074354,-6.974022955191634,-1.1157815599102976,-1.5327048728962374,-8.01122023528172,-3.6852540803446447,-3.460790591648249,-8.728804765137829,-3.096446922156906,-1.6222280798864954,-5.649445283449058,1.1589525200902926,-3.4201071247840233,-9.242266642738025,-5.768521735018762,1.53558453673564,-1.8166828523231342,-7.8085903771845695,-4.566656512815283,0.4907050647387128,-3.7580083124150954,-2.232156786388717,-7.134239853835378,-3.8077526467273235,-3.6698716254087813,8.109257898230476,-5.9656537477594505,-2.9322167755860598,-3.397592869702807,-5.9997349372584194,-3.6529486436288003,6.599203709014336,-3.004717066858839,-13.074791625190327,-2.571398998282058,0.41514383585917725,0.5342436538462094,-4.382187533257807,-2.8005007175058667,3.666622319388285,1.386792987784996,-1.5707168316102655\n-4.208424669527474,-5.908040816225524,-7.316164323952265,-5.304792828441856,-0.8524281716783049,-1.8698296713016416,-6.894789514239907,8.36796673048242,-3.7528162710783657,-9.048749654566736,-6.1875010362041785,5.163207345010622,-8.621447179948877,-7.989218669581615,-5.748038033599747,-4.4387810516321995,0.08933448864790128,1.5455502780387027,-4.965067810842413,5.4567165183089585,-3.6759063231877844,-7.3770748066317795,-2.0519801457274305,0.3697565230805533,-7.40795869704556,-0.896836662118573,-6.187855172907137,-4.504725101052121,-6.098439915510005,-5.946546863782664,-5.167054253782234,-3.697150087308268,4.342080755255587,4.037672115912088,-1.240947929437005,-2.9595535574124905,0.2831407812456286,-1.720054429504684,2.5887181337325043,0.04646132487663568,0.8353110506837851,-8.658927074462532,-1.134911960326436,-1.7174607769200247,3.11183929028161,-3.3399188427660413,-3.8562039897609703,-3.3573883746662556,-2.9035202918282503,-2.5704661699583955\n0.21380924706806548,-4.106652459992706,-4.827738193353805,-4.580126923696446,-1.178820719520894,-9.09797335248272,-3.651198457841796,1.8472101298698806,-2.828386321190484,-8.814523069107153,-6.241591079439768,-0.6848051324017099,-6.483809414062534,-2.352594841671538,-4.7699364119901455,-5.462372314945073,-5.264266771308365,1.5111060242124683,-8.411792745857642,4.601065347478929,-2.0890200984562326,-3.629158996560051,-5.07842685823857,-2.1376878826950696,-9.817801539898994,-7.559221014522796,-3.837710197693899,-6.1226327207439555,-6.999434121635661,-4.020201542928028,-9.596414402186793,-2.542715731268743,-0.566393580134799,-1.1080838786713954,-12.458614006158747,-1.5480433649865768,-4.516254101389014,-3.431902566790592,-4.218193517683515,-2.91284734793052,-1.6302428425149518,-10.037433562628477,0.40392414595533754,2.751063569510663,-5.586989810205397,-2.3535665918986495,-4.531527830331861,-3.041307293275281,-4.834587450975379,-8.076209535597702\n-2.5157972441760164,3.861474539275994,-6.081922962926324,-2.253121573481353,0.29707061666426576,-1.1522546344396358,-0.9051680072598539,2.1248229452009855,-3.2350383825212243,-1.729142418449925,0.3151992402200592,3.743696386857375,-0.6433392033977932,1.0365648867725423,-0.5746413336971554,-3.30354794653822,-1.372842337341135,-2.340741405562945,-3.202013166064814,8.911629299134223,-1.1160391537995116,-3.0691120272962413,0.48163201671133593,3.6494991029366974,-1.3901527364289348,-1.6617587419838227,6.455116106207098,1.7337328048055052,-3.950409785808194,1.3855390133991596,0.13477646604786364,-3.7656748144149104,-2.8060292011784034,2.461498055938796,-6.976065687468839,-0.6247919731575923,-5.056967479207937,-0.7254947432454417,0.40071790852841027,7.093522934962321,1.2734591907551764,-11.600663504556925,4.046426069287369,2.0483322137722255,7.0900851700854535,-2.296922635725412,-1.9117115883652815,4.531976969177347,-3.6128649728616824,-1.2297345663783765\n-1.4709527332060666,-2.2859336381213025,-6.366740161078279,-3.8668413995401605,2.6578017394064126,-3.2506450254491632,-1.2173520772363242,5.932485189954048,-1.8421482456853,-5.971358665246308,-4.010443873205928,3.8435862800281413,-2.1707564635734062,-4.817370432940268,-5.681423206694016,-7.448644588561232,-0.9268428271123073,2.973271157872109,-4.365028901978009,6.001790025978922,-0.4869610394021109,-5.041136545545907,0.3303504974603957,1.4075421989437409,-8.723260378056946,-3.819521114654818,-1.8764461725979036,-4.561530535150908,-1.9993294415304947,-2.5295737301750263,-4.0612639906541554,-3.072107721333424,4.171042524918059,2.4192510412023562,-5.177943102833455,0.7405968696225859,-0.9624313364176484,-0.9139972490284108,-0.5641809967761837,0.016098440644816137,-2.385613190236393,-6.535643254631346,0.42409625517214655,1.1791367569119149,1.2574325875342034,-2.4049640605737292,-3.6825695993974445,-0.25044441910494686,-0.39131684489191354,-2.3258562786012233\n-4.502972136126779,-8.341294558406757,-6.229225120514656,-4.5280194773049525,5.114406631935327,-0.6075487950445222,0.9034456708753881,-0.6469614678117717,-0.3539215148551651,0.8149451107872594,1.9968122893822866,-0.01555696409508344,-1.0653015041685312,-7.558568524007801,-6.48617708868817,-18.08052876822756,-1.212043695133324,5.016749715435796,-7.111995952976846,-0.6457888180052342,-1.089824177015394,-14.577386982048528,2.3331701201261374,2.129587007067722,-8.911404064518747,-2.6447259920243713,-7.664303362763219,-2.2806965471569853,0.4866922734585051,-0.6297186964903381,-0.3714064653258531,-1.4009365374710714,-0.5050836364851707,8.253642577312648,-6.407347010637617,-1.4415315676354763,-0.15856665033966322,-3.068769004211492,-6.266264845547968,0.15689609202492516,-7.277012853502568,-4.1746778846906984,-2.214132640562297,-2.439913138710221,-7.647812580997913,-2.53409408616761,0.5141172584262828,-2.432003281096029,4.245307732274421,-0.6118758022007285\n-2.01479033082884,-4.530998618071512,-1.6047836765115693,-3.2515119836660276,-2.1241944946230356,-1.4549963793386531,-1.8705631821635107,2.9052083710968155,-4.168747767680897,-7.077551278290954,-7.739486652307728,4.390206817595272,-3.7939704528260463,-8.41939285836812,-6.759654080824167,0.7303805589920522,-1.110602174879513,-2.3386670317784115,-2.49684894205888,-0.5820883478205349,-5.487302820045784,0.06538912313821693,-3.29492859019282,-5.982291401553539,-7.660156358707505,-0.37381631674627597,-5.121784158755415,-7.321598540873365,-5.563156144627303,-5.7806391009918325,-4.271500626844832,-4.783404854900069,7.255436362918928,-7.0678084864709,2.6710939726535132,-1.4753842424823231,-0.028990241251812904,-0.9767542471251933,2.5132843297926173,-11.67627904917873,0.7829338873184309,1.7622472787799983,-3.857855204946766,-2.4431902792777813,1.050594116035797,-2.455733847751699,-2.351489081913167,-5.197188421036548,-5.4675070848599026,-3.088960973339876\n-9.952855521047445,-10.728312270872031,-9.923188577961927,-8.392247091897614,-4.099297467851235,-4.351192164322134,-9.727309905092048,3.9746062214064306,-4.698692418768775,-4.73933674560476,-4.756072850188566,-2.1134290969418568,-4.7213837308511355,-7.254953356168473,-6.420500981342299,-11.932520514437357,-4.31637147131138,-0.2866056530938419,-3.3795095619556346,0.8309916242757529,-4.802970818840804,-10.786433317925862,-3.5672504110204,-2.1951930448978714,-3.041917625252888,0.8565557967311681,-8.144505384869698,-5.349543879158311,-5.135970335998552,-3.3746527253860528,0.49765923946381907,0.4417090769274985,-6.368402363414072,11.09908900070949,-1.8374484352650158,-10.680783051375847,0.4645481662700477,-4.9104574272728785,-1.0228818111549787,2.383252120701208,-3.286172525012196,-11.142411743918798,-1.6542791639197705,-9.441947417261055,-0.3539808572536334,-6.731589662978496,-5.824192462520308,-11.820196243727187,1.45611632525604,-3.663612060425426\n-7.834492650183964,-6.8881359897353684,-8.83520715690916,-9.08754280056328,-4.516252265442722,-10.50581975718381,-8.727389920891166,-1.1440273322753844,-5.288395362744433,-10.487653820062238,-6.490168349051586,-6.879295100841678,-7.8109295258525835,-2.7052809015666597,-6.244232178881896,-9.451076044146205,-9.762351311998303,-5.89394256028522,-9.307704769348172,0.2496942905741535,-6.326460051544639,-4.9722475324982165,-11.2009670834969,-4.880416898028658,-4.343743440975308,-10.932580443262555,-3.672921832858218,-6.840317757325597,-8.660704647298775,-2.158029484781523,-9.404193861652569,-3.2130395360900614,-8.279977268406997,5.680426131327992,-12.36229968335578,-8.45353142308068,-7.619863983439451,-9.787749624109443,-7.453136198393764,-0.16004684956609294,-3.7775576828477666,-16.238099075038726,1.1119026615684853,-2.4633457550777704,-5.390922555094757,-7.072969848179285,-7.187921316593306,-5.681605178746404,-4.175886068868282,-10.85890907775043\n-4.836175332908319,-8.872051589936289,-6.478268280740753,-7.37354742684208,-4.164052645398226,-7.1607218406966435,-6.910209336288325,-2.0423420690749703,-2.9749892063767955,-3.5927821682568877,-4.6161762610129315,-7.543324633998639,-4.370720951327358,-3.2938837788371584,-3.954037998828343,-10.308511603056942,-7.6292224895786696,-1.0506523802108,-5.046318564204038,-3.217481244246015,-2.8644285646461656,-4.585844215260735,-7.316651675948672,-4.39970240418158,-3.9513893045651054,-6.287684840720005,-6.900190166543439,-5.938957289815281,-4.476297787294335,-2.4565286744436117,-4.147270818641489,0.881499599606903,-9.342151355524338,4.198586671644002,-8.291029751803187,-8.954058066276037,-2.398758826455889,-6.672518440983416,-6.1454934582760075,-1.0581601445582796,-5.243846081348415,-9.474199880937094,-1.6621501412400452,-5.956852803896696,-8.193603062261856,-5.811102475520174,-4.784538976795078,-9.153336735772017,0.6768566629724766,-7.458773394162623\n-1.2061910210670717,-1.1998295108607935,-8.914576395451874,-1.544942997349061,-2.4707614895159264,4.702579835387483,-3.919296951080721,5.233759438109315,0.9593269522102859,-1.677033800029153,-1.046390461823699,0.6628361994775973,-5.642804900282866,-3.271670951990915,1.4134429983828247,0.37292349663824353,3.7714260548006777,-0.17282006207688028,-0.6316340159535154,-0.22326778301527872,1.9679018481015031,2.9591682142086144,-0.5797693519280196,4.408109324045217,0.6723185056647005,-2.779170689758742,0.4561600771054529,-1.1915471886981468,2.619012805088464,-0.464366161518015,-0.7801584429501296,-0.7260782169293813,3.8389481925559914,6.489864067630375,5.103508530181092,-1.7040519597231143,2.6149672047302706,-2.109148979366802,2.3015832067870914,4.890277528393632,0.7336072254012764,-1.9489518115242501,5.553694187550029,-2.6905009070400907,1.4095211882748864,-1.8818125330230702,-0.2299516593965265,1.9398140352895379,1.3902069600112532,-1.5466305901397863\n-1.3264536777337446,-13.643661499224615,-15.80461366322815,-11.922101219064949,-5.701289288610631,-1.2154430790011679,-11.164457715456958,4.152070053745815,-3.9743827153532325,-3.3108804386082005,-9.328269290818701,-3.515449961227486,-12.931584854378759,-12.205801152945433,-3.2574900215198728,-14.255182678003536,-5.10251657086217,3.91685730540621,-7.097571971680653,-2.346449659335458,0.08352588002787709,-3.658959974882622,-8.073894569873968,-0.9748543517163748,-13.07459411624668,-10.453217368021564,-12.58374297207006,-9.123274325536995,-5.409969400958742,-9.090058749917507,-7.0147960507022615,-1.6140304159709946,-6.739614110040031,0.271500762250116,-8.550090802390539,-12.091500075251945,1.5943887645927517,-6.970336736958036,-2.9369629426359607,-0.3742877828145428,-6.336230887995097,-13.711090364621684,-2.969548914570818,-10.335062951561321,-9.228748152210246,-9.671485210499712,-4.21659619470492,-8.742997433779191,1.5546610315769556,-9.4371360617993\n2.36709846081605,1.8816606141599448,-6.042322411888497,-3.7550099663624414,0.6360195680437222,-2.464474359055439,1.674302073335208,0.9975626685243519,-2.51914985841374,-3.5301070652330755,-5.016768959595438,1.7956407390766405,-0.7495604529874544,-2.793389769954437,-3.0731144052589263,-3.885671122491626,-3.421336696540603,-1.355157288736061,-4.149865328336146,3.5182339680174755,0.3073446283942982,4.483855175074107,-3.042899315060937,-0.7653486882585594,-9.093448954569315,-9.484486808273026,3.296791366735499,-5.320647349366821,-2.3211501117607667,-1.6435229966319955,-5.575577521652009,-5.320076815354164,1.9320117075447452,-7.720632627444835,-8.305476333756815,0.9617655147082416,-4.2160147548422815,-2.1601181463871173,-2.0889916521228438,-3.6581951459556317,-2.6620796562349014,-5.606045459509255,1.4542722535532346,2.027856700193256,-0.04438363867231865,-3.554933788697373,-2.701343043919742,3.5094014916771314,-3.3468095190198106,-5.482309579285571\n-10.792990442998128,-10.561868460566117,-7.94673320053642,-12.476433343961151,-1.0074610649535496,-1.7841051492125446,-11.186400296916924,3.617494867461283,-8.101294461370614,-9.950128020565222,-8.100799876993918,0.45895156829093603,-11.170946746818359,-12.547313971134123,-8.990833934575672,-12.034915079635885,-6.712108140155016,-5.250727736163098,-6.74730143621714,-0.8178784792750109,-9.591068875411281,-11.326235646343896,-10.332010840368406,-5.052637649736278,-7.413340763007742,-7.079790039051511,-10.658479648368075,-5.388194123010794,-10.614561798710191,-8.028937022492375,-7.731677355931504,-7.5980728639909065,-4.932185062433102,1.837450321933659,-4.6535689011196375,-10.023499581028693,-3.641362822174825,-8.236341176249747,-1.5842373687236349,-1.8221225755079529,-3.7485397372887372,-15.818295648234432,-8.681618964761784,-7.173264842067294,2.318919048561198,-9.922448003505624,-5.42432323370785,-4.338747461413809,-2.2994620206168372,-4.209888365021787\n-0.9416431902264577,-4.569555958545556,-4.849911994869059,-2.875484810554096,0.5572747460922333,0.598635607130009,-0.3743205395996257,-2.1065126521432718,-2.061183096012539,-0.8333027913253973,0.3363003677204095,1.9491431071909011,-6.727688095264013,-5.585104678984554,-2.3456657828933505,-7.761537354545881,-0.7899346674650367,0.8954394580276135,-8.640180443733177,0.8352084898737151,-2.5386423044897803,-7.9479659880523,-1.0665926468547657,1.3572251936168158,-7.7834071285812785,-3.5905307667939015,-4.240839701319502,-0.5682438999617252,-4.858268998750793,-2.47181098878469,-3.9342274837663185,-4.243348499969317,-0.13633878314721448,-0.2229358550425704,-7.548953630512071,-1.2510052143592043,-3.1756692617899107,-2.7610820849536473,-3.59185250131873,-1.401514547279658,-1.243542545127152,-5.855897961685897,-0.38581895837865665,0.4173427965650867,-5.740723415497311,-1.4959719647522833,2.350185273214139,1.3296776554130614,-3.775602655299647,-3.33234180027792\n-7.832393834532059,-8.20950987354011,-7.564997132853279,-8.976224619993685,1.1441208368292863,-5.325228606568661,-8.162677134239631,7.92601798808248,-5.541120559139344,-12.420147724834154,-8.14807602601159,3.2019603831099737,-8.164137764122572,-9.8711038832172,-10.05769846485106,-10.281171738272382,-3.974109862387682,-0.16378310550684283,-6.622285775292121,4.588228378469127,-6.386182613666553,-11.01146771812145,-5.316073743456009,-2.4839980682371308,-9.54665319657833,-4.776765676318185,-8.482381212808246,-6.872322179781343,-7.754255739560097,-6.6365147319894655,-7.8998744643775884,-5.364854897298837,2.0267689712743397,5.00808165675333,-4.78297174021389,-4.50678234226201,-1.9719618866644066,-4.687026799394231,-0.5192401761443601,-1.502478610587691,-2.70133727009783,-12.565358242728982,-4.468671810209432,-2.3865776071430966,2.572607349479169,-6.126310900852659,-6.740958101786881,-4.59571863601505,-1.8408838879762008,-3.811109539017784\n-3.3733001618770437,-4.38500537494418,-10.071602099128427,-6.4558216313991945,-2.3584881897691328,0.9852673737707847,-4.4826278085669555,4.885104466906043,-5.614556731064311,-5.350197665012782,-6.3529739851663,5.892122722390028,-7.2778004364475954,-9.707647716982459,-5.1567021215345354,-5.564179840202246,-1.0561722318558093,-1.6411112500236453,-5.557749024449377,4.313904919721065,-4.102546094100093,-3.638531293927914,-2.7911481089338492,-0.41654470656144404,-9.450646286442153,-3.113970779085679,-2.942390629445111,-5.140090830289733,-6.930140630490574,-5.534916454037467,-3.523069273590404,-6.634574647790856,2.6895983415665157,-2.503044699577685,-2.832288580137093,-4.328735231599238,-1.8095376149939597,-2.564360932057756,2.1875017710388023,-2.615676553373659,0.09520889832589396,-8.900310118188099,-0.5999015173576114,-3.7068855333897317,3.458883793674098,-5.522962509962214,-2.360229848150789,-1.5557101525868258,-5.19073330717997,-4.091443438090275\n-1.9759362917396341,-2.2021744521004107,-8.04136978589775,-8.065605198110301,-0.87321764942676094,-8.904381937996625,-4.182872707768179,-0.11659425741774632,-5.641297804644903,-5.571450977124004,-5.380918052897367,-1.38118066605266,-3.9718246976164364,-1.5395379694871845,-4.304012037054972,-11.195803814999591,-9.051843844030085,-1.139874677229102,-8.236559794197982,7.1967333825137905,-2.5255855957376707,-5.0743419229108975,-6.22774141827025,-1.4286098196702008,-9.562257799446183,-9.879829225217213,-0.02126756292520393,-4.315771676730654,-8.83099651784064,-2.6787353436093206,-7.040117427759796,-4.29225502695169,-9.137397637459838,-2.060939567728503,-18.444281054730574,-5.062311639509432,-8.042761685758467,-4.935180054193347,-5.584522853049824,2.148380887151658,-3.847381670076449,-18.65132906987398,-0.40804473613866366,0.63385802049214,-1.596565650507356,-6.300899111588449,-5.7906547826299,-1.0505269800151003,-4.278463978438629,-8.115712913408997\n-7.860455098941947,-6.687421059673293,-10.638338024054724,-7.16818520456826,-4.957987282474862,-0.7321030496265892,-7.837840666467003,0.54092230792347,-4.706779754578103,-2.9775045435928007,-2.661244542540781,-1.789198025507455,-7.152582866095494,-5.767705681414842,-2.9042489652114027,-8.26878888086107,-3.515888212372145,-4.1041522972854905,-5.410467800387857,0.12501373743650568,-4.689117313288163,-6.299110536952627,-5.1410570420432284,-0.47450003590882317,-1.7183179915878404,-2.8846321356511613,-3.3606061224784143,-2.5474335253646445,-5.849771342301109,-2.005733620410158,-1.0913729695789005,-2.6980451154884104,-6.484274351922346,6.933631355084792,-3.489003175973037,-9.237607804407974,-2.744763666251141,-6.142689041342478,-1.72120901008262,3.348233454720911,-1.341887928478711,-12.012614088608714,1.2909755629784416,-6.885629498833452,-0.3488679658980577,-6.388741355678908,-2.6443142051363218,-4.658756105124133,-2.162196919302546,-4.979866543116972\n-10.434084014531352,-4.596377970922135,-9.587333797789015,-9.17889156110062,2.0255597319438086,4.351759990539731,-4.288967941488349,-0.3657349249330446,-7.334395139283663,-7.913211701391685,-2.231504571565604,4.618767383220906,-11.709038483402132,-12.425194221654825,-7.762843776610596,-10.849617449992444,-2.7949936894780354,-9.616738038833159,-11.550991773206304,0.014037696168998304,-10.433888855495193,-10.758601383723718,-7.775642460101415,-0.467541081275582,-7.296876455785572,-9.925696648605228,-3.0159042201447352,-1.193789181232005,-9.406025469521774,-3.80086939337795,-8.05590278662723,-13.62355479826415,1.3720425990172789,1.0719230509586029,-5.038358771053037,-3.8836430760929566,-8.198731726703706,-9.066495530775564,-3.189411582340635,-1.2737831676086693,-1.7819778843303102,-13.850333990466941,-2.752864799084785,-1.456789551913746,3.3305911508072903,-7.670492925272728,0.32146019381253765,7.643723578894147,-6.863875631590329,-3.6203646220047787\n0.7009645813140973,-0.08957617846298427,2.029401229326742,0.7249907589441537,7.5793403967688935,-2.335052019959528,1.848001504396791,1.5436733699180776,4.53768846155344,-0.6566207063454489,3.8038382604632375,-3.0323353341352,2.0411155344142613,2.884747608387702,-0.6943178340832457,-6.828309667250407,0.3816137103942374,5.964210762023095,-0.7640351287105149,0.34420399520828315,4.017499276206561,-5.642464007628051,2.290299971548671,4.063814992468142,-0.16878044823741556,-3.9301820795622016,-1.8954644305774413,1.9368757830451846,5.843634160275415,2.450520721819704,-2.4513966203353394,2.837815733071716,0.35255957586687403,8.766871323582084,-3.8480858883479536,4.693406857686588,1.0682027361068198,-0.3346321675338745,-4.795985458443051,6.085972870077269,-4.781773295795198,-0.6765759493124204,-0.34852404027865447,4.778817703272558,-4.188492709262564,2.021734360111013,-0.5229924581039325,4.0254973380048185,7.66723221438881,2.4331306329307507\n-5.23428939274357,-7.489455447527511,-5.723117777247468,-6.91894387793148,-0.16575672211754017,-3.8365693413735213,-5.341313582353548,1.809637674447214,-4.9604545581826445,-7.284187612439753,-4.846005184666801,1.7131600576463006,-8.022121370018164,-7.966768724449542,-6.843834439655261,-9.472036324677436,-4.113058763534158,-0.6662108666820292,-8.2537376558295,2.2655709200152696,-5.912266391355055,-10.261386446905808,-4.785932947793937,-2.325719378465661,-8.944279590811684,-4.306547630802495,-7.4222355556572595,-4.299265530060368,-8.335182854510915,-5.280988948735072,-6.531765829709002,-5.021413370872644,-1.147038541294768,1.2908245210577707,-7.637223662650424,-4.488354701012506,-3.568010219387758,-4.488928623064392,-2.6693494847329333,-2.6682928331957494,-2.058943673825312,-10.664082379827667,-3.7234126528893006,-1.774405066900609,-2.208048472944516,-4.590487113542438,-2.8310072594529365,-3.397722437226123,-3.9034027121470953,-4.567915075519506\n-11.227956250461123,-6.969391744704872,-17.195634065988394,-12.936468251053054,-6.546904327077589,-1.5026583732574934,-13.493483127633937,0.884953810684844,-7.3108864645470915,-6.33756213239298,-4.780882698006287,-5.202115212019121,-12.596876770237824,-6.396349995364554,-2.6305724783685362,-12.306296307331657,-7.807620911075107,-8.84508531946014,-8.478907676365326,0.6049999860020168,-6.124545903080627,-5.707795507858052,-12.13511331191023,0.1259106644747594,-1.3545405214594481,-11.905426364883544,-1.9417343585938402,-2.8393360582099683,-8.986209558300244,-2.6322466587142843,-5.812191676627872,-5.90205954121471,-13.395599513636162,9.172621892793536,-9.565112344430862,-14.0499929468297,-7.092359390612618,-11.97664469744173,-4.375290441659982,9.354995931368236,-3.2262600809718163,-24.317197844671842,2.2919945462978704,-8.293044639811516,1.1060875517723994,-11.812943676249521,-5.5607817700573605,-1.1359159917595711,-2.677895006026074,-9.125884928480481\n" }, { "path": "tests/testthat/matrix.mtx", "content": "%%MatrixMarket matrix coordinate integer general\n%\n252 142 1059\n42 1 1\n43 1 1\n87 1 1\n92 1 37\n217 1 1\n233 1 1\n92 2 11\n160 2 1\n233 2 6\n92 3 10\n121 3 1\n190 3 1\n210 3 1\n217 3 2\n233 3 22\n92 4 21\n121 4 1\n123 4 1\n166 4 2\n173 4 1\n20 5 1\n92 5 74\n9 6 1\n51 6 1\n92 6 5\n95 6 1\n156 6 1\n182 6 1\n217 6 2\n92 7 25\n95 7 1\n121 7 2\n183 7 1\n190 7 1\n217 7 5\n221 7 1\n233 7 65\n241 7 1\n92 8 5\n121 8 1\n190 8 1\n219 8 1\n69 9 1\n92 9 21\n121 9 2\n159 9 1\n215 9 1\n217 9 4\n226 9 1\n233 9 7\n39 10 1\n92 10 14\n156 10 1\n190 10 1\n201 10 1\n217 10 10\n219 10 1\n233 10 16\n248 10 3\n20 11 1\n51 11 1\n54 11 1\n92 11 16\n107 11 1\n121 11 1\n122 11 1\n142 11 1\n217 11 11\n229 11 1\n233 11 12\n92 12 11\n121 12 1\n217 12 4\n233 12 8\n75 13 1\n76 13 1\n92 13 30\n95 13 1\n121 13 3\n125 13 1\n150 13 1\n156 13 1\n217 13 4\n233 13 3\n20 14 1\n92 14 19\n95 14 1\n121 14 1\n182 14 1\n210 14 1\n9 15 1\n20 15 1\n26 15 1\n35 15 1\n42 15 1\n43 15 2\n76 15 1\n92 15 26\n121 15 1\n204 15 2\n217 15 3\n219 15 1\n18 16 1\n92 16 11\n142 16 1\n153 16 1\n169 16 1\n180 16 1\n204 16 1\n210 16 1\n217 16 5\n20 17 1\n92 17 12\n121 17 1\n217 17 2\n219 17 1\n233 17 3\n39 18 1\n92 18 33\n125 18 2\n142 18 1\n156 18 1\n160 18 1\n221 18 1\n248 18 1\n20 19 1\n42 19 1\n92 19 26\n156 19 1\n217 19 1\n250 19 1\n92 20 23\n121 20 1\n156 20 1\n173 20 1\n229 20 1\n233 20 1\n43 21 2\n70 21 1\n92 21 17\n100 21 1\n118 21 1\n125 21 1\n173 21 1\n190 21 1\n201 21 1\n204 21 2\n210 21 1\n217 21 31\n219 21 1\n221 21 1\n233 21 16\n248 21 1\n22 22 1\n92 22 26\n217 22 2\n248 22 1\n43 23 1\n92 23 5\n209 23 1\n233 23 19\n51 24 1\n76 24 1\n92 24 24\n204 24 1\n209 24 1\n221 24 1\n9 25 2\n42 25 1\n92 25 35\n156 25 1\n180 25 1\n217 25 4\n6 26 1\n39 26 1\n51 26 1\n75 26 1\n88 26 1\n92 26 25\n95 26 1\n201 26 1\n207 26 1\n217 26 3\n221 26 1\n42 27 1\n92 27 14\n169 27 1\n217 27 2\n221 27 1\n233 27 12\n75 28 1\n88 28 1\n92 28 33\n210 28 1\n217 28 2\n219 28 1\n221 28 1\n233 28 1\n92 29 16\n180 29 1\n217 29 2\n233 29 1\n39 30 1\n42 30 1\n51 30 1\n92 30 10\n233 30 10\n248 30 1\n9 31 1\n92 31 15\n190 31 1\n217 31 1\n233 31 1\n92 32 21\n121 32 1\n162 32 1\n201 32 1\n217 32 13\n221 32 1\n233 32 8\n248 32 1\n20 33 1\n70 33 1\n92 33 40\n121 33 1\n142 33 1\n217 33 2\n226 33 1\n20 34 1\n51 34 1\n92 34 19\n142 34 1\n217 34 1\n219 34 1\n221 34 2\n26 35 1\n51 35 1\n54 35 1\n92 35 30\n107 35 1\n121 35 1\n159 35 1\n162 35 2\n190 35 1\n215 35 1\n217 35 2\n219 35 1\n233 35 1\n248 35 1\n26 36 4\n42 36 1\n92 36 6\n180 36 1\n217 36 2\n221 36 1\n50 37 1\n51 37 1\n88 37 1\n92 37 7\n156 37 1\n182 37 1\n190 37 1\n201 37 1\n217 37 5\n233 37 12\n9 38 1\n88 38 1\n92 38 35\n121 38 1\n125 38 1\n160 38 1\n217 38 2\n219 38 1\n248 38 1\n6 39 2\n43 39 1\n88 39 3\n92 39 8\n121 39 1\n156 39 1\n183 39 1\n233 39 3\n92 40 11\n153 40 1\n160 40 1\n165 40 1\n217 40 5\n233 40 25\n20 41 1\n42 41 2\n92 41 24\n118 41 1\n121 41 2\n142 41 1\n175 41 1\n217 41 1\n92 42 5\n136 42 1\n217 42 1\n233 42 3\n3 43 1\n6 43 1\n92 43 9\n190 43 1\n217 43 2\n233 43 12\n54 44 1\n88 44 2\n92 44 18\n121 44 1\n123 44 1\n125 44 1\n136 44 1\n142 44 1\n156 44 2\n183 44 1\n197 44 1\n217 44 8\n233 44 6\n248 44 1\n42 45 1\n63 45 1\n92 45 25\n121 45 2\n217 45 1\n219 45 1\n92 46 22\n121 46 1\n217 46 2\n20 47 2\n76 47 1\n92 47 7\n121 47 1\n233 47 3\n20 48 1\n51 48 1\n54 48 1\n92 48 10\n156 48 2\n217 48 4\n43 49 1\n92 49 11\n121 49 2\n136 49 1\n215 49 1\n217 49 5\n221 49 1\n233 49 2\n20 50 1\n26 50 1\n43 50 2\n92 50 20\n142 50 1\n180 50 1\n217 50 3\n233 50 1\n248 50 1\n250 50 1\n51 51 1\n69 51 1\n92 51 22\n121 51 1\n125 51 1\n196 51 1\n217 51 2\n248 51 1\n92 52 9\n121 52 1\n142 52 1\n165 52 1\n217 52 1\n233 52 1\n76 53 1\n92 53 5\n121 53 1\n156 53 1\n217 53 1\n221 53 1\n233 53 4\n39 54 1\n92 54 12\n144 54 1\n215 54 1\n217 54 4\n221 54 1\n233 54 12\n92 55 3\n136 55 1\n233 55 3\n42 56 1\n92 56 12\n233 56 8\n92 57 5\n123 57 1\n156 57 1\n174 57 1\n192 57 1\n201 57 1\n217 57 6\n233 57 4\n51 58 1\n88 58 1\n92 58 40\n95 58 1\n121 58 1\n217 58 4\n233 58 5\n20 59 1\n50 59 1\n92 59 19\n125 59 1\n217 59 2\n39 60 1\n43 60 2\n92 60 6\n121 60 1\n142 60 1\n217 60 1\n221 60 1\n233 60 16\n22 61 1\n92 61 14\n156 61 1\n209 61 1\n9 62 2\n42 62 2\n92 62 50\n121 62 1\n156 62 1\n162 62 1\n226 62 2\n43 63 1\n63 63 1\n92 63 25\n156 63 1\n162 63 2\n215 63 1\n217 63 4\n221 63 1\n233 63 1\n22 64 1\n39 64 2\n42 64 1\n88 64 1\n92 64 15\n121 64 1\n190 64 1\n217 64 2\n219 64 1\n226 64 1\n233 64 16\n240 64 1\n88 65 1\n92 65 7\n140 65 1\n182 65 1\n201 65 1\n217 65 2\n234 65 1\n92 66 1\n217 66 1\n233 66 2\n20 67 1\n92 67 28\n219 67 1\n233 67 1\n76 68 1\n92 68 20\n142 68 1\n217 68 1\n233 68 1\n54 69 2\n92 69 8\n121 69 1\n140 69 1\n217 69 2\n233 69 7\n248 69 2\n9 70 1\n35 70 1\n54 70 1\n92 70 12\n95 70 1\n125 70 1\n190 70 1\n233 70 18\n20 71 2\n92 71 25\n121 71 1\n142 71 1\n201 71 1\n215 71 1\n217 71 3\n219 71 1\n233 71 2\n18 72 1\n75 72 1\n92 72 4\n217 72 1\n6 73 1\n92 73 21\n140 73 1\n142 73 1\n217 73 2\n219 73 1\n233 73 32\n92 74 10\n217 74 3\n226 74 1\n233 74 3\n248 74 1\n50 75 1\n54 75 1\n63 75 1\n92 75 20\n122 75 1\n182 75 1\n215 75 1\n217 75 10\n226 75 1\n233 75 7\n248 75 1\n9 76 2\n92 76 27\n121 76 1\n122 76 1\n204 76 1\n217 76 3\n248 76 1\n18 77 1\n81 77 1\n88 77 1\n92 77 13\n217 77 4\n250 77 1\n92 78 15\n101 78 1\n121 78 1\n217 78 10\n221 78 1\n233 78 12\n248 78 1\n6 79 1\n50 79 1\n92 79 23\n121 79 1\n162 79 1\n204 79 1\n217 79 11\n233 79 4\n51 80 2\n54 80 1\n88 80 1\n92 80 4\n136 80 1\n217 80 3\n233 80 1\n20 81 1\n42 81 1\n92 81 6\n215 81 1\n217 81 1\n92 82 15\n204 82 1\n42 83 1\n56 83 1\n92 83 18\n95 83 1\n142 83 1\n162 83 1\n207 83 1\n217 83 1\n51 84 1\n92 84 10\n217 84 1\n221 84 1\n233 84 14\n26 85 1\n92 85 6\n95 85 1\n140 85 1\n201 85 1\n215 85 3\n217 85 12\n221 85 1\n233 85 8\n51 86 1\n54 86 1\n92 86 3\n121 86 1\n217 86 6\n92 87 12\n126 87 1\n136 87 1\n159 87 1\n160 87 1\n182 87 1\n201 87 1\n217 87 4\n219 87 1\n233 87 32\n9 88 1\n20 88 1\n51 88 1\n76 88 1\n83 88 1\n88 88 1\n92 88 21\n125 88 1\n142 88 1\n182 88 1\n209 88 1\n215 88 1\n217 88 2\n233 88 1\n90 89 1\n92 89 21\n121 89 1\n142 89 1\n156 89 1\n210 89 1\n217 89 3\n220 89 1\n248 89 1\n20 90 1\n92 90 26\n121 90 2\n217 90 1\n233 90 1\n234 90 1\n25 91 1\n26 91 1\n39 91 2\n42 91 1\n88 91 1\n92 91 22\n121 91 4\n142 91 1\n215 91 1\n217 91 9\n233 91 16\n20 92 1\n42 92 1\n92 92 11\n100 92 1\n142 92 1\n156 92 1\n180 92 1\n217 92 3\n226 92 1\n233 92 1\n35 93 1\n92 93 42\n121 93 2\n125 93 1\n217 93 4\n6 94 2\n43 94 1\n92 94 8\n121 94 1\n217 94 5\n221 94 1\n233 94 22\n39 95 1\n76 95 1\n92 95 16\n121 95 1\n173 95 2\n180 95 1\n190 95 1\n201 95 1\n209 95 1\n210 95 1\n215 95 3\n217 95 9\n219 95 2\n221 95 2\n226 95 1\n233 95 21\n248 95 1\n9 96 1\n22 96 1\n92 96 12\n121 96 1\n136 96 2\n160 96 1\n215 96 1\n217 96 7\n233 96 5\n9 97 1\n136 97 1\n217 97 2\n20 98 2\n22 98 1\n42 98 1\n45 98 1\n92 98 33\n142 98 2\n201 98 1\n215 98 1\n217 98 3\n22 99 1\n42 99 1\n92 99 16\n95 99 1\n121 99 1\n217 99 1\n20 100 2\n92 100 31\n201 100 2\n217 100 1\n233 100 1\n22 101 1\n88 101 1\n92 101 23\n95 101 1\n121 101 1\n125 101 2\n156 101 1\n204 101 1\n217 101 4\n221 101 1\n51 102 2\n92 102 4\n217 102 2\n233 102 12\n20 103 2\n51 103 1\n92 103 28\n121 103 1\n153 103 1\n162 103 1\n201 103 1\n217 103 2\n233 103 12\n92 104 12\n22 105 1\n92 105 7\n100 105 1\n122 105 1\n156 105 1\n197 105 1\n217 105 2\n220 105 1\n22 106 1\n92 106 23\n140 106 1\n217 106 3\n233 106 15\n18 107 1\n70 107 1\n92 107 20\n162 107 1\n172 107 1\n217 107 3\n233 107 34\n9 108 1\n22 108 1\n92 108 8\n140 108 1\n192 108 1\n217 108 3\n219 108 1\n233 108 1\n248 108 1\n42 109 1\n92 109 4\n95 109 1\n140 109 1\n142 109 2\n162 109 1\n215 109 1\n217 109 10\n226 109 1\n248 109 1\n20 110 1\n42 110 1\n43 110 1\n51 110 1\n75 110 2\n92 110 35\n140 110 1\n217 110 2\n9 111 1\n20 111 2\n39 111 1\n92 111 15\n121 111 2\n136 111 1\n162 111 1\n169 111 1\n217 111 8\n220 111 1\n221 111 1\n233 111 17\n241 111 1\n26 112 1\n92 112 26\n217 112 4\n230 112 1\n233 112 18\n248 112 1\n9 113 1\n20 113 1\n26 113 1\n51 113 1\n92 113 27\n126 113 1\n201 113 2\n217 113 2\n233 113 2\n9 114 1\n20 114 1\n92 114 22\n173 114 1\n201 114 2\n217 114 1\n219 114 1\n20 115 2\n39 115 1\n43 115 1\n51 115 1\n92 115 28\n142 115 1\n173 115 1\n180 115 1\n233 115 1\n6 116 1\n9 116 1\n20 116 1\n92 116 21\n175 116 1\n204 116 1\n217 116 2\n229 116 1\n63 117 1\n70 117 1\n92 117 17\n121 117 2\n175 117 1\n199 117 1\n217 117 15\n219 117 1\n221 117 1\n233 117 8\n6 118 1\n92 118 13\n121 118 1\n162 118 2\n217 118 2\n233 118 8\n20 119 1\n92 119 10\n162 119 1\n169 119 1\n173 119 1\n217 119 4\n225 119 1\n233 119 1\n9 120 1\n22 120 1\n92 120 8\n140 120 1\n192 120 1\n217 120 3\n219 120 1\n233 120 1\n248 120 1\n92 121 6\n233 121 18\n20 122 1\n92 122 29\n95 122 6\n125 122 1\n217 122 1\n219 122 1\n233 122 2\n6 123 1\n42 123 1\n88 123 1\n92 123 17\n121 123 1\n210 123 1\n217 123 1\n26 124 1\n42 124 1\n88 124 1\n92 124 16\n121 124 1\n142 124 1\n156 124 1\n210 124 1\n217 124 5\n250 124 1\n54 125 1\n63 125 1\n92 125 12\n217 125 1\n233 125 3\n22 126 1\n35 126 1\n76 126 1\n88 126 2\n92 126 23\n121 126 1\n142 126 1\n162 126 1\n165 126 1\n201 126 2\n204 126 1\n210 126 1\n217 126 14\n219 126 1\n233 126 3\n250 126 1\n20 127 1\n22 127 1\n42 127 1\n70 127 1\n88 127 1\n92 127 28\n121 127 1\n162 127 1\n173 127 1\n204 127 1\n217 127 4\n233 127 1\n241 127 1\n51 128 1\n88 128 1\n92 128 11\n95 128 2\n156 128 1\n190 128 1\n217 128 9\n39 129 1\n42 129 1\n92 129 14\n126 129 1\n136 129 2\n215 129 1\n217 129 6\n226 129 1\n233 129 3\n9 130 1\n27 130 1\n92 130 22\n121 130 1\n136 130 1\n160 130 1\n173 130 1\n215 130 2\n217 130 2\n248 130 1\n250 130 1\n35 131 1\n92 131 8\n125 131 1\n140 131 1\n217 131 1\n233 131 9\n248 131 1\n9 132 1\n92 132 18\n209 132 1\n215 132 2\n20 133 2\n54 133 1\n92 133 21\n100 133 1\n121 133 8\n175 133 1\n190 133 2\n201 133 1\n204 133 1\n215 133 1\n217 133 13\n219 133 4\n221 133 1\n226 133 1\n229 133 1\n233 133 5\n248 133 1\n39 134 1\n43 134 1\n92 134 11\n95 134 2\n123 134 1\n156 134 1\n217 134 3\n51 135 2\n92 135 4\n217 135 2\n233 135 12\n63 136 1\n92 136 13\n121 136 3\n125 136 1\n182 136 1\n190 136 1\n217 136 3\n219 136 1\n221 136 1\n233 136 14\n248 136 1\n20 137 1\n42 137 1\n88 137 2\n92 137 10\n217 137 2\n248 137 1\n6 138 3\n9 138 4\n20 138 2\n39 138 2\n51 138 2\n69 138 2\n88 138 2\n92 138 101\n121 138 7\n123 138 1\n125 138 1\n140 138 1\n156 138 2\n162 138 8\n173 138 5\n190 138 5\n201 138 1\n210 138 1\n215 138 1\n217 138 29\n219 138 3\n220 138 1\n221 138 3\n229 138 1\n233 138 85\n248 138 3\n70 139 1\n92 139 13\n121 139 1\n173 139 1\n201 139 1\n217 139 2\n20 140 2\n51 140 1\n70 140 1\n92 140 10\n121 140 1\n136 140 1\n156 140 2\n201 140 1\n217 140 10\n233 140 26\n92 141 9\n190 141 1\n217 141 3\n92 142 8\n217 142 3\n233 142 17\n" }, { "path": "tests/testthat/test_create_model.R", "content": "context(\"Creating the model from different objects\")\nlibrary(MOFA2)\n\ntest_that(\"a model can be created from a list of matrices\", {\n\tm <- as.matrix(read.csv('matrix.csv'))\n\texpect_warning(create_mofa(list(\"view1\" = m))) # no feature names provided\n\trownames(m) <- paste(\"feature\", seq_len(nrow(m)), paste = \"\", sep = \"\")\n\texpect_is(create_mofa(list(\"view1\" = m)), \"MOFA\")\n\texpect_error(create_mofa(m))\n})\n\ntest_that(\"a model can be created from a list of sparse matrices\", {\n\tskip_if_not_installed(\"Matrix\")\n\tlibrary(Matrix)\n\t# Generate a sparse matrix\n\tm <- matrix(rnorm(100 * 5), ncol = 5) %*% t(matrix(rnorm(5 * 50), ncol = 5))\n\tm[sample(1:nrow(m), 100, replace = TRUE), sample(1:ncol(m), 100, replace = TRUE)] <- 0\n\tm <- Matrix(m, sparse = TRUE)\n\t# Set feature names\n\trownames(m) <- paste(\"feature_\", seq_len(nrow(m)), paste = \"\", sep = \"\")\n\t# Set sample names\n\tcolnames(m) <- paste(\"sample_\", seq_len(ncol(m)), paste = \"\", sep = \"\")\n\t# Test if a sparse matrix can be imported to the MOFA\n\texpect_is(create_mofa(list(\"view1\" = m)), \"MOFA\")\n})\n\ntest_that(\"a model can be created from a Seurat object\", {\n\tskip_if_not_installed(\"Seurat\")\n\tskip_if_not_installed(\"SeuratObject\")\n\tlibrary(Seurat)\n\tlibrary(Matrix)\n\tm <- readMM('matrix.mtx')\n\tgenes <- read.delim('genes.tsv', sep='\\t', header=FALSE, stringsAsFactors=FALSE)[,2]\n\tcells <- read.delim('barcodes.tsv', sep='\\t', header=FALSE, stringsAsFactors=FALSE)[,1]\n\tcolnames(m) <- cells\n\trownames(m) <- genes\n\tsrt <- SeuratObject::CreateSeuratObject(m)\n\t# only for testing purpose, should use scale.data\n\texpect_is(create_mofa(srt, features = genes, layer = \"counts\"), \"MOFA\")\n})\n\ntest_that(\"a list of matrices per view is split correctly into a nested list of matrices according to samples groups\", {\n\tn_groups <- 3\n\t# Create view 1\n\tm <- as.matrix(read.csv('matrix.csv'))\n\trownames(m) <- paste(\"feature\", seq_len(nrow(m)), paste = \"\", sep = \"\")\n\tcolnames(m) <- paste(\"sample\", seq_len(ncol(m)), paste = \"\", sep = \"\")\n\t# Add second view\n\tm2 <- m[1:(nrow(m)/3),]\n\trownames(m2) <- paste(\"view2\", rownames(m2), sep = \"_\")\n\t# Define multiple groups\n\tsamples_groups <- sample(x = paste0(\"group\", 1:n_groups), replace = TRUE, size = ncol(m))\n\t# Split the data\n\tdata_split <- .split_data_into_groups(list(\"view1\" = m, \"view2\" = m2), samples_groups)\n\t# Check group assignments\n\tfor (g in 1:n_groups) {\n\t\tg_name <- paste0(\"group\", g)\n\t\texpect_equal(colnames(data_split[[1]][[g_name]]), colnames(m)[which(samples_groups == g_name)])\n\t\texpect_equal(colnames(data_split[[2]][[g_name]]), colnames(m)[which(samples_groups == g_name)])\n\t}\n})\n\n\n" }, { "path": "tests/testthat/test_load_model.R", "content": "context(\"Loading the model\")\nlibrary(MOFA2)\n\ntest_that(\"a pre-trained model can be loaded from disk\", {\n filepath <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\n expect_is(load_model(filepath), \"MOFA\")\n})\n\n" }, { "path": "tests/testthat/test_plot.R", "content": "context(\"Making plots\")\nlibrary(MOFA2)\n\nfilepath <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\ntest_mofa2 <- load_model(filepath)\n\n# Data plots\n\ntest_that(\"plot data overview works\", {\n\texpect_silent(p <- plot_data_overview(test_mofa2))\n})\n\ntest_that(\"plot data heatmap\", {\n\texpect_silent(p <- plot_data_heatmap(test_mofa2, view = 1, factor = 1, silent = TRUE))\n})\n\n# yields an error and I do not know why\n# test_that(\"plot data scatter\", {\n# \texpect_silent(p <- plot_data_scatter(test_mofa2, view = 1, factor = 1))\n# })\n\ntest_that(\"plot data ASCII in terminal\", {\n\texpect_error(plot_ascii_data(test_mofa2), NA)\n})\n\n\n# Plotting weights\n\ntest_that(\"plot weights heatmap\", {\n\texpect_silent(p <- plot_weights_heatmap(test_mofa2, view = 1, silent = TRUE))\n})\n\ntest_that(\"plot weights\", {\n\t# For multiple factors\n\texpect_silent(p <- plot_weights(test_mofa2, view = 1, factors = 1:2))\n\t# For one factor\n\texpect_silent(p <- plot_weights(test_mofa2, factors = 1))\n})\n\ntest_that(\"plot top weights\", {\n\texpect_silent(p <- plot_top_weights(test_mofa2, view = 1, factors = 1))\n})\n\n\n\n# Plotting factor values\n\ntest_that(\"plot factor values\", {\n\texpect_silent(p <- plot_factor(test_mofa2))\n})\n\ntest_that(\"plot factor values\", {\n\texpect_silent(p <- plot_factors(test_mofa2, factors = 1:2))\n})\n\ntest_that(\"plot factors correlation\", {\n\texpect_error({plot_factor_cor(test_mofa2); dev.off()}, NA)\n})\n" }, { "path": "tests/testthat/test_prepare_model.R", "content": "context(\"Prepare the model from different objects\")\nlibrary(MOFA2)\n\n\ntest_that(\"a MOFA model can be prepared from a list of matrices\", {\n\tm <- as.matrix(read.csv('matrix.csv'))\n\t# Set feature names\n\trownames(m) <- paste(\"feature_\", seq_len(nrow(m)), paste = \"\", sep = \"\")\n\t# Set sample names\n\tcolnames(m) <- paste(\"sample_\", seq_len(ncol(m)), paste = \"\", sep = \"\")\n\tmofa_model <- create_mofa(list(\"view1\" = m))\n\tmodel_opts <- get_default_model_options(mofa_model)\n\tmodel_opts$num_factors <- 10\n\texpect_is(prepare_mofa(mofa_model, model_options = model_opts), \"MOFA\")\n})\n\ntest_that(\"a model can be created from a list of sparse matrices\", {\n\tskip_if_not_installed(\"Matrix\")\n\n\t# Generate a sparse matrix\n\tm <- matrix(rnorm(100 * 5), ncol = 5) %*% t(matrix(rnorm(5 * 50), ncol = 5))\n\tm[sample(1:nrow(m), 100, replace = TRUE), sample(1:ncol(m), 100, replace = TRUE)] <- 0\n\tlibrary(Matrix)\n\tm <- Matrix(m, sparse = TRUE)\n\n\t# Set feature names\n\trownames(m) <- paste(\"feature_\", seq_len(nrow(m)), paste = \"\", sep = \"\")\n\t# Set sample names\n\tcolnames(m) <- paste(\"sample_\", seq_len(ncol(m)), paste = \"\", sep = \"\")\n\t# Initialise a model\n\tmofa_model <- create_mofa(list(\"view1\" = m))\n\tmodel_opts <- get_default_model_options(mofa_model)\n\tmodel_opts$num_factors <- 10\n\n\t# Test if a sparse matrix can be used to prepare the MOFA model for training\n\texpect_is(prepare_mofa(mofa_model, model_options = model_opts), \"MOFA\")\n})\n\ntest_that(\"a model can be created from a Seurat object\", {\n\tskip_if_not_installed(\"Seurat\")\n\tskip_if_not_installed(\"SeuratObject\")\n\tlibrary(Seurat)\n\tlibrary(Matrix)\n\tm <- readMM('matrix.mtx')\n\tgenes <- read.delim('genes.tsv', sep='\\t', header=FALSE, stringsAsFactors=FALSE)[,2]\n\tcells <- read.delim('barcodes.tsv', sep='\\t', header=FALSE, stringsAsFactors=FALSE)[,1]\n\tcolnames(m) <- cells\n\trownames(m) <- genes\n\tsrt <- SeuratObject::CreateSeuratObject(m)\n\tmofa_model <- create_mofa(srt, features = genes, layer = \"counts\")\n\tmodel_opts <- get_default_model_options(mofa_model)\n\tmodel_opts$num_factors <- 10\n\n\t# Test if a Seurat object can be used to prepare the MOFA model for training\n\texpect_is(prepare_mofa(mofa_model, model_options = model_opts), \"MOFA\")\n})\n\n" }, { "path": "tests/testthat.R", "content": "library(testthat)\nlibrary(MOFA2)\n\ntest_check(\"MOFA2\")\n\n# setwd(\"/Users/rargelaguet/mofa/MOFA2/tests/testthat\")\n" }, { "path": "vignettes/MEFISTO_temporal.Rmd", "content": "---\ntitle: \"Illustration of MEFISTO on simulated data with a temporal covariate\"\nauthor:\n- name: \"Britta Velten\"\n affiliation: \"German Cancer Research Center, Heidelberg, Germany\"\n email: \"b.velten@dkfz-heidelberg.de\"\ndate: \"`r Sys.Date()`\"\noutput:\n BiocStyle::html_document:\n toc_float: true\nvignette: >\n %\\VignetteIndexEntry{MEFISTO on simulated data (temporal)}\n %\\VignetteEngine{knitr::rmarkdown}\n %\\VignetteEncoding{UTF-8}\n---\n\n```{r, message=FALSE, warning=FALSE}\nlibrary(MOFA2)\nlibrary(tidyverse)\nlibrary(pheatmap)\n```\n\n# Temporal data: Simulate an example data set\nTo illustrate the MEFISTO method in MOFA2 we simulate a small example data set with 4 different views and one covariates defining a timeline using `make_example_data`. The simulation is based on 4 factors, two of which vary smoothly along the covariate (with different lengthscales) and two are independent of the covariate.\n\n```{r}\nset.seed(2020)\n\n# set number of samples and time points\nN <- 200\ntime <- seq(0,1,length.out = N)\n\n# generate example data\ndd <- make_example_data(sample_cov = time, n_samples = N,\n n_factors = 4, n_features = 200, n_views = 4,\n lscales = c(0.5, 0.2, 0, 0))\n# input data\ndata <- dd$data\n\n# covariate matrix with samples in columns\ntime <- dd$sample_cov\nrownames(time) <- \"time\"\n```\n\n\nLet's have a look at the simulated latent temporal processes, which we want to recover:\n```{r}\ndf <- data.frame(dd$Z, t(time))\ndf <- gather(df, key = \"factor\", value = \"value\", starts_with(\"simulated_factor\"))\nggplot(df, aes(x = time, y = value)) + geom_point() + facet_grid(~factor)\n```\n\n# MEFISTO framework\nUsing the MEFISTO framework is very similar to using MOFA2. In addition to the omics data, however, we now additionally specify the time points for each sample. If you are not familiar with the MOFA2 framework, it might be helpful to have a look at [MOFA2 tutorials](https://biofam.github.io/MOFA2/tutorials.html) first.\n\n## Create a MOFA object with covariates\nTo create the MOFA object we need to specify the training data and the covariates for pattern detection and inference of smooth factors. Here, `sample_cov` is a matrix with samples in columns and one row containing the time points. The sample order must match the order in data columns. Alternatively, a data frame can be provided containing one `sample` columns with samples names matching the sample names in the data.\n\nFirst, we start by creating a standard MOFA model.\n```{r}\nsm <- create_mofa(data = dd$data)\n```\n\nNow, we can add the additional temporal covariate, that we want to use for training.\n```{r, message=FALSE, warning=FALSE}\nsm <- set_covariates(sm, covariates = time)\nsm\n```\nWe now successfully created a MOFA object that contains 4 views, 1 group and 1 covariate giving the time point for each sample.\n\n## Prepare a MOFA object\nBefore training, we can specify various options for the model, the training and the data preprocessing. If no options are specified, the model will use the default options. See also `get_default_data_options`, `get_default_model_options` and `get_default_training_options` to have a look at the defaults and change them where required. For illustration, we only use a small number of iterations.\n\nImportantly, to activate the use of the covariate for a functional decomposition (MEFISTO) we now additionally to the standard MOFA options need to specify `mefisto_options`. For this you can just use the default options (`get_default_mefisto_options`), unless you want to make use of advanced options such as alignment across groups.\n\n```{r, message=FALSE, warning=FALSE}\ndata_opts <- get_default_data_options(sm)\n\nmodel_opts <- get_default_model_options(sm)\nmodel_opts$num_factors <- 4\n\ntrain_opts <- get_default_training_options(sm)\ntrain_opts$maxiter <- 100\n\nmefisto_opts <- get_default_mefisto_options(sm)\n\nsm <- prepare_mofa(sm, model_options = model_opts,\n mefisto_options = mefisto_opts,\n training_options = train_opts,\n data_options = data_opts)\n```\n\n## Run MOFA\nNow, the MOFA object is ready for training. Using `run_mofa` we can fit the model, which is saved in the file specified as `outfile`. If none is specified the output is saved in a temporary location.\n```{r, warning=FALSE, message=FALSE}\noutfile = file.path(tempdir(),\"model.hdf5\")\nsm <- run_mofa(sm, outfile, use_basilisk = TRUE)\n```\n\n\n## Down-stream analysis\n### Variance explained per factor\nUsing `plot_variance_explained` we can explore which factor is active in which view. `plot_factor_cor` shows us whether the factors are correlated.\n```{r, fig.width=5, fig.height=4}\nplot_variance_explained(sm)\nr <- plot_factor_cor(sm)\n```\n\n\n### Relate factors to the covariate\nThe MOFA model has learnt scale parameters for each factor, which give us an indication of the smoothness per factor along the covariate (here time) and are between 0 and 1. A scale of 0 means that the factor captures variation independent of time, a value close to 1 tells us that this factor varys very smoothly along time. \n```{r}\nget_scales(sm)\n```\n\nIn this example, we find two factors that are non-smooth and two smooth factors. Using `plot_factors_vs_cov` we can plot the factors along the time line, where we can distinguish smooth and non smooth variation along time.\n```{r}\nplot_factors_vs_cov(sm, color_by = \"time\")\n```\n\nFor more customized plots, we can extract the underlying data containing the factor and covariate values for each sample.\n```{r}\ndf <- plot_factors_vs_cov(sm, color_by = \"time\",\n legend = FALSE, return_data = TRUE)\nhead(df)\n```\n\nWe can compare the above plots to the factors that were simulated above and find that the model recaptured the two smooth as well as two non-smooth patterns in time. Note that factors are invariant to the sign, e.g. Factor 4 is the negative of the simulated factor but we can simply multiply the factors and its weights by -1 to obtain exactly the simulated factor.\n\n\n### Exploration of weights\nAs with standard MOFA, we can now look deeper into the meaning of these factors by exploring the weights or performing feature set enrichment analysis.\n```{r, fig.width=5, fig.height=4}\nplot_weights(sm, factors = 4, view = 1)\nplot_top_weights(sm, factors = 3, view = 2)\n```\n\nIn addition, we can take a look at the top feature values per factor along time and see that their patterns are in line with the pattern of the corresponding Factor (here Factor 3).\n```{r}\nplot_data_vs_cov(sm, factor=3,\n features = 2,\n color_by = \"time\",\n dot_size = 1)\n```\n\n### Interpolation\nFurthermore, we can interpolate or extrapolate a factor to new values. Here, we only show the mean of the prediction, to obtain uncertainties you need to specify the new values before training in `get_default_mefisto_options(sm)$new_values`.\n```{r}\nsm <- interpolate_factors(sm, new_values = seq(0,1.1,0.01))\nplot_interpolation_vs_covariate(sm, covariate = \"time\",\n factors = \"Factor3\")\n```\n\n
\n **Session Info**\n \n```{r}\nsessionInfo()\n```\n\n
\n" }, { "path": "vignettes/downstream_analysis.Rmd", "content": "---\ntitle: \"MOFA+: downstream analysis in R\"\nauthor:\n- name: \"Ricard Argelaguet\"\n affiliation: \"European Bioinformatics Institute, Cambridge, UK\"\n email: \"ricard@ebi.ac.uk\"\n- name: \"Britta Velten\"\n affiliation: \"German Cancer Research Center, Heidelberg, Germany\"\n email: \"b.velten@dkfz-heidelberg.de\"\ndate: \"`r Sys.Date()`\"\n\noutput:\n BiocStyle::html_document:\n toc_float: true\nvignette: >\n %\\VignetteIndexEntry{Downstream analysis: Overview}\n %\\VignetteEngine{knitr::rmarkdown}\n %\\VignetteEncoding{UTF-8}\n---\n\n# Introduction\n\nIn the MOFA2 R package we provide a wide range of downstream analysis\nto visualise and interpret the model output.\nHere we provide a brief description of the main functionalities.\nThis vignette is made of simulated data and\nwe do not highlight biologically relevant results.\nPlease see our [tutorials](https://biofam.github.io/MOFA2/tutorials.html) for real use cases.\n\n# Load libraries\n```{r, message=FALSE}\nlibrary(ggplot2)\nlibrary(MOFA2)\n```\n\n# Load trained model\n\n```{r }\nfilepath <- system.file(\"extdata\", \"model.hdf5\", package = \"MOFA2\")\nmodel <- load_model(filepath)\n```\n\n## Overview of data\nThe function `plot_data_overview` can be used to obtain an overview of the input data. \nIt shows how many views (rows) and how many groups (columns) exist, what are\ntheir corresponding dimensionalities and how many missing information they have (grey bars). \n```{r}\nplot_data_overview(model)\n```\n\n# Add metadata to the model\n\nThe metadata is stored as a data.frame object in `model@samples_metadata`,\nand it requires at least the column `sample`.\nThe column `group` is required only if you are doing multi-group inference. \nThe number of rows must match the total number of samples\nin the model (`sum(model@dimensions$N)`).\n\nLet's add some artificial metadata...\n```{r }\nNsamples = sum(get_dimensions(model)[[\"N\"]])\n\nsample_metadata <- data.frame(\n sample = samples_names(model)[[1]],\n condition = sample(c(\"A\",\"B\"), size = Nsamples, replace = TRUE),\n age = sample(1:100, size = Nsamples, replace = TRUE)\n)\n\nsamples_metadata(model) <- sample_metadata\nhead(samples_metadata(model), n=3)\n```\n\n# Variance decomposition\n\nThe first step in the MOFA analysis is to quantify the amount\nof variance explained ($R^2$) by each factor in each data modality. \nThe variance explained estimates are stored in the hdf5 file and\nloaded in `model@cache[[\"variance_explained\"]]`:\n```{r }\n# Total variance explained per view\nhead(get_variance_explained(model)$r2_total[[1]])\n\n# Variance explained for every factor in per view\nhead(get_variance_explained(model)$r2_per_factor[[1]])\n```\n\nVariance explained estimates can be plotted using `plot_variance_explained(model, ...)`. Options: \n\n* **factors**: character vector with a factor name(s), or numeric vector with\n the index(es) of the factor(s). Default is \"all\".\n* **x**: character specifying the dimension for the x-axis (\"view\", \"factor\", or \"group\").\n* **y**: character specifying the dimension for the y-axis (\"view\", \"factor\", or \"group\").\n* **split_by**: character specifying the dimension to be faceted (\"view\", \"factor\", or \"group\").\n* **plot_total**: logical value to indicate if to plot the total variance explained \n (for the variable in the x-axis)\n\nIn this case we have 5 active factors that explain a large amount of variation in\nboth data modalities.\n```{r}\nplot_variance_explained(model, x=\"view\", y=\"factor\")\n```\n\nThe model explains ~70% of the variance in both data modalities.\n```{r}\nplot_variance_explained(model, x=\"view\", y=\"factor\", plot_total = TRUE)[[2]]\n```\n\n\n# Visualisation of Factors\n\nThe MOFA factors capture the global sources of variability in the data.\nMathematically, each factor ordinates cells along a one-dimensional axis centered at zero.\nThe value per se is not important, only the relative positioning of samples matters.\nSamples with different signs manifest opposite “effects”\nalong the inferred axis of variation,\nwith higher absolute value indicating a stronger effect.\nNote that the interpretation of factors is analogous to the interpretation of the principal components in PCA.\n\n## Visualisation of factors one at a time\n\nFactors can be plotted using `plot_factor` (for beeswarm plots of individual factors) or\n`plot_factors` (for scatter plots of factor combinations).\n```{r }\nplot_factor(model, \n factor = 1:3,\n color_by = \"age\",\n shape_by = \"condition\"\n)\n```\n\nAdding more options\n```{r}\np <- plot_factor(model, \n factors = c(1,2,3),\n color_by = \"condition\",\n dot_size = 3, # change dot size\n dodge = TRUE, # dodge points with different colors\n legend = FALSE, # remove legend\n add_violin = TRUE, # add violin plots,\n violin_alpha = 0.25 # transparency of violin plots\n)\n\n# The output of plot_factor is a ggplot2 object that we can edit\np <- p + \n scale_color_manual(values=c(\"A\"=\"black\", \"B\"=\"red\")) +\n scale_fill_manual(values=c(\"A\"=\"black\", \"B\"=\"red\"))\n\nprint(p)\n```\n\n## Visualisation of combinations of factors\n\nScatter plots\n```{r, message=FALSE}\nplot_factors(model, \n factors = 1:3,\n color_by = \"condition\"\n)\n```\n\n\n# Visualisation of feature weights\n\nThe weights provide a score for how strong each feature relates to each factor.\nFeatures with no association with the factor have values close to zero,\nwhile features with strong association with the factor have large absolute values.\nThe sign of the weight indicates the direction of the effect:\na positive weight indicates that the feature has higher levels in the cells with\npositive factor values, and vice versa. \n\nWeights can be plotted using `plot_weights` or `plot_top_weights`\n\n```{r }\nplot_weights(model,\n view = \"view_0\",\n factor = 1,\n nfeatures = 10, # Number of features to highlight\n scale = TRUE, # Scale weights from -1 to 1\n abs = FALSE # Take the absolute value?\n)\n```\n\n```{r }\nplot_top_weights(model,\n view = \"view_0\",\n factor = 1,\n nfeatures = 10\n)\n```\n\n# Visualisation of covariation patterns in the input data\n\nInstead of looking at weights, it is useful to observe the coordinated heterogeneity\nthat MOFA captures in the original data.\nThis can be done using the `plot_data_heatmap` and `plot_data_scatter` function. \n\n## Heatmaps\n\nHeatmap of observations.\nTop features are selected by its weight in the selected factor.\nBy default, samples are ordered according to their corresponding factor value.\n```{r}\nplot_data_heatmap(model,\n view = \"view_1\", # view of interest\n factor = 1, # factor of interest\n features = 20, # number of features to plot (they are selected by weight)\n \n # extra arguments that are passed to the `pheatmap` function\n cluster_rows = TRUE, cluster_cols = FALSE,\n show_rownames = TRUE, show_colnames = FALSE\n)\n```\n\n## Scatter plots\n\nScatter plots of observations vs factor values. \nIt is useful to add a linear regression estimate to visualise\nif the relationship between (top) features and factor values is linear.\n```{r}\nplot_data_scatter(model,\n view = \"view_1\", # view of interest\n factor = 1, # factor of interest\n features = 5, # number of features to plot (they are selected by weight)\n add_lm = TRUE, # add linear regression\n color_by = \"condition\"\n)\n```\n\n## Non-linear dimensionality reduction\n\nThe MOFA factors are linear (as in Principal Component analysis),\nso each one captures limited amount of information,\nbut they can be used as input to other methods that learn compact nonlinear manifolds, \ne.g. t-SNE or UMAP.\n\nRun UMAP or t-SNE\n```{r }\nset.seed(42)\nmodel <- run_umap(model)\nmodel <- run_tsne(model)\n```\n\nPlot (nothing too interesting in this simulated data set)\n```{r }\nplot_dimred(model,\n method = \"TSNE\", # method can be either \"TSNE\" or \"UMAP\"\n color_by = \"condition\",\n dot_size = 5\n)\n```\n\n# Other functionalities\n\n## Renaming dimensions\n\nThe user can rename the dimensions of the model\n```{r}\nviews_names(model) <- c(\"Transcriptomics\", \"Proteomics\")\nfactors_names(model) <- paste(\"Factor\", 1:get_dimensions(model)$K, sep=\" \")\n```\n\n```{r}\nviews_names(model)\n```\n\n## Extracting data for downstream analysis\n\nThe user can extract the feature weights, the data and the factors to\ngenerate their own plots. \n\nExtract factors\n```{r}\n# \"factors\" is a list of matrices, one matrix per group with dimensions (nsamples, nfactors)\nfactors <- get_factors(model, factors = \"all\")\nlapply(factors,dim)\n```\n\nExtract weights\n```{r}\n# \"weights\" is a list of matrices, one matrix per view with dimensions (nfeatures, nfactors)\nweights <- get_weights(model, views = \"all\", factors = \"all\")\nlapply(weights,dim)\n```\n\nExtract data\n```{r}\n# \"data\" is a nested list of matrices, one matrix per view and group with dimensions (nfeatures, nsamples)\ndata <- get_data(model)\nlapply(data, function(x) lapply(x, dim))[[1]]\n```\n\nFor convenience, the user can extract the data in long data.frame format:\n\n```{r}\nfactors <- get_factors(model, as.data.frame = TRUE)\nhead(factors, n=3)\n```\n\n```{r}\nweights <- get_weights(model, as.data.frame = TRUE)\nhead(weights, n=3)\n```\n\n```{r}\ndata <- get_data(model, as.data.frame = TRUE)\nhead(data, n=3)\n```\n\n
\n **Session Info**\n \n```{r}\nsessionInfo()\n```\n\n
\n" }, { "path": "vignettes/getting_started_R.Rmd", "content": "---\ntitle: \"MOFA2: training a model in R\"\nauthor:\n- name: \"Ricard Argelaguet\"\n affiliation: \"European Bioinformatics Institute, Cambridge, UK\"\n email: \"ricard@ebi.ac.uk\"\n- name: \"Britta Velten\"\n affiliation: \"German Cancer Research Center, Heidelberg, Germany\"\n email: \"b.velten@dkfz-heidelberg.de\"\ndate: \"`r Sys.Date()`\"\n\noutput:\n BiocStyle::html_document:\n toc_float: true\nvignette: >\n %\\VignetteIndexEntry{MOFA2: How to train a model in R}\n %\\VignetteEngine{knitr::rmarkdown}\n %\\VignetteEncoding{UTF-8}\n---\n\nThis vignette contains a detailed tutorial on how to train a MOFA model using R.\nA concise template script can be found [here](https://github.com/bioFAM/MOFA2/blob/87e615bf0d49481821bd03cb32baa5d2e66ad6d8/inst/scripts/template_script.R).\nMany more examples on application of MOFA to various multi-omics data sets can be found [here](https://biofam.github.io/MOFA2/tutorials.html).\n\n\n# Load libraries\n\n```{r message=FALSE}\nlibrary(data.table)\nlibrary(MOFA2)\n```\n\n# Is MOFA the right method for my data?\n\nMOFA (and factor analysis models in general) are useful to uncover variation\nin complex data sets that contain multiple sources of heterogeneity.\nThis requires a **relatively large sample size (at least ~15 samples)**.\nIn addition, MOFA needs the multi-modal measurements to be derived **from the same samples**. It is fine if you have samples that are missing some data modality,\nbut there has to be a significant degree of matched measurements. \n\n# Preprocessing the data\n\n## Normalisation\n\nProper normalisation of the data is critical. \n**The model can handle three types of data**: \ncontinuous (modelled with a gaussian likelihood),\nsmall counts (modelled with a Poisson likelihood) \nand binary measurements (modelled with a bernoulli likelihood).\nNon-gaussian likelihoods give non-optimal results, \nwe recommend the user to apply data transformations to obtain continuous measurements.\nFor example, for count-based data such as RNA-seq or ATAC-seq we recommend\nsize factor normalisation + variance stabilisation (i.e. a log transformation). \n\n## Feature selection\n\nIt is strongly recommended that you select **highly variable features (HVGs) per assay**\nbefore fitting the model. This ensures a faster training and a more robust inference\nprocedure. Also, for data modalities that have very different dimensionalities we\nsuggest a stronger feature selection fort he bigger views, with the aim of\nreducing the feature imbalance between data modalities.\n\n# Create the MOFA object\n\nTo create a MOFA object you need to specify three dimensions: samples, features and view(s).\nOptionally, a group can also be specified for each sample (no group structure by default).\nMOFA objects can be created from a wide range of input formats, including:\n\n- **a list of matrices**: this is recommended for relatively simple data.\n- **a long data.frame**: this is recommended for complex data sets with\n multiple views and/or groups.\n- **MultiAssayExperiment**: to connect with Bioconductor objects.\n- **Seurat**: for single-cell genomics users. \nSee [this vignette](https://raw.githack.com/bioFAM/MOFA2/master/MOFA2/vignettes/scRNA_gastrulation.html)\n\n## List of matrices\n\nA list of matrices, where each entry corresponds to one view.\nSamples are stored in columns and features in rows.\n\nLet's simulate some data to start with\n```{r}\ndata <- make_example_data(\n n_views = 2, \n n_samples = 200, \n n_features = 1000, \n n_factors = 10\n)[[1]]\n\nlapply(data,dim)\n```\n\nCreate the MOFA object:\n```{r message=FALSE}\nMOFAobject <- create_mofa(data)\n```\n\nPlot the data overview\n```{r}\nplot_data_overview(MOFAobject)\n```\n\nIn case you are using the multi-group functionality, the groups can be specified\nusing the `groups` argument as a vector with the group ID for each sample.\nKeep in mind that the multi-group functionality is a rather advanced option that we\ndiscourage for beginners. For more details on how the multi-group inference works,\nread the [FAQ section](https://biofam.github.io/MOFA2/faq.html) and\n[check this vignette](https://raw.githack.com/bioFAM/MOFA2/master/MOFA2/vignettes/scRNA_gastrulation.html). \n\n```{r message=FALSE}\nN = ncol(data[[1]])\ngroups = c(rep(\"A\",N/2), rep(\"B\",N/2))\n\nMOFAobject <- create_mofa(data, groups=groups)\n```\n\nPlot the data overview\n```{r}\nplot_data_overview(MOFAobject)\n```\n\n## Long data.frame\n\nA long data.frame with columns `sample`, `feature`, `view`, `group` (optional), `value` \nmight be the best format for complex data sets with multiple omics and potentially multiple groups of data. Also, there is no need to add rows that correspond to missing data:\n\n```{r }\nfilepath <- system.file(\"extdata\", \"test_data.RData\", package = \"MOFA2\")\nload(filepath)\n\nhead(dt)\n```\n\nCreate the MOFA object\n```{r }\nMOFAobject <- create_mofa(dt)\nprint(MOFAobject)\n```\n\nPlot data overview\n```{r out.width = \"80%\"}\nplot_data_overview(MOFAobject)\n```\n\n# Define options \n\n## Define data options\n\n- **scale_groups**: if groups have different ranges/variances,\nit is good practice to scale each group to unit variance. Default is `FALSE`\n- **scale_views**: if views have different ranges/variances,\nit is good practice to scale each view to unit variance. Default is `FALSE`\n```{r }\ndata_opts <- get_default_data_options(MOFAobject)\nhead(data_opts)\n```\n\n## Define model options\n\n- **num_factors**: number of factors\n- **likelihoods**: likelihood per view (options are \"gaussian\", \"poisson\", \"bernoulli\").\nDefault is \"gaussian\".\n- **spikeslab_factors**: use spike-slab sparsity prior in the factors? \nDefault is `FALSE`.\n- **spikeslab_weights**: use spike-slab sparsity prior in the weights? \nDefault is `TRUE`.\n- **ard_factors**: use ARD prior in the factors? \nDefault is `TRUE` if using multiple groups.\n- **ard_weights**: use ARD prior in the weights? \nDefault is `TRUE` if using multiple views.\n\nOnly change the default model options if you are familiar\nwith the underlying mathematical model.\n```{r }\nmodel_opts <- get_default_model_options(MOFAobject)\nmodel_opts$num_factors <- 10\nhead(model_opts)\n```\n\n\n## Define training options\n\n- **maxiter**: number of iterations. Default is 1000.\n- **convergence_mode**: \"fast\" (default), \"medium\", \"slow\".\nFor exploration, the fast mode is sufficient. For a final model,\nconsider using medium\" or even \"slow\", but hopefully results should not change much.\n- **gpu_mode**: use GPU mode? \n(needs [cupy](https://cupy.chainer.org/) installed and a functional GPU).\n- **verbose**: verbose mode?\n\n```{r }\ntrain_opts <- get_default_training_options(MOFAobject)\nhead(train_opts)\n```\n\n# Build and train the MOFA object \n\nPrepare the MOFA object\n```{r message=FALSE}\nMOFAobject <- prepare_mofa(\n object = MOFAobject,\n data_options = data_opts,\n model_options = model_opts,\n training_options = train_opts\n)\n```\n\nTrain the MOFA model. Remember that in this step the `MOFA2` R package connets with the\n`mofapy2` Python package using `reticulate`. This is the source of most problems when\nrunning MOFA. See our [FAQ section](https://biofam.github.io/MOFA2/faq.html) \nif you have issues. The output is saved in the file specified as `outfile`. If none is specified, the output is saved in a temporary location.\n```{r}\noutfile = file.path(tempdir(),\"model.hdf5\")\nMOFAobject.trained <- run_mofa(MOFAobject, outfile, use_basilisk=TRUE)\n```\n\nIf everything is successful, you should observe an output analogous to the following:\n```\n\n######################################\n## Training the model with seed 1 ##\n######################################\n\nIteration 1: time=0.03, ELBO=-52650.68, deltaELBO=837116.802 (94.082647669%), Factors=10\n\n(...)\n\nIteration 9: time=0.04, ELBO=-50114.43, deltaELBO=23.907 (0.002686924%), Factors=10\n\n#######################\n## Training finished ##\n#######################\n\nSaving model in `/var/folders/.../model.hdf5...`r outfile`.\n```\n\n# Downstream analysis\n\nThis finishes the tutorial on how to train a MOFA object from R. \nTo continue with the downstream analysis, follow [this tutorial](https://raw.githack.com/bioFAM/MOFA2_tutorials/master/R_tutorials/downstream_analysis.html)\n\n
\n **Session Info**\n \n```{r}\nsessionInfo()\n```\n\n
\n" } ]