├── .Rbuildignore ├── .github ├── .gitignore ├── CONTRIBUTING.md ├── ISSUE_TEMPLATE.md └── workflows │ ├── R-CMD-check.yaml │ └── pkgdown.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE.md ├── NAMESPACE ├── NeuralNetTools.Rproj ├── R ├── NeuralNetTools_gar.R ├── NeuralNetTools_lek.R ├── NeuralNetTools_neuraldat.R ├── NeuralNetTools_old.R ├── NeuralNetTools_plot.R └── NeuralNetTools_utils.R ├── README.md ├── cran-comments.md ├── data-raw └── neuraldat.R ├── data └── neuraldat.RData ├── inst └── CITATION ├── man ├── bias_lines.Rd ├── bias_points.Rd ├── garson.Rd ├── get_ys.Rd ├── layer_lines.Rd ├── layer_points.Rd ├── lekgrps.Rd ├── lekprofile.Rd ├── neuraldat.Rd ├── neuralskips.Rd ├── neuralweights.Rd ├── olden.Rd ├── plotnet.Rd └── pred_sens.Rd └── vignettes ├── .gitignore └── Overview.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^data-raw$ 4 | README.md 5 | README.Rmd 6 | cran-comments.md 7 | .gitignore 8 | .Rhistory 9 | ^\.travis\.yml$ 10 | ^appveyor\.yml$ 11 | ^README_cache/.* 12 | README.Rmd 13 | README.html 14 | ^README_files/.* 15 | ^revdep/.* 16 | ^\.github$ 17 | ^LICENSE\.md$ 18 | ^CRAN-RELEASE$ 19 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing to NeuralNetTools 2 | 3 | This outlines how to propose a change to NeuralNetTools. For more detailed 4 | info about contributing to this, please see the 5 | [**development contributing guide**](https://rstd.io/tidy-contrib). 6 | 7 | ### Fixing typos 8 | 9 | Small typos or grammatical errors in documentation may be edited directly using 10 | the GitHub web interface, so long as the changes are made in the _source_ file. 11 | 12 | * YES: you edit a roxygen comment in a `.R` file below `R/`. 13 | * NO: you edit an `.Rd` file below `man/`. 14 | 15 | ### Prerequisites 16 | 17 | Before you make a substantial pull request, you should always file an issue and 18 | make sure someone from the team agrees that it’s a problem. If you’ve found a 19 | bug, create an associated issue and illustrate the bug with a minimal 20 | [reprex](https://www.tidyverse.org/help/#reprex). 21 | 22 | ### Pull request process 23 | 24 | * We recommend that you create a Git branch for each pull request (PR). 25 | * Look at the Travis and AppVeyor build status before and after making changes. 26 | The `README` should contain badges for any continuous integration services used 27 | by the package. 28 | * New code should follow the tidyverse [style guide](https://style.tidyverse.org). 29 | You can use the [styler](https://CRAN.R-project.org/package=styler) package to 30 | apply these styles, but please don't restyle code that has nothing to do with 31 | your PR. 32 | * We use [roxygen2](https://cran.r-project.org/package=roxygen2), with 33 | [Markdown syntax](https://cran.r-project.org/web/packages/roxygen2/vignettes/markdown.html), 34 | for documentation. 35 | * We use [testthat](https://cran.r-project.org/package=testthat). Contributions 36 | with test cases included are easier to accept. 37 | * For user-facing changes, add a bullet to the top of `NEWS.md` below the 38 | current development version header describing the changes made followed by your 39 | GitHub username, and links to relevant issue(s)/PR(s). 40 | 41 | ### Code of Conduct 42 | 43 | Please note that the NeuralNetTools project is released with a 44 | [Contributor Code of Conduct](CODE_OF_CONDUCT.md). By contributing to this 45 | project you agree to abide by its terms. 46 | 47 | ### See tidyverse [development contributing guide](https://rstd.io/tidy-contrib) 48 | for further details. 49 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | # Issues reporting guide 2 | 3 | Please briefly describe your problem and what output you expect. If you have a question, please don't use this form. Instead, ask on or . 4 | 5 | Please include a minimal reproducible example (AKA a reprex). If you've never heard of a [reprex](https://reprex.tidyverse.org/) before, start by reading . 6 | 7 | --- 8 | 9 | Brief description of the problem 10 | 11 | ```r 12 | # insert reprex here 13 | ``` 14 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - {os: macOS-latest, r: 'release'} 22 | - {os: windows-latest, r: 'release'} 23 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 24 | - {os: ubuntu-latest, r: 'release'} 25 | 26 | env: 27 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 28 | R_KEEP_PKG_SOURCE: yes 29 | 30 | steps: 31 | - uses: actions/checkout@v2 32 | 33 | - uses: r-lib/actions/setup-pandoc@v1 34 | 35 | - uses: r-lib/actions/setup-r@v1 36 | with: 37 | r-version: ${{ matrix.config.r }} 38 | http-user-agent: ${{ matrix.config.http-user-agent }} 39 | use-public-rspm: true 40 | 41 | - uses: r-lib/actions/setup-r-dependencies@v1 42 | with: 43 | extra-packages: rcmdcheck 44 | 45 | - uses: r-lib/actions/check-r-package@v1 46 | 47 | - name: Show testthat output 48 | if: always() 49 | run: find check -name 'testthat.Rout*' -exec cat '{}' \; || true 50 | shell: bash 51 | 52 | - name: Upload check results 53 | if: failure() 54 | uses: actions/upload-artifact@main 55 | with: 56 | name: ${{ runner.os }}-r${{ matrix.config.r }}-results 57 | path: check 58 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: 4 | - main 5 | - master 6 | 7 | name: pkgdown 8 | 9 | jobs: 10 | pkgdown: 11 | runs-on: macOS-latest 12 | env: 13 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 14 | steps: 15 | - uses: actions/checkout@v2 16 | 17 | - uses: r-lib/actions/setup-r@v1 18 | 19 | - uses: r-lib/actions/setup-pandoc@v1 20 | 21 | - name: Query dependencies 22 | run: | 23 | install.packages('remotes') 24 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 25 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 26 | shell: Rscript {0} 27 | 28 | - name: Cache R packages 29 | uses: actions/cache@v2 30 | with: 31 | path: ${{ env.R_LIBS_USER }} 32 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 33 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 34 | 35 | - name: Install dependencies 36 | run: | 37 | remotes::install_deps(dependencies = TRUE) 38 | install.packages("pkgdown", type = "binary") 39 | shell: Rscript {0} 40 | 41 | - name: Install package 42 | run: R CMD INSTALL . 43 | 44 | - name: Deploy package 45 | run: | 46 | git config --local user.email "actions@github.com" 47 | git config --local user.name "GitHub Actions" 48 | Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)' 49 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | inst/doc 5 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: NeuralNetTools 2 | Type: Package 3 | Title: Visualization and Analysis Tools for Neural Networks 4 | Version: 1.5.3 5 | Date: 2022-01-06 6 | Author: Marcus W. Beck [aut, cre] 7 | Maintainer: Marcus W. Beck 8 | Description: Visualization and analysis tools to aid in the interpretation of 9 | neural network models. Functions are available for plotting, 10 | quantifying variable importance, conducting a sensitivity analysis, and 11 | obtaining a simple list of model weights. 12 | BugReports: https://github.com/fawda123/NeuralNetTools/issues 13 | License: CC0 14 | LazyData: true 15 | Imports: 16 | ggplot2 (>= 2.0.0), 17 | nnet, 18 | reshape2, 19 | scales, 20 | tidyr 21 | Suggests: 22 | caret, 23 | neuralnet, 24 | RSNNS, 25 | knitr, 26 | rmarkdown 27 | Depends: 28 | R (>= 3.1.1) 29 | Authors@R: person(given = "Marcus W.", family = "Beck", 30 | role = c("aut","cre"), 31 | email = "mbafs2012@gmail.com") 32 | RoxygenNote: 7.1.1 33 | VignetteBuilder: knitr 34 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | ## creative commons 2 | 3 | # CC0 1.0 Universal 4 | 5 | CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED HEREUNDER. 6 | 7 | ### Statement of Purpose 8 | 9 | The laws of most jurisdictions throughout the world automatically confer exclusive Copyright and Related Rights (defined below) upon the creator and subsequent owner(s) (each and all, an "owner") of an original work of authorship and/or a database (each, a "Work"). 10 | 11 | Certain owners wish to permanently relinquish those rights to a Work for the purpose of contributing to a commons of creative, cultural and scientific works ("Commons") that the public can reliably and without fear of later claims of infringement build upon, modify, incorporate in other works, reuse and redistribute as freely as possible in any form whatsoever and for any purposes, including without limitation commercial purposes. These owners may contribute to the Commons to promote the ideal of a free culture and the further production of creative, cultural and scientific works, or to gain reputation or greater distribution for their Work in part through the use and efforts of others. 12 | 13 | For these and/or other purposes and motivations, and without any expectation of additional consideration or compensation, the person associating CC0 with a Work (the "Affirmer"), to the extent that he or she is an owner of Copyright and Related Rights in the Work, voluntarily elects to apply CC0 to the Work and publicly distribute the Work under its terms, with knowledge of his or her Copyright and Related Rights in the Work and the meaning and intended legal effect of CC0 on those rights. 14 | 15 | 1. __Copyright and Related Rights.__ A Work made available under CC0 may be protected by copyright and related or neighboring rights ("Copyright and Related Rights"). Copyright and Related Rights include, but are not limited to, the following: 16 | 17 | i. the right to reproduce, adapt, distribute, perform, display, communicate, and translate a Work; 18 | 19 | ii. moral rights retained by the original author(s) and/or performer(s); 20 | 21 | iii. publicity and privacy rights pertaining to a person's image or likeness depicted in a Work; 22 | 23 | iv. rights protecting against unfair competition in regards to a Work, subject to the limitations in paragraph 4(a), below; 24 | 25 | v. rights protecting the extraction, dissemination, use and reuse of data in a Work; 26 | 27 | vi. database rights (such as those arising under Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, and under any national implementation thereof, including any amended or successor version of such directive); and 28 | 29 | vii. other similar, equivalent or corresponding rights throughout the world based on applicable law or treaty, and any national implementations thereof. 30 | 31 | 2. __Waiver.__ To the greatest extent permitted by, but not in contravention of, applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and unconditionally waives, abandons, and surrenders all of Affirmer's Copyright and Related Rights and associated claims and causes of action, whether now known or unknown (including existing as well as future claims and causes of action), in the Work (i) in all territories worldwide, (ii) for the maximum duration provided by applicable law or treaty (including future time extensions), (iii) in any current or future medium and for any number of copies, and (iv) for any purpose whatsoever, including without limitation commercial, advertising or promotional purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each member of the public at large and to the detriment of Affirmer's heirs and successors, fully intending that such Waiver shall not be subject to revocation, rescission, cancellation, termination, or any other legal or equitable action to disrupt the quiet enjoyment of the Work by the public as contemplated by Affirmer's express Statement of Purpose. 32 | 33 | 3. __Public License Fallback.__ Should any part of the Waiver for any reason be judged legally invalid or ineffective under applicable law, then the Waiver shall be preserved to the maximum extent permitted taking into account Affirmer's express Statement of Purpose. In addition, to the extent the Waiver is so judged Affirmer hereby grants to each affected person a royalty-free, non transferable, non sublicensable, non exclusive, irrevocable and unconditional license to exercise Affirmer's Copyright and Related Rights in the Work (i) in all territories worldwide, (ii) for the maximum duration provided by applicable law or treaty (including future time extensions), (iii) in any current or future medium and for any number of copies, and (iv) for any purpose whatsoever, including without limitation commercial, advertising or promotional purposes (the "License"). The License shall be deemed effective as of the date CC0 was applied by Affirmer to the Work. Should any part of the License for any reason be judged legally invalid or ineffective under applicable law, such partial invalidity or ineffectiveness shall not invalidate the remainder of the License, and in such case Affirmer hereby affirms that he or she will not (i) exercise any of his or her remaining Copyright and Related Rights in the Work or (ii) assert any associated claims and causes of action with respect to the Work, in either case contrary to Affirmer's express Statement of Purpose. 34 | 35 | 4. __Limitations and Disclaimers.__ 36 | 37 | a. No trademark or patent rights held by Affirmer are waived, abandoned, surrendered, licensed or otherwise affected by this document. 38 | 39 | b. Affirmer offers the Work as-is and makes no representations or warranties of any kind concerning the Work, express, implied, statutory or otherwise, including without limitation warranties of title, merchantability, fitness for a particular purpose, non infringement, or the absence of latent or other defects, accuracy, or the present or absence of errors, whether or not discoverable, all to the greatest extent permissible under applicable law. 40 | 41 | c. Affirmer disclaims responsibility for clearing rights of other persons that may apply to the Work or any use thereof, including without limitation any person's Copyright and Related Rights in the Work. Further, Affirmer disclaims responsibility for obtaining any necessary consents, permissions or other rights required for any use of the Work. 42 | 43 | d. Affirmer understands and acknowledges that Creative Commons is not a party to this document and has no duty or obligation with respect to this CC0 or use of the Work. 44 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(garson,default) 4 | S3method(garson,mlp) 5 | S3method(garson,nn) 6 | S3method(garson,nnet) 7 | S3method(garson,numeric) 8 | S3method(garson,train) 9 | S3method(lekprofile,default) 10 | S3method(lekprofile,mlp) 11 | S3method(lekprofile,nn) 12 | S3method(lekprofile,nnet) 13 | S3method(lekprofile,train) 14 | S3method(neuralskips,nnet) 15 | S3method(neuralweights,mlp) 16 | S3method(neuralweights,nn) 17 | S3method(neuralweights,nnet) 18 | S3method(neuralweights,numeric) 19 | S3method(olden,default) 20 | S3method(olden,mlp) 21 | S3method(olden,nn) 22 | S3method(olden,nnet) 23 | S3method(olden,numeric) 24 | S3method(olden,train) 25 | S3method(plotnet,default) 26 | S3method(plotnet,mlp) 27 | S3method(plotnet,nn) 28 | S3method(plotnet,nnet) 29 | S3method(plotnet,numeric) 30 | S3method(plotnet,train) 31 | export(garson) 32 | export(lekgrps) 33 | export(lekprofile) 34 | export(neuralskips) 35 | export(neuralweights) 36 | export(olden) 37 | export(plotnet) 38 | export(pred_sens) 39 | import(ggplot2) 40 | import(nnet) 41 | import(reshape2) 42 | import(tidyr) 43 | importFrom(graphics,par) 44 | importFrom(graphics,plot) 45 | importFrom(graphics,points) 46 | importFrom(graphics,segments) 47 | importFrom(graphics,text) 48 | importFrom(scales,rescale) 49 | importFrom(stats,coef) 50 | importFrom(stats,formula) 51 | importFrom(stats,kmeans) 52 | importFrom(stats,model.frame) 53 | importFrom(stats,predict) 54 | importFrom(stats,quantile) 55 | importFrom(stats,terms) 56 | importFrom(utils,capture.output) 57 | -------------------------------------------------------------------------------- /NeuralNetTools.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | PackageCheckArgs: --as-cran 19 | PackageRoxygenize: rd 20 | -------------------------------------------------------------------------------- /R/NeuralNetTools_gar.R: -------------------------------------------------------------------------------- 1 | #' Variable importance using Garson's algorithm 2 | #' 3 | #' Relative importance of input variables in neural networks using Garson's algorithm 4 | #' 5 | #' @param mod_in input model object or a list of model weights as returned from \code{\link{neuralweights}} if using the default method 6 | #' @param x_names chr string of input variable names, obtained from the model object 7 | #' @param y_names chr string of response variable names, obtained from the model object 8 | #' @param bar_plot logical indicating if a \code{ggplot} object is returned (default \code{T}), otherwise numeric values are returned 9 | #' @param x_lab chr string of alternative names to be used for explanatory variables in the figure, default is taken from \code{mod_in} 10 | #' @param y_lab chr string of alternative name to be used for the y-axis in the figure 11 | #' @param ... arguments passed to other methods 12 | #' 13 | #' @details 14 | #' The weights that connect variables in a neural network are partially analogous to parameter coefficients in a standard regression model and can be used to describe relationships between variables. The weights dictate the relative influence of information that is processed in the network such that input variables that are not relevant in their correlation with a response variable are suppressed by the weights. The opposite effect is seen for weights assigned to explanatory variables that have strong positive or negative associations with a response variable. An obvious difference between a neural network and a regression model is that the number of weights is excessive in the former case. This characteristic is advantageous in that it makes neural networks very flexible for modeling non-linear functions with multiple interactions, although interpretation of the effects of specific variables is of course challenging. 15 | #' 16 | #' A method described in Garson 1991 (also see Goh 1995) identifies the relative importance of explanatory variables for a single response variables in a supervised neural network by deconstructing the model weights. The relative importance (or strength of association) of a specific explanatory variable for the response variable can be determined by identifying all weighted connections between the nodes of interest. That is, all weights connecting the specific input node that pass through the hidden layer to the response variable are identified. This is repeated for all other explanatory variables until a list of all weights that are specific to each input variable is obtained. The connections are tallied for each input node and scaled relative to all other inputs. A single value is obtained for each explanatory variable that describes the relationship with the response variable in the model (see the appendix in Goh 1995 for a more detailed description). The original algorithm indicates relative importance as the absolute magnitude from zero to one such the direction of the response cannot be determined. 17 | #' 18 | #' Misleading results may be produced if the neural network was created with a skip-layer using \code{skip = TRUE} with the \code{\link[nnet]{nnet}} or \code{\link[caret]{train}} functions. Garson's algorithm does not describe the effects of skip layer connections on estimates of variable importance. As such, these values are removed prior to estimating variable importance. 19 | #' 20 | #' The algorithm currently only works for neural networks with one hidden layer and one response variable. 21 | #' 22 | #' @export 23 | #' 24 | #' @import ggplot2 25 | #' 26 | #' @return A \code{\link[ggplot2]{ggplot}} object for plotting if \code{bar_plot = FALSE}, otherwise a \code{data.frame} of relative importance values for each input variable. The default aesthetics for \code{\link[ggplot2]{ggplot}} can be further modified, as shown with the examples. 27 | #' 28 | #' @references 29 | #' 30 | #' Beck, M.W. 2018. NeuralNetTools: Visualization and Analysis Tools for Neural Networks. Journal of Statistical Software. 85(11):1-20. 31 | #' 32 | #' Garson, G.D. 1991. Interpreting neural network connection weights. Artificial Intelligence Expert. 6(4):46-51. 33 | #' 34 | #' Goh, A.T.C. 1995. Back-propagation neural networks for modeling complex systems. Artificial Intelligence in Engineering. 9(3):143-151. 35 | #' 36 | #' Olden, J.D., Jackson, D.A. 2002. Illuminating the 'black-box': a randomization approach for understanding variable contributions in artificial neural networks. Ecological Modelling. 154:135-150. 37 | #' 38 | #' Olden, J.D., Joy, M.K., Death, R.G. 2004. An accurate comparison of methods for quantifying variable importance in artificial neural networks using simulated data. Ecological Modelling. 178:389-397. 39 | #' 40 | #' @seealso \code{\link{olden}} for a more flexible approach for variable importance 41 | #' 42 | #' @examples 43 | #' 44 | #' ## using numeric input 45 | #' 46 | #' wts_in <- c(13.12, 1.49, 0.16, -0.11, -0.19, -0.16, 0.56, -0.52, 0.81) 47 | #' struct <- c(2, 2, 1) #two inputs, two hidden, one output 48 | #' 49 | #' garson(wts_in, struct) 50 | #' 51 | #' ## using nnet 52 | #' 53 | #' library(nnet) 54 | #' 55 | #' data(neuraldat) 56 | #' set.seed(123) 57 | #' 58 | #' mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 59 | #' 60 | #' garson(mod) 61 | #' 62 | #' \dontrun{ 63 | #' ## using RSNNS, no bias layers 64 | #' 65 | #' library(RSNNS) 66 | #' 67 | #' x <- neuraldat[, c('X1', 'X2', 'X3')] 68 | #' y <- neuraldat[, 'Y1'] 69 | #' mod <- mlp(x, y, size = 5) 70 | #' 71 | #' garson(mod) 72 | #' 73 | #' ## using neuralnet 74 | #' 75 | #' library(neuralnet) 76 | #' 77 | #' mod <- neuralnet(Y1 ~ X1 + X2 + X3, data = neuraldat, hidden = 5) 78 | #' 79 | #' garson(mod) 80 | #' 81 | #' ## using caret 82 | #' 83 | #' library(caret) 84 | #' 85 | #' mod <- train(Y1 ~ X1 + X2 + X3, method = 'nnet', data = neuraldat, linout = TRUE) 86 | #' 87 | #' garson(mod) 88 | #' 89 | #' ## modify the plot using ggplot2 syntax 90 | #' library(ggplot2) 91 | #' 92 | #' mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 93 | #' 94 | #' cols <- heat.colors(10) 95 | #' garson(mod) + 96 | #' scale_y_continuous('Rel. Importance', limits = c(-1, 1)) + 97 | #' scale_fill_gradientn(colours = cols) + 98 | #' scale_colour_gradientn(colours = cols) 99 | #'} 100 | garson <- function(mod_in, ...) UseMethod('garson') 101 | 102 | #' @rdname garson 103 | #' 104 | #' @export 105 | #' 106 | #' @method garson default 107 | garson.default <- function(mod_in, x_names, y_names, bar_plot = TRUE, x_lab = NULL, y_lab = NULL, ...){ 108 | 109 | # stop if more than one y output 110 | if(length(y_names) > 1) 111 | stop('Garson only applies to neural networks with one output node') 112 | 113 | # change variables names to user sub 114 | if(!is.null(x_lab)){ 115 | if(length(x_names) != length(x_lab)) stop('x_lab length not equal to number of input variables') 116 | else x_names <- x_lab 117 | } 118 | if(!is.null(y_lab)){ 119 | y_names <- y_lab 120 | } else { 121 | y_names <- 'Importance' 122 | } 123 | 124 | # the default method works with weight list 125 | wts_in <- mod_in 126 | 127 | # organize hidden layer weights for matrix mult 128 | inp_hid <- wts_in[grep('hidden', names(wts_in))] 129 | split_vals <- substr(names(inp_hid), 1, 8) 130 | inp_hid <- split(inp_hid, split_vals) 131 | inp_hid <- lapply(inp_hid, function(x) t(do.call('rbind', x))[-1, ]) 132 | 133 | # stop if multiple hidden layers 134 | max_i <- length(inp_hid) 135 | if(max_i > 1) stop('Garsons algorithm not applicable for multiple hidden layers') 136 | 137 | # final layer weights for output 138 | hid_out <- wts_in[[grep('out 1', names(wts_in))]][-1] 139 | 140 | # use garson's algorithm 141 | sum_in <- t(inp_hid[[max_i]]) 142 | dimsum <- dim(sum_in) 143 | sum_in <- apply(sum_in, 2, function(x){ 144 | 145 | abs(x) * abs(hid_out) 146 | 147 | }) 148 | sum_in <- matrix(sum_in, nrow = dimsum[1], ncol = dimsum[2], byrow = FALSE) 149 | sum_in <- sum_in/rowSums(sum_in) 150 | sum_in <- colSums(sum_in) 151 | 152 | # get relative contribution 153 | rel_imp <- sum_in/sum(sum_in) 154 | 155 | if(!bar_plot){ 156 | out <- data.frame(rel_imp) 157 | row.names(out) <- x_names 158 | return(out) 159 | } 160 | 161 | to_plo <- data.frame(rel_imp, x_names)[order(rel_imp), , drop = FALSE] 162 | to_plo$x_names <- factor(x_names[order(rel_imp)], levels = x_names[order(rel_imp)]) 163 | out_plo <- ggplot2::ggplot(to_plo, aes(x = x_names, y = rel_imp, fill = rel_imp, 164 | colour = rel_imp)) + 165 | geom_bar(stat = 'identity', position = 'identity') + 166 | scale_x_discrete(element_blank()) + 167 | scale_y_continuous(y_names) + 168 | theme_bw() + 169 | theme(legend.position = 'none') 170 | 171 | return(out_plo) 172 | 173 | } 174 | 175 | #' @rdname garson 176 | #' 177 | #' @param struct numeric vector equal in length to the number of layers in the network. Each number indicates the number of nodes in each layer starting with the input and ending with the output. An arbitrary number of hidden layers can be included. 178 | #' 179 | #' @export 180 | #' 181 | #' @method garson numeric 182 | garson.numeric <- function(mod_in, struct, ...){ 183 | 184 | # get variable names from mod_in object 185 | x_names <- paste0(rep('X', struct[1]), seq(1:struct[1])) 186 | y_names <- paste0(rep('Y', struct[3]), seq(1:struct[3])) 187 | 188 | # get model weights 189 | wts_in <- neuralweights(mod_in, struct = struct) 190 | struct <- wts_in$struct 191 | wts_in <- wts_in$wts 192 | 193 | garson.default(wts_in, x_names, y_names, ...) 194 | 195 | } 196 | 197 | #' @rdname garson 198 | #' 199 | #' @export 200 | #' 201 | #' @method garson nnet 202 | garson.nnet <- function(mod_in, ...){ 203 | 204 | # check for skip layers 205 | chk <- grepl('skip-layer', capture.output(mod_in)) 206 | if(any(chk)) 207 | stop("Garson's algorithm not applicable for networks with skip layers, use Olden's method") 208 | 209 | # get variable names from mod_in object 210 | # separate methdos if nnet called with formula 211 | if(is.null(mod_in$call$formula)){ 212 | x_names <- colnames(eval(mod_in$call$x)) 213 | y_names <- colnames(eval(mod_in$call$y)) 214 | } 215 | else{ 216 | forms <- eval(mod_in$call$formula) 217 | x_names <- mod_in$coefnames 218 | facts <- attr(terms(mod_in), 'factors') 219 | y_check <- mod_in$fitted 220 | if(ncol(y_check)>1) y_names <- colnames(y_check) 221 | else y_names <- as.character(forms)[2] 222 | } 223 | 224 | # get model weights 225 | wts_in <- neuralweights(mod_in) 226 | struct <- wts_in$struct 227 | wts_in <- wts_in$wts 228 | 229 | garson.default(wts_in, x_names, y_names, ...) 230 | 231 | } 232 | 233 | #' @rdname garson 234 | #' 235 | #' @export 236 | #' 237 | #' @method garson mlp 238 | garson.mlp <- function(mod_in, ...){ 239 | 240 | #get variable names from mod_in object 241 | all_names <- mod_in$snnsObject$getUnitDefinitions() 242 | x_names <- all_names[grep('Input', all_names$unitName), 'unitName'] 243 | y_names <- all_names[grep('Output', all_names$unitName), 'unitName'] 244 | 245 | # get model weights 246 | wts_in <- neuralweights(mod_in) 247 | struct <- wts_in$struct 248 | wts_in <- wts_in$wts 249 | 250 | garson.default(wts_in, x_names, y_names, ...) 251 | 252 | } 253 | 254 | #' @rdname garson 255 | #' 256 | #' @export 257 | #' 258 | #' @method garson nn 259 | garson.nn <- function(mod_in, ...){ 260 | 261 | # get variable names from mod_in object 262 | # change to user input if supplied 263 | x_names <- mod_in$model.list$variables 264 | y_names <- mod_in$model.list$response 265 | 266 | # get model weights 267 | wts_in <- neuralweights(mod_in) 268 | struct <- wts_in$struct 269 | wts_in <- wts_in$wts 270 | 271 | garson.default(wts_in, x_names, y_names, ...) 272 | 273 | } 274 | 275 | #' @rdname garson 276 | #' 277 | #' @export 278 | #' 279 | #' @method garson train 280 | garson.train <- function(mod_in, ...){ 281 | 282 | y_names <- strsplit(as.character(mod_in$terms[[2]]), ' + ', fixed = TRUE)[[1]] 283 | mod_in <- mod_in$finalModel 284 | x_names <- mod_in$xNames 285 | 286 | # check for skip layers 287 | chk <- grepl('skip-layer', capture.output(mod_in)) 288 | if(any(chk)) 289 | stop("Garson's algorithm not applicable for networks with skip layers, use Olden's method") 290 | 291 | # get model weights 292 | wts_in <- neuralweights(mod_in) 293 | struct <- wts_in$struct 294 | wts_in <- wts_in$wts 295 | 296 | garson.default(wts_in, x_names, y_names, ...) 297 | 298 | } 299 | 300 | -------------------------------------------------------------------------------- /R/NeuralNetTools_lek.R: -------------------------------------------------------------------------------- 1 | #' Sensitivity analysis using Lek's profile method 2 | #' 3 | #' Conduct a sensitivity analysis of model responses in a neural network to input variables using Lek's profile method 4 | #' 5 | #' @param mod_in input object for which an organized model list is desired. The input can be an object of class \code{nnet} or \code{mlp} 6 | #' @param xvars \code{\link[base]{data.frame}} of explanatory variables used to create the input model, only needed for \code{mlp} objects 7 | #' @param yvars \code{\link[base]{data.frame}} of explanatory variables used to create the input model, only needed for \code{mlp} objects 8 | #' @param ysel chr string indicating which response variables to plot if more than one, defaults to all 9 | #' @param xsel chr string of names of explanatory variables to plot, defaults to all 10 | #' @param steps numeric value indicating number of observations to evaluate for each explanatory variable from minimum to maximum value, default 100 11 | #' @param group_vals numeric vector with values from 0-1 indicating quantile values at which to hold other explanatory variables constant or a single value indicating number of clusters to define grouping scheme, see details 12 | #' @param val_out logical value indicating if actual sensitivity values are returned rather than a plot, default \code{FALSE} 13 | #' @param group_show logical if a barplot is returned that shows the values at which explanatory variables were held constant while not being evaluated 14 | #' @param grp_nms optional chr string of alternative names for groups in legend 15 | #' @param position chr string indicating bar position (e.g., 'dodge', 'fill', 'stack'), passed to \code{\link[ggplot2]{geom_bar}}, used if \code{group_show = TRUE} 16 | #' @param ... arguments passed to other methods 17 | #' 18 | #' @details 19 | #' The Lek profile method is described briefly in Lek et al. 1996 and in more detail in Gevrey et al. 2003. The profile method is fairly generic and can be extended to any statistical model in R with a predict method. However, it is one of few methods used to evaluate sensitivity in neural networks. 20 | #' 21 | #' The profile method can be used to evaluate the effect of explanatory variables by returning a plot of the predicted response across the range of values for each separate variable. The original profile method evaluated the effects of each variable while holding the remaining explanatory variables at different quantiles (e.g., minimum, 20th percentile, maximum). This is implemented in in the function by creating a matrix of values for explanatory variables where the number of rows is the number of observations and the number of columns is the number of explanatory variables. All explanatory variables are held at their mean (or other constant value) while the variable of interest is sequenced from its minimum to maximum value across the range of observations. This matrix (or data frame) is then used to predict values of the response variable from a fitted model object. This is repeated for each explanatory variable to obtain all response curves. Values passed to \code{group_vals} must range from zero to one to define the quantiles for holding unevaluated explanatory variables. 22 | #' 23 | #' An alternative implementation of the profile method is to group the unevaluated explanatory variables using groupings defined by the statistical properties of the data. Covariance among predictors may present unlikely scenarios if holding all unevaluated variables at the same level. To address this issue, the function provides an option to hold unevaluated variable at mean values defined by natural clusters in the data. \code{\link[stats]{kmeans}} clustering is used on the input \code{data.frame} of explanatory variables if the argument passed to \code{group_vals} is an integer value greater than one. The centers of the clusters are then used as constant values for the unevaluated variables. An arbitrary grouping scheme can also be passed to \code{group_vals} as a \code{data.frame} where the user can specify exact values for holding each value constant (see the examples). 24 | #' 25 | #' For all plots, the legend with the 'Groups' label indicates the colors that correspond to each group. The groups describe the values at which unevaluated explanatory variables were held constant, either as specific quantiles, group assignments based on clustering, or in the arbitrary grouping defined by the user. The constant values of each explanatory variable for each group can be viewed as a barplot by using \code{group_show = TRUE}. 26 | #' 27 | #' Note that there is no predict method for neuralnet objects from the nn package. The lekprofile method for nn objects uses the nnet package to recreate the input model, which is then used for the sensitivity predictions. This approach only works for networks with one hidden layer. 28 | #' 29 | #' @export 30 | #' 31 | #' @import ggplot2 nnet 32 | #' 33 | #' @return A \code{\link[ggplot2]{ggplot}} object for plotting if \code{val_out = FALSE}, otherwise a two-element \code{list} is returned with a \code{data.frame} in long form showing the predicted responses at different values of the explanatory variables and the grouping scheme that was used to hold unevaluated variables constant. 34 | #' 35 | #' @references 36 | #' 37 | #' Beck, M.W. 2018. NeuralNetTools: Visualization and Analysis Tools for Neural Networks. Journal of Statistical Software. 85(11):1-20. 38 | #' 39 | #' Lek, S., Delacoste, M., Baran, P., Dimopoulos, I., Lauga, J., Aulagnier, S. 1996. Application of neural networks to modelling nonlinear relationships in Ecology. Ecological Modelling. 90:39-52. 40 | #' 41 | #' Gevrey, M., Dimopoulos, I., Lek, S. 2003. Review and comparison of methods to study the contribution of variables in artificial neural network models. Ecological Modelling. 160:249-264. 42 | #' 43 | #' Olden, J.D., Joy, M.K., Death, R.G. 2004. An accurate comparison of methods for quantifying variable importance in artificial neural networks using simulated data. Ecological Modelling. 178:389-397. 44 | #' 45 | #' @examples 46 | #' 47 | #' ## using nnet 48 | #' 49 | #' library(nnet) 50 | #' 51 | #' set.seed(123) 52 | #' 53 | #' mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 54 | #' 55 | #' lekprofile(mod) 56 | #' 57 | #' \dontrun{ 58 | #' ## using RSNNS, no bias layers 59 | #' 60 | #' library(RSNNS) 61 | #' 62 | #' x <- neuraldat[, c('X1', 'X2', 'X3')] 63 | #' y <- neuraldat[, 'Y1', drop = FALSE] 64 | #' 65 | #' mod <- mlp(x, y, size = 5) 66 | #' 67 | #' lekprofile(mod, xvars = x) 68 | #' 69 | #' ## using neuralnet 70 | #' 71 | #' library(neuralnet) 72 | #' 73 | #' mod <- neuralnet(Y1 ~ X1 + X2 + X3, data = neuraldat, hidden = 5) 74 | #' 75 | #' lekprofile(mod) 76 | #' 77 | #' ## back to nnet, not using formula to create model 78 | #' ## y variable must have a name attribute 79 | #' 80 | #' mod <- nnet(x, y, size = 5) 81 | #' 82 | #' lekprofile(mod) 83 | #' 84 | #' ## using caret 85 | #' 86 | #' library(caret) 87 | #' 88 | #' mod <- train(Y1 ~ X1 + X2 + X3, method = 'nnet', data = neuraldat, linout = TRUE) 89 | #' 90 | #' lekprofile(mod) 91 | #' 92 | #' ## group by clusters instead of sequencing by quantiles 93 | #' 94 | #' mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 95 | #' 96 | #' lekprofile(mod, group_vals = 6) # six clusters 97 | #' 98 | #' ## enter an arbitrary grouping scheme for the group values 99 | #' ## i.e. hold all values at 0.5 100 | #' group_vals <- rbind(rep(0.5, length = ncol(x))) 101 | #' group_vals <- data.frame(group_vals) 102 | #' names(group_vals) <- names(group_vals) 103 | #' 104 | #' lekprofile(mod, group_vals = group_vals, xsel = 'X3') 105 | #' } 106 | lekprofile <- function(mod_in, ...) UseMethod('lekprofile') 107 | 108 | #' @rdname lekprofile 109 | #' 110 | #' @import ggplot2 111 | #' 112 | #' @export 113 | #' 114 | #' @method lekprofile default 115 | lekprofile.default <- function(mod_in, xvars, ysel = NULL, xsel = NULL, steps = 100, group_vals = seq(0, 1, by = 0.2), val_out = FALSE, group_show = FALSE, grp_nms = NULL, position = 'dodge', ...){ 116 | 117 | # subset xsel if xsel is not empy 118 | if(is.null(xsel)) xsel <- names(xvars) 119 | 120 | # stop if only one input variable 121 | if(ncol(xvars) == 1) stop('Lek profile requires greater than one input variable') 122 | 123 | # standard lekprofile method using quantile groups or clusters 124 | if(inherits(group_vals, c('numeric', 'integer'))){ 125 | 126 | # quantile approach 127 | if(all(group_vals <= 1)){ 128 | 129 | grps <- apply(xvars, 2, quantile, group_vals) 130 | grps <- as.data.frame(rbind(grps)) 131 | 132 | # kmeans approach 133 | } else { 134 | 135 | # sanity checks for integer, one value 136 | if(length(group_vals) > 1) stop('Multiple group_vals must be from 0 and 1') 137 | if(any(group_vals%%1 != 0)) stop('group_vals as a single value must be an integer') 138 | 139 | # get means of cluster centers 140 | grps <- kmeans(xvars, centers = group_vals)$centers 141 | 142 | } 143 | 144 | # use matrix or data.frame input for constant values 145 | } else { 146 | 147 | if(ncol(group_vals) != ncol(xvars)) stop('group_vals as matrix must have ncol same as xvars') 148 | grps <- group_vals 149 | names(grps) <- names(xvars) 150 | 151 | } 152 | 153 | # return bar plot for group values 154 | if(group_show) return(lekgrps(grps, position = position, grp_nms = grp_nms)) 155 | 156 | #use 'pred_fun' to get pred vals of response across range of vals for an exp vars 157 | #loops over all explanatory variables of interest and all group values 158 | lek_vals <- sapply( 159 | xsel, 160 | function(vars) pred_sens(xvars, mod_in, vars, steps, grps, ysel), 161 | simplify = FALSE 162 | ) 163 | 164 | #melt lek_val list for use with ggplot 165 | lek_vals <- melt(lek_vals, id.vars = 'x_vars') 166 | lek_vals$L2 <- factor(lek_vals$L2)#, labels = 1:nrow(grps)) 167 | names(lek_vals) <- c('Explanatory', 'resp_name', 'Response', 'Groups', 'exp_name') 168 | 169 | # change factor levels for groups in legend 170 | if(!is.null(grp_nms)){ 171 | 172 | uni_grps <- unique(lek_vals$Groups) 173 | if(length(grp_nms) != length(uni_grps)) 174 | stop('grp_nms must have same length as group_vals') 175 | 176 | lek_vals$Groups <- factor(lek_vals$Groups, levels = uni_grps, labels = grp_nms) 177 | 178 | } 179 | 180 | #return only values if val_out = TRUE 181 | if(val_out) return(list(lek_vals, grps)) 182 | 183 | #ggplot object 184 | p <- ggplot2::ggplot(lek_vals, aes_string(x = 'Explanatory', y = 'Response', group = 'Groups')) + 185 | geom_line(aes_string(colour = 'Groups')) + 186 | facet_grid(resp_name ~ exp_name, scales = 'free_x') + 187 | theme_bw() 188 | 189 | return(p) 190 | 191 | } 192 | 193 | #' @rdname lekprofile 194 | #' 195 | #' @import ggplot2 196 | #' 197 | #' @export 198 | #' 199 | #' @method lekprofile nnet 200 | lekprofile.nnet <- function(mod_in, xsel = NULL, ysel = NULL, ...){ 201 | 202 | # get exp and resp names from mod_in 203 | # get matrix for exp vars 204 | if(is.null(mod_in$call$formula)){ 205 | 206 | ychk <- colnames(eval(mod_in$call$y)) 207 | if(is.null(ychk)) stop('Response variables must have names attribute') 208 | xchk <- colnames(eval(mod_in$call$x)) 209 | if(is.null(xchk)) stop('Input variables must have names attribute') 210 | xvars <- eval(mod_in$call$x) 211 | 212 | } else { 213 | 214 | forms <- eval(mod_in$call$formula) 215 | dat_names <- try(model.frame(forms,data = eval(mod_in$call$data))) 216 | ychk <- as.character(forms)[2] 217 | xchk <- names(dat_names)[!names(dat_names) %in% as.character(forms)[2]] 218 | xvars <- dat_names[, !names(dat_names) %in% as.character(forms)[2], drop = F] 219 | 220 | } 221 | 222 | # replace xsel, ysel with model values if not provided 223 | if(is.null(xsel)) xsel <- xchk 224 | if(is.null(ysel)) ysel <- ychk 225 | 226 | lekprofile.default(mod_in, xvars = xvars, ysel = ysel, xsel = xsel, ...) 227 | 228 | } 229 | 230 | #' @rdname lekprofile 231 | #' 232 | #' @import ggplot2 233 | #' 234 | #' @export 235 | #' 236 | #' @method lekprofile mlp 237 | lekprofile.mlp <- function(mod_in, xvars, yvars, xsel = NULL, ysel = NULL, ...){ 238 | 239 | if(!inherits(xvars, 'data.frame')) stop('xvars must be a data.frame') 240 | if(!inherits(yvars, 'data.frame')) stop('yvars must be a data.frame') 241 | 242 | # getexp and resp names from mod_in if not provided 243 | # get matrix for exp vars 244 | if(is.null(ysel)) 245 | ysel <- names(yvars) 246 | if(is.null(xsel)) 247 | xsel <- names(xvars) 248 | 249 | lekprofile.default(mod_in, xvars = xvars, yvars = yvars, xsel = xsel, ysel = ysel, ...) 250 | 251 | } 252 | 253 | #' @rdname lekprofile 254 | #' 255 | #' @import ggplot2 256 | #' 257 | #' @export 258 | #' 259 | #' @method lekprofile train 260 | lekprofile.train <- function(mod_in, xsel = NULL, ysel = NULL, ...){ 261 | 262 | # input data, x_names, and y_names 263 | xvars <- mod_in$trainingData 264 | xvars <- xvars[, !names(xvars) %in% '.outcome'] 265 | ychk <- strsplit(as.character(mod_in$terms[[2]]), ' + ', fixed = TRUE)[[1]] 266 | mod_in <- mod_in$finalModel 267 | x_names <- mod_in$xNames 268 | xvars <- xvars[, x_names] 269 | 270 | if(is.null(ysel)) ysel <- ychk 271 | 272 | lekprofile.default(mod_in, xvars = xvars, xsel = xsel, ysel = ysel, ...) 273 | 274 | } 275 | 276 | #' @rdname lekprofile 277 | #' 278 | #' @import ggplot2 nnet 279 | #' 280 | #' @export 281 | #' 282 | #' @method lekprofile nn 283 | lekprofile.nn <- function(mod_in, xsel = NULL, ysel = NULL, ...){ 284 | 285 | # recreate the model using nnet (no predict method for nn) 286 | moddat <- mod_in$data 287 | modwts <- neuralweights(mod_in) 288 | modwts <- unlist(modwts$wts) 289 | modsz <- mod_in$call$hidden 290 | modfrm <- eval(mod_in$call$formula) 291 | modlin <- mod_in$call$linear.output 292 | modlin2 <- TRUE 293 | if(!is.null(modlin)) modlin2 <- modlin 294 | 295 | # stop if multiple hidden layers - nnet can only do one input 296 | # mlp can do this but does not accept starting weights 297 | if(length(modsz) > 1) stop('Cannot use lekprofile with multiple hidden layers') 298 | 299 | # create call for nnet model 300 | mod_in <- substitute( 301 | nnet(formin, data = moddat, size = modsz, 302 | Wts = modwts, maxit = 0, linout = modlin2, trace = FALSE), 303 | list(formin = formula(modfrm), moddat = moddat, modsz = modsz, modwts = modwts, 304 | modlin2 = modlin2) 305 | ) 306 | 307 | # eval call 308 | mod_in <- eval(mod_in) 309 | 310 | # pass to lekprofile.nnet 311 | lekprofile(mod_in, xsel = xsel, ysel = ysel, ...) 312 | 313 | } 314 | 315 | -------------------------------------------------------------------------------- /R/NeuralNetTools_neuraldat.R: -------------------------------------------------------------------------------- 1 | #' Simulated dataset for function examples 2 | #' 3 | #' A simulated dataset of 2000 observations containing two response variables and three explanatory variables. Explanatory variables were sampled from a standard normal distribution. Response variables were linear combinations of the explanatory variables. The response variables Y1 and Y2 are standardized from 0 to 1. 4 | #' 5 | #' @format A data frame with 2000 rows and 5 variables: 6 | #' \describe{ 7 | #' \item{Y1}{numeric} 8 | #' \item{Y2}{numeric} 9 | #' \item{X1}{numeric} 10 | #' \item{X2}{numeric} 11 | #' \item{X3}{numeric} 12 | #' ... 13 | #' } 14 | #' 15 | "neuraldat" -------------------------------------------------------------------------------- /R/NeuralNetTools_old.R: -------------------------------------------------------------------------------- 1 | #' Variable importance using connection weights 2 | #' 3 | #' Relative importance of input variables in neural networks as the sum of the product of raw input-hidden, hidden-output connection weights, proposed by Olden et al. 2004. 4 | #' 5 | #' @param mod_in input model object or a list of model weights as returned from \code{\link{neuralweights}} if using the default method 6 | #' @param x_names chr string of input variable names, obtained from the model object 7 | #' @param y_names chr string of response variable names, obtained from the model object 8 | #' @param out_var chr string indicating the response variable in the neural network object to be evaluated. Only one input is allowed for models with more than one response. Names must be of the form \code{'Y1'}, \code{'Y2'}, etc. if using numeric values as weight inputs for \code{mod_in}. 9 | #' @param bar_plot logical indicating if a \code{ggplot} object is returned (default \code{T}), otherwise numeric values are returned 10 | #' @param x_lab chr string of alternative names to be used for explanatory variables in the figure, default is taken from \code{mod_in} 11 | #' @param y_lab chr string of alternative names to be used for response variable in the figure, default is taken from \code{out_var} 12 | #' @param skip_wts vector from \code{\link{neuralskips}} for \code{\link[nnet]{nnet}} models with skip-layer connections 13 | #' @param ... arguments passed to or from other methods 14 | #' 15 | #' @details 16 | #' This method is similar to Garson's algorithm (Garson 1991, modified by Goh 1995) in that the connection weights between layers of a neural network form the basis for determining variable importance. However, Olden et al. 2004 describe a connection weights algorithm that consistently out-performed Garson's algorithm in representing the true variable importance in simulated datasets. This `Olden' method calculates variable importance as the product of the raw input-hidden and hidden-output connection weights between each input and output neuron and sums the product across all hidden neurons. An advantage of this approach is the relative contributions of each connection weight are maintained in terms of both magnitude and sign as compared to Garson's algorithm which only considers the absolute magnitude. For example, connection weights that change sign (e.g., positive to negative) between the input-hidden to hidden-output layers would have a cancelling effect whereas Garson's algorithm may provide misleading results based on the absolute magnitude. An additional advantage is that Olden's algorithm is capable of evaluating neural networks with multiple hidden layers wheras Garson's was developed for networks with a single hidden layer. 17 | #' 18 | #' The importance values assigned to each variable are in units that are based directly on the summed product of the connection weights. The actual values should only be interpreted based on relative sign and magnitude between explanatory variables. Comparisons between different models should not be made. 19 | #' 20 | #' The Olden function also works with networks that have skip layers by adding the input-output connection weights to the final summed product of all input-hidden and hidden-output connections. This was not described in the original method so interpret with caution. 21 | #' 22 | #' By default, the results are shown only for the first response variable for networks with multiple output nodes. The plotted response variable can be changed with \code{out_var}. 23 | #' 24 | #' @export 25 | #' 26 | #' @import ggplot2 27 | #' 28 | #' @return A \code{\link[ggplot2]{ggplot}} object for plotting if \code{bar_plot = FALSE}, otherwise a \code{data.frame} of relative importance values for each input variable. 29 | #' 30 | #' @references 31 | #' 32 | #' Beck, M.W. 2018. NeuralNetTools: Visualization and Analysis Tools for Neural Networks. Journal of Statistical Software. 85(11):1-20. 33 | #' 34 | #' Garson, G.D. 1991. Interpreting neural network connection weights. Artificial Intelligence Expert. 6(4):46-51. 35 | #' 36 | #' Goh, A.T.C. 1995. Back-propagation neural networks for modeling complex systems. Artificial Intelligence in Engineering. 9(3):143-151. 37 | #' 38 | #' Olden, J.D., Jackson, D.A. 2002. Illuminating the 'black-box': a randomization approach for understanding variable contributions in artificial neural networks. Ecological Modelling. 154:135-150. 39 | #' 40 | #' Olden, J.D., Joy, M.K., Death, R.G. 2004. An accurate comparison of methods for quantifying variable importance in artificial neural networks using simulated data. Ecological Modelling. 178:389-397. 41 | #' 42 | #' @examples 43 | #' 44 | #' ## using numeric input 45 | #' 46 | #' wts_in <- c(13.12, 1.49, 0.16, -0.11, -0.19, -0.16, 0.56, -0.52, 0.81) 47 | #' struct <- c(2, 2, 1) #two inputs, two hidden, one output 48 | #' 49 | #' olden(wts_in, struct) 50 | #' 51 | #' ## using nnet 52 | #' 53 | #' library(nnet) 54 | #' 55 | #' data(neuraldat) 56 | #' set.seed(123) 57 | #' 58 | #' mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 59 | #' 60 | #' olden(mod) 61 | #' 62 | #' \dontrun{ 63 | #' ## View the difference for a model w/ skip layers 64 | #' 65 | #' set.seed(123) 66 | #' 67 | #' mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5, skip = TRUE) 68 | #' 69 | #' olden(mod) 70 | #' 71 | #' ## using RSNNS, no bias layers 72 | #' 73 | #' library(RSNNS) 74 | #' 75 | #' x <- neuraldat[, c('X1', 'X2', 'X3')] 76 | #' y <- neuraldat[, 'Y1'] 77 | #' mod <- mlp(x, y, size = 5) 78 | #' 79 | #' olden(mod) 80 | #' 81 | #' ## using neuralnet 82 | #' 83 | #' library(neuralnet) 84 | #' 85 | #' mod <- neuralnet(Y1 ~ X1 + X2 + X3, data = neuraldat, hidden = 5) 86 | #' 87 | #' olden(mod) 88 | #' 89 | #' ## using caret 90 | #' 91 | #' library(caret) 92 | #' 93 | #' mod <- train(Y1 ~ X1 + X2 + X3, method = 'nnet', data = neuraldat, linout = TRUE) 94 | #' 95 | #' olden(mod) 96 | #' 97 | #' ## multiple hidden layers 98 | #' 99 | #' x <- neuraldat[, c('X1', 'X2', 'X3')] 100 | #' y <- neuraldat[, 'Y1'] 101 | #' mod <- mlp(x, y, size = c(5, 7, 6), linOut = TRUE) 102 | #' 103 | #' olden(mod) 104 | #' } 105 | olden <- function(mod_in, ...) UseMethod('olden') 106 | 107 | #' @rdname olden 108 | #' 109 | #' @export 110 | #' 111 | #' @method olden default 112 | olden.default <- function(mod_in, x_names, y_names, out_var = NULL, bar_plot = TRUE, x_lab = NULL, y_lab = NULL, skip_wts = NULL, ...){ 113 | 114 | # get index value for response variable to measure 115 | if(is.null(out_var)){ 116 | if(length(y_names) > 1) 117 | warning('Results for first response variable only, use out_var argument to change') 118 | out_var <- y_names[1] 119 | } 120 | 121 | # stop if out_var is not a named variable 122 | if(!out_var %in% y_names) stop(paste('out_var must match one:', paste(y_names, collapse = ', '))) 123 | else out_ind <- grep(out_var, y_names, fixed = TRUE) 124 | 125 | #change variables names to user sub 126 | if(!is.null(x_lab)){ 127 | if(length(x_names) != length(x_lab)) stop('x_lab length not equal to number of input variables') 128 | else x_names <- x_lab 129 | } 130 | if(!is.null(y_lab)){ 131 | y_names <- y_lab 132 | } else { 133 | y_names <- 'Importance' 134 | } 135 | 136 | # the default method works with weight list 137 | wts_in <- mod_in 138 | 139 | # organize hidden layer weights for matrix mult 140 | inp_hid <- wts_in[grep('hidden', names(wts_in))] 141 | split_vals <- substr(names(inp_hid), 1, 8) 142 | inp_hid <- split(inp_hid, split_vals) 143 | inp_hid <- lapply(inp_hid, function(x) t(do.call('rbind', x))[-1, ]) 144 | 145 | # final layer weights for output 146 | hid_out <- wts_in[[paste('out', out_ind)]][-1] 147 | 148 | # matrix multiplication of output layer with connecting hidden layer 149 | max_i <- length(inp_hid) 150 | sum_in <- inp_hid[[max_i]] %*% matrix(hid_out) 151 | 152 | # recursive matrix multiplication for all remaining hidden layers 153 | # only for multiple hidden layers 154 | if(max_i != 1){ 155 | 156 | for(i in (max_i - 1):1) sum_in <- as.matrix(inp_hid[[i]]) %*% sum_in 157 | 158 | # final contribution vector for all inputs 159 | importance <- sum_in 160 | 161 | } else { 162 | 163 | importance <- sum_in 164 | 165 | } 166 | 167 | # add skip_wts 168 | if(!is.null(skip_wts)) sum_in <- unlist(skip_wts) + sum_in 169 | 170 | if(!bar_plot){ 171 | out <- data.frame(importance) 172 | row.names(out) <- x_names 173 | return(out) 174 | } 175 | 176 | to_plo <- data.frame(importance, x_names)[order(importance), , drop = FALSE] 177 | to_plo$x_names <- factor(x_names[order(importance)], levels = x_names[order(importance)]) 178 | out_plo <- ggplot2::ggplot(to_plo, aes(x = x_names, y = importance, fill = importance, 179 | colour = importance)) + 180 | geom_bar(stat = 'identity', position = 'identity') + 181 | scale_x_discrete(element_blank()) + 182 | scale_y_continuous(y_names) + 183 | theme_bw() + 184 | theme(legend.position = 'none') 185 | 186 | 187 | return(out_plo) 188 | 189 | 190 | } 191 | 192 | #' @rdname olden 193 | #' 194 | #' @param struct numeric vector equal in length to the number of layers in the network. Each number indicates the number of nodes in each layer starting with the input and ending with the output. An arbitrary number of hidden layers can be included. 195 | #' 196 | #' @export 197 | #' 198 | #' @method olden numeric 199 | olden.numeric <- function(mod_in, struct, ...){ 200 | 201 | #get variable names from mod_in object 202 | x_names <- paste0(rep('X', struct[1]), seq(1:struct[1])) 203 | y_names <- paste0(rep('Y', struct[3]), seq(1:struct[3])) 204 | 205 | # get model weights 206 | wts_in <- neuralweights(mod_in, struct = struct) 207 | struct <- wts_in$struct 208 | wts_in <- wts_in$wts 209 | 210 | olden.default(wts_in, x_names, y_names, ...) 211 | 212 | } 213 | 214 | #' @rdname olden 215 | #' 216 | #' @export 217 | #' 218 | #' @method olden nnet 219 | olden.nnet <- function(mod_in, ...){ 220 | 221 | # check for skip layers 222 | skip_wts <- try(neuralskips(mod_in), silent = TRUE) 223 | if(inherits(skip_wts, 'try-error')) skip_wts <- NULL 224 | 225 | # get variable names from mod_in object 226 | # separate methods if nnet called with formula 227 | if(is.null(mod_in$call$formula)){ 228 | x_names <- 229 | colnames(eval(mod_in$call$x)) 230 | y_names <- colnames(eval(mod_in$call$y)) 231 | } 232 | else{ 233 | forms <- eval(mod_in$call$formula) 234 | x_names <- mod_in$coefnames 235 | facts <- attr(terms(mod_in), 'factors') 236 | y_check <- mod_in$fitted 237 | if(ncol(y_check)>1) y_names <- colnames(y_check) 238 | else y_names <- as.character(forms)[2] 239 | } 240 | 241 | # get model weights 242 | wts_in <- neuralweights(mod_in) 243 | struct <- wts_in$struct 244 | wts_in <- wts_in$wts 245 | 246 | olden.default(wts_in, x_names, y_names, skip_wts = skip_wts, ...) 247 | 248 | } 249 | 250 | #' @rdname olden 251 | #' 252 | #' @export 253 | #' 254 | #' @method olden mlp 255 | olden.mlp <- function(mod_in, ...){ 256 | 257 | # get variable names from mod_in object 258 | all_names <- mod_in$snnsObject$getUnitDefinitions() 259 | x_names <- all_names[grep('Input', all_names$unitName), 'unitName'] 260 | y_names <- all_names[grep('Output', all_names$unitName), 'unitName'] 261 | 262 | # get model weights 263 | wts_in <- neuralweights(mod_in) 264 | struct <- wts_in$struct 265 | wts_in <- wts_in$wts 266 | 267 | olden.default(wts_in, x_names, y_names, ...) 268 | 269 | } 270 | 271 | #' @rdname olden 272 | #' 273 | #' @export 274 | #' 275 | #' @method olden nn 276 | olden.nn <- function(mod_in, ...){ 277 | 278 | # get variable names from mod_in object 279 | x_names <- mod_in$model.list$variables 280 | y_names <- mod_in$model.list$response 281 | 282 | # get model weights 283 | wts_in <- neuralweights(mod_in) 284 | struct <- wts_in$struct 285 | wts_in <- wts_in$wts 286 | 287 | olden.default(wts_in, x_names, y_names, ...) 288 | 289 | } 290 | 291 | #' @rdname olden 292 | #' 293 | #' @export 294 | #' 295 | #' @method olden train 296 | olden.train <- function(mod_in, ...){ 297 | 298 | # check for skip layers 299 | skip_wts <- try(neuralskips(mod_in), silent = TRUE) 300 | if(inherits(skip_wts, 'try-error')) skip_wts <- NULL 301 | 302 | # get variable names from mod_in object 303 | y_names <- strsplit(as.character(mod_in$terms[[2]]), ' + ', fixed = TRUE)[[1]] 304 | mod_in <- mod_in$finalModel 305 | x_names <- mod_in$xNames 306 | 307 | # get model weights 308 | wts_in <- neuralweights(mod_in) 309 | struct <- wts_in$struct 310 | wts_in <- wts_in$wts 311 | 312 | olden.default(wts_in, x_names, y_names, skip_wts = skip_wts, ...) 313 | 314 | } 315 | -------------------------------------------------------------------------------- /R/NeuralNetTools_plot.R: -------------------------------------------------------------------------------- 1 | #' Plot a neural network model 2 | #' 3 | #' Plot a neural interpretation diagram for a neural network object 4 | #' 5 | #' @param mod_in neural network object or numeric vector of weights 6 | #' @param x_names chr string indicating names for input variables, default from model object 7 | #' @param y_names chr string indicating names for output variables, default from model object 8 | #' @param nid logical value indicating if neural interpretation diagram is plotted, default \code{TRUE} 9 | #' @param all_out chr string indicating names of response variables for which connections are plotted, default all 10 | #' @param all_in chr string indicating names of input variables for which connections are plotted, default all 11 | #' @param bias logical value indicating if bias nodes and connections are plotted, default \code{TRUE} 12 | #' @param bias_y value from 0 to 1 for locattion of bias nodes on y-axis 13 | #' @param rel_rsc numeric indicating the scaling range for the width of connection weights 14 | #' @param circle_cex numeric value indicating size of nodes, default 5 15 | #' @param node_labs logical value indicating if labels are plotted directly on nodes, default \code{TRUE} 16 | #' @param var_labs logical value indicating if variable names are plotted next to nodes, default \code{TRUE} 17 | #' @param line_stag numeric value that specifies distance of connection weights from nodes 18 | #' @param cex_val numeric value indicating size of text labels, default 1 19 | #' @param alpha_val numeric value (0-1) indicating transparency of connections, default 1 20 | #' @param circle_col chr string indicating color of nodes, default \code{'lightblue'}, or two element list with first element indicating color of input nodes and second indicating color of remaining nodes 21 | #' @param pos_col chr string indicating color of positive connection weights, default \code{'black'} 22 | #' @param neg_col chr string indicating color of negative connection weights, default \code{'grey'} 23 | #' @param bord_col chr string indicating border color around nodes, default \code{'lightblue'} 24 | #' @param prune_col chr string indicating color of pruned connections, otherwise not shown 25 | #' @param prune_lty line type for pruned connections, passed to \code{\link[graphics]{segments}} 26 | #' @param max_sp logical value indicating if space between nodes in each layer is maximized, default \code{FALSE} 27 | #' @param pad_x numeric for increasing or decreasing padding on the x-axis, values less than one will increase padding and values greater than one will decrease padding 28 | #' @param skip logical if skip layer connections are plotted instead of the primary network 29 | #' @param ... additional arguments passed to or from other methods 30 | #' 31 | #' @import ggplot2 32 | #' 33 | #' @export 34 | #' 35 | #' @references 36 | #' 37 | #' Beck, M.W. 2018. NeuralNetTools: Visualization and Analysis Tools for Neural Networks. Journal of Statistical Software. 85(11):1-20. 38 | #' 39 | #' Ozesmi, S.L., Ozesmi, U. 1999. An artificial neural network approach to spatial habitat modeling with interspecific interaction. Ecological Modelling. 116:15-31. 40 | #' 41 | #' @return A graphics object unless \code{wts_only = TRUE}, then neural network weights from \code{\link{neuralweights}}. 42 | #' 43 | #' @details 44 | #' This function plots a neural network as a neural interpretation diagram as in Ozesmi and Ozesmi (1999). Options to plot without color-coding or shading of weights are also provided. The default settings plot positive weights between layers as black lines and negative weights as grey lines. Line thickness is in proportion to relative magnitude of each weight. The first layer includes only input variables with nodes labelled arbitrarily as I1 through In for n input variables. One through many hidden layers are plotted with each node in each layer labelled as H1 through Hn. The output layer is plotted last with nodes labeled as O1 through On. Bias nodes connected to the hidden and output layers are also shown. Neural networks created using \code{\link[RSNNS]{mlp}} do not show bias layers. 45 | #' 46 | #' A primary network and a skip layer network can be plotted for \code{\link[nnet]{nnet}} models with a skip layer connection. The default is to plot the primary network, whereas the skip layer network can be viewed with \code{skip = TRUE}. If \code{nid = TRUE}, the line widths for both the primary and skip layer plots are relative to all weights. Viewing both plots is recommended to see which network has larger relative weights. Plotting a network with only a skip layer (i.e., no hidden layer, \code{size = 0}) will include bias connections to the output layer, whereas these are not included in the plot of the skip layer if \code{size} is greater than zero. 47 | #' 48 | #' The numeric method for plotting requires the input weights to be in a specific order given the structure of the network. An additional argument \code{struct} (from \code{\link{neuralweights}} is also required that lists the number of nodes in the input, hidden, and output layers. The example below for the numeric input shows the correct weight vector for a simple neural network model with two input variables, one output variable, and one hidden layer with two nodes. Bias nodes are also connected to the hidden and output layer. Using the plot syntax of I, H, O, and B for input, hidden, output, and bias to indicate weighted connections between layers, the correct weight order for the \code{mod_in} vector is B1-H1, I1-H1, I2-H1, B1-H2, I1-H2, I2-H2, B2-O1, H1-O1, H2-O1. For a generic network (three layers) with n input nodes, j hidden nodes, and k output nodes, the weights are ordered as the connections from B1, I1,...,In to H1,...,Hj, then B2, H1,..,Hj to O1,...,Ok. 49 | #' 50 | #' @examples 51 | #' ## using numeric input 52 | #' 53 | #' # B1-H1, I1-H1, I2-H1, B1-H2, I1-H2, I2-H2, B2-O1, H1-O1, H2-O1. 54 | #' wts_in <- c(13.12, 1.49, 0.16, -0.11, -0.19, -0.16, 0.56, -0.52, 0.81) 55 | #' struct <- c(2, 2, 1) #two inputs, two hidden, one output 56 | #' 57 | #' plotnet(wts_in, struct = struct) 58 | #' 59 | #' # numeric input, two hidden layers 60 | #' 61 | #' # B1-H11, I1-H11, I2-H11, B1-H12, I1-H12, I2-H12, B2-H21, H11-H21, H12-H21, 62 | #' # B2-H22, H11-H22, H12-H22, B3-O1, H21-O1, H22-O1 63 | #' wts_in <- c(1.12, 1.49, 0.16, -0.11, -0.19, -0.16, 0.5, 0.2, -0.12, -0.1, 64 | #' 0.89, 0.9, 0.56, -0.52, 0.81) 65 | #' struct <- c(2, 2, 2, 1) # two inputs, two (two nodes each), one output 66 | #' 67 | #' plotnet(wts_in, struct = struct) 68 | #' 69 | #' ## using nnet 70 | #' 71 | #' library(nnet) 72 | #' 73 | #' data(neuraldat) 74 | #' set.seed(123) 75 | #' 76 | #' mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 77 | #' 78 | #' plotnet(mod) 79 | #' 80 | #' ## plot the skip layer from nnet model 81 | #' 82 | #' mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5, skip = TRUE) 83 | #' 84 | #' plotnet(mod, skip = TRUE) 85 | #' 86 | #' \dontrun{ 87 | #' ## using RSNNS, no bias layers 88 | #' 89 | #' library(RSNNS) 90 | #' 91 | #' x <- neuraldat[, c('X1', 'X2', 'X3')] 92 | #' y <- neuraldat[, 'Y1'] 93 | #' mod <- mlp(x, y, size = 5) 94 | #' 95 | #' plotnet(mod) 96 | #' 97 | #' # pruned model using code from RSSNS pruning demo 98 | #' pruneFuncParams <- list(max_pr_error_increase = 10.0, pr_accepted_error = 1.0, 99 | #' no_of_pr_retrain_cycles = 1000, min_error_to_stop = 0.01, init_matrix_value = 1e-6, 100 | #' input_pruning = TRUE, hidden_pruning = TRUE) 101 | #' mod <- mlp(x, y, size = 5, pruneFunc = "OptimalBrainSurgeon", 102 | #' pruneFuncParams = pruneFuncParams) 103 | #' 104 | #' plotnet(mod) 105 | #' plotnet(mod, prune_col = 'lightblue') 106 | #' 107 | #' ## using neuralnet 108 | #' 109 | #' library(neuralnet) 110 | #' 111 | #' mod <- neuralnet(Y1 ~ X1 + X2 + X3, data = neuraldat, hidden = 5) 112 | #' 113 | #' plotnet(mod) 114 | #' 115 | #' ## using caret 116 | #' 117 | #' library(caret) 118 | #' 119 | #' mod <- train(Y1 ~ X1 + X2 + X3, method = 'nnet', data = neuraldat, linout = TRUE) 120 | #' 121 | #' plotnet(mod) 122 | #' 123 | #' ## a more complicated network with categorical response 124 | #' AND <- c(rep(0, 7), 1) 125 | #' OR <- c(0, rep(1, 7)) 126 | #' 127 | #' binary_data <- data.frame(expand.grid(c(0, 1), c(0, 1), c(0, 1)), AND, OR) 128 | #' 129 | #' mod <- neuralnet(AND + OR ~ Var1 + Var2 + Var3, binary_data, 130 | #' hidden = c(6, 12, 8), rep = 10, err.fct = 'ce', linear.output = FALSE) 131 | #' 132 | #' plotnet(mod) 133 | #' 134 | #' ## recreate the previous example with numeric inputs 135 | #' 136 | #' # get the weights and structure in the right format 137 | #' wts <- neuralweights(mod) 138 | #' struct <- wts$struct 139 | #' wts <- unlist(wts$wts) 140 | #' 141 | #' # plot 142 | #' plotnet(wts, struct = struct) 143 | #' 144 | #' ## color input nodes by relative importance 145 | #' mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 146 | #' 147 | #' rel_imp <- garson(mod, bar_plot = FALSE)$rel_imp 148 | #' cols <- colorRampPalette(c('lightgreen', 'darkgreen'))(3)[rank(rel_imp)] 149 | #' 150 | #' plotnet(mod, circle_col = list(cols, 'lightblue')) 151 | #' } 152 | plotnet <- function(mod_in, ...) UseMethod('plotnet') 153 | 154 | #' @rdname plotnet 155 | #' 156 | #' @export 157 | #' 158 | #' @method plotnet default 159 | plotnet.default <- function(mod_in, x_names, y_names, struct = NULL, nid = TRUE, all_out = TRUE, all_in = TRUE, bias = TRUE, bias_y = 0.95, rel_rsc = c(1, 7), circle_cex = 5, node_labs = TRUE, var_labs = TRUE, line_stag = NULL, cex_val = 1, alpha_val = 1, circle_col = 'lightblue', pos_col = 'black', neg_col = 'grey', bord_col = 'lightblue', max_sp = FALSE, pad_x = 1, prune_col = NULL, prune_lty = 'dashed', skip = NULL, ...){ 160 | 161 | wts <- neuralweights(mod_in, struct = struct) 162 | struct <- wts$struct 163 | wts <- wts$wts 164 | 165 | #circle colors for input, if desired, must be two-vector list, first vector is for input layer 166 | if(is.list(circle_col)){ 167 | circle_col_inp <- circle_col[[1]] 168 | circle_col <- circle_col[[2]] 169 | } 170 | else circle_col_inp <- circle_col 171 | 172 | #initiate plotting 173 | x_range <- c(-1, 1) 174 | y_range <- c(0, 1) 175 | if(is.null(line_stag)) line_stag <- 0.011 * circle_cex/2 176 | layer_x <- seq(-0.4, 0.4, length = length(struct)) * pad_x 177 | bias_x <- layer_x[-length(layer_x)] + diff(layer_x)/2 178 | circle_cex <- circle_cex 179 | 180 | #initiate plot 181 | plot(x_range, y_range, type = 'n', axes = FALSE, ylab = '', xlab = '') 182 | 183 | # warning if nnet hidden is zero 184 | if(struct[2] == 0){ 185 | warning('No hidden layer, plotting skip layer only with bias connections') 186 | skip <- TRUE 187 | } 188 | 189 | # subroutine for skip layer connections in nnet 190 | if(any(skip)){ 191 | 192 | return({ # use this to exit 193 | 194 | # plot connections usign layer lines with skip TRUE 195 | mapply( 196 | function(x) layer_lines(mod_in, x, layer1 = 1, layer2 = length(struct), out_layer = TRUE, nid = nid, rel_rsc = rel_rsc, all_in = all_in, pos_col = alpha(pos_col, alpha_val), neg_col = alpha(neg_col, alpha_val), x_range = x_range, y_range = y_range, line_stag = line_stag, x_names = x_names, layer_x = layer_x, max_sp = max_sp, struct = struct, prune_col = prune_col, prune_lty = prune_lty, skip = skip), 197 | 1:struct[length(struct)] 198 | ) 199 | 200 | # plot only input, output nodes 201 | for(i in c(1, length(struct))){ 202 | in_col <- circle_col 203 | if(i == 1) { layer_name <- 'I'; in_col <- circle_col_inp} 204 | if(i == length(struct)) layer_name <- 'O' 205 | layer_points(struct[i], layer_x[i], x_range, layer_name, cex_val, circle_cex, bord_col, in_col, 206 | node_labs, line_stag, var_labs, x_names, y_names, max_sp = max_sp, struct = struct, 207 | y_range = y_range 208 | ) 209 | 210 | } 211 | 212 | # bias node 213 | if(bias & struct[2] == 0){ 214 | layer_x <- rep(layer_x[length(layer_x)], length(layer_x)) # repeat this for last layer 215 | bias_points(max(bias_x), bias_y, 'B', node_labs, x_range, 216 | y_range, circle_cex, cex_val, bord_col, circle_col) 217 | bias_lines(max(bias_x), bias_y, mod_in, nid = nid, rel_rsc = rel_rsc, all_out = all_out, pos_col = alpha(pos_col, alpha_val), neg_col = alpha(neg_col, alpha_val), y_names = y_names, x_range = x_range, max_sp = max_sp, struct = struct[c(1, length(struct))], y_range = y_range, layer_x = layer_x, line_stag = line_stag) 218 | } 219 | 220 | }) 221 | 222 | } 223 | 224 | #use functions to plot connections between layers 225 | #bias lines 226 | if(bias) bias_lines(bias_x, bias_y, mod_in, nid = nid, rel_rsc = rel_rsc, all_out = all_out, pos_col = alpha(pos_col, alpha_val), neg_col = alpha(neg_col, alpha_val), y_names = y_names, x_range = x_range, max_sp = max_sp, struct = struct, y_range = y_range, layer_x = layer_x, line_stag = line_stag) 227 | 228 | #layer lines, makes use of arguments to plot all or for individual layers 229 | #starts with input - hidden 230 | #uses 'all_in' argument to plot connection lines for all input nodes or a single node 231 | if(is.logical(all_in)){ 232 | mapply( 233 | function(x) layer_lines(mod_in, x, layer1 = 1, layer2 = 2, nid = nid, rel_rsc = rel_rsc, 234 | all_in = all_in, pos_col = alpha(pos_col, alpha_val), 235 | neg_col = alpha(neg_col, alpha_val), x_range = x_range, y_range = y_range, 236 | line_stag = line_stag, x_names = x_names, layer_x = layer_x, max_sp = max_sp, struct = struct, 237 | prune_col = prune_col, prune_lty = prune_lty), 238 | 1:struct[1] 239 | ) 240 | } 241 | else{ 242 | node_in <- which(x_names == all_in) 243 | layer_lines(mod_in, node_in, layer1 = 1, layer2 = 2, nid = nid, rel_rsc = rel_rsc, all_in = all_in, 244 | pos_col = alpha(pos_col, alpha_val), neg_col = alpha(neg_col, alpha_val), 245 | x_range = x_range, y_range = y_range, line_stag = line_stag, x_names = x_names, layer_x = layer_x, 246 | max_sp = max_sp, struct = struct, prune_col = prune_col, prune_lty = prune_lty) 247 | } 248 | 249 | #connections between hidden layers 250 | lays <- split(c(1, rep(2:(length(struct) - 1), each = 2), length(struct)), 251 | f = rep(1:(length(struct) - 1), each = 2)) 252 | lays <- lays[-c(1, (length(struct) - 1))] 253 | for(lay in lays){ 254 | for(node in 1:struct[lay[1]]){ 255 | layer_lines(mod_in, node, layer1 = lay[1], layer2 = lay[2], nid = nid, rel_rsc = rel_rsc, all_in = TRUE, 256 | pos_col = alpha(pos_col, alpha_val), neg_col = alpha(neg_col, alpha_val), 257 | x_range = x_range, y_range = y_range, line_stag = line_stag, x_names = x_names, layer_x = layer_x, 258 | max_sp = max_sp, struct = struct, prune_col = prune_col, prune_lty = prune_lty, skip = skip) 259 | } 260 | } 261 | #lines for hidden - output 262 | #uses 'all_out' argument to plot connection lines for all output nodes or a single node 263 | if(is.logical(all_out)) 264 | mapply( 265 | function(x) layer_lines(mod_in, x, layer1 = length(struct) - 1, layer2 = length(struct), out_layer = TRUE, nid = nid, rel_rsc = rel_rsc, all_in = all_in, pos_col = alpha(pos_col, alpha_val), neg_col = alpha(neg_col, alpha_val), x_range = x_range, y_range = y_range, line_stag = line_stag, x_names = x_names, layer_x = layer_x, max_sp = max_sp, struct = struct, prune_col = prune_col, prune_lty = prune_lty, skip = skip), 266 | 1:struct[length(struct)] 267 | ) 268 | else{ 269 | node_in <- which(y_names == all_out) 270 | layer_lines(mod_in, node_in, layer1 = length(struct) - 1, layer2 = length(struct), out_layer = TRUE, nid = nid, rel_rsc = rel_rsc, pos_col = pos_col, neg_col = neg_col, x_range = x_range, y_range = y_range, line_stag = line_stag, x_names = x_names, layer_x = layer_x, max_sp = max_sp, struct = struct, prune_col = prune_col, prune_lty = prune_lty, skip = skip) 271 | } 272 | 273 | #use functions to plot nodes 274 | for(i in 1:length(struct)){ 275 | in_col <- circle_col 276 | layer_name <- 'H' 277 | if(i == 1) { layer_name <- 'I'; in_col <- circle_col_inp} 278 | if(i == length(struct)) layer_name <- 'O' 279 | layer_points(struct[i], layer_x[i], x_range, layer_name, cex_val, circle_cex, bord_col, in_col, 280 | node_labs, line_stag, var_labs, x_names, y_names, max_sp = max_sp, struct = struct, 281 | y_range = y_range 282 | ) 283 | } 284 | 285 | if(bias) bias_points(bias_x, bias_y, 'B', node_labs, x_range, 286 | y_range, circle_cex, cex_val, bord_col, circle_col) 287 | 288 | } 289 | 290 | #' @rdname plotnet 291 | #' 292 | #' @export 293 | #' 294 | #' @method plotnet nnet 295 | plotnet.nnet <- function(mod_in, x_names = NULL, y_names = NULL, skip = FALSE, ...){ 296 | 297 | # check for skip layers 298 | chk <- grepl('skip-layer', capture.output(mod_in)) 299 | if(!any(chk)) skip <- FALSE 300 | 301 | #get variable names from mod_in object 302 | #change to user input if supplied 303 | if(is.null(mod_in$call$formula)){ 304 | xlabs <- colnames(eval(mod_in$call$x)) 305 | ylabs <- colnames(eval(mod_in$call$y)) 306 | } 307 | else{ 308 | forms <- eval(mod_in$call$formula) 309 | xlabs <- mod_in$coefnames 310 | facts <- attr(terms(mod_in), 'factors') 311 | y_check <- mod_in$fitted 312 | if(ncol(y_check)>1) ylabs <- colnames(y_check) 313 | else ylabs <- as.character(forms)[2] 314 | } 315 | if(is.null(x_names)) x_names <- xlabs 316 | if(is.null(y_names)) y_names <- ylabs 317 | 318 | plotnet.default(mod_in, x_names = x_names, y_names = y_names, skip = skip, ...) 319 | 320 | } 321 | 322 | #' @rdname plotnet 323 | #' 324 | #' @param struct numeric vector equal in length to the number of layers in the network. Each number indicates the number of nodes in each layer starting with the input and ending with the output. An arbitrary number of hidden layers can be included. 325 | #' 326 | #' @export 327 | #' 328 | #' @method plotnet numeric 329 | plotnet.numeric <- function(mod_in, struct, x_names = NULL, y_names = NULL, ...){ 330 | 331 | #get variable names from mod_in object 332 | #change to user input if supplied 333 | if(is.null(x_names)) 334 | x_names <- paste0(rep('X', struct[1]), seq(1:struct[1])) 335 | if(is.null(y_names)) 336 | y_names <- paste0(rep('Y', struct[length(struct)]), seq(1:struct[length(struct)])) 337 | 338 | plotnet.default(mod_in, struct = struct, x_names = x_names, y_names = y_names, skip = FALSE, ...) 339 | 340 | } 341 | 342 | #' @rdname plotnet 343 | #' 344 | #' @export 345 | #' 346 | #' @method plotnet mlp 347 | plotnet.mlp <- function(mod_in, x_names = NULL, y_names = NULL, prune_col = NULL, prune_lty = 'dashed', ...){ 348 | 349 | #get variable names from mod_in object 350 | all_names <- mod_in$snnsObject$getUnitDefinitions() 351 | if(is.null(x_names)) 352 | x_names <- all_names[grep('Input', all_names$unitName), 'unitName'] 353 | if(is.null(y_names)) 354 | y_names <- all_names[grep('Output', all_names$unitName), 'unitName'] 355 | 356 | bias <- FALSE 357 | 358 | plotnet.default(mod_in, x_names = x_names, y_names = y_names, bias = bias, prune_col = prune_col, 359 | prune_lty = prune_lty, skip = FALSE, ...) 360 | 361 | } 362 | 363 | #' @rdname plotnet 364 | #' 365 | #' @export 366 | #' 367 | #' @method plotnet nn 368 | plotnet.nn <- function(mod_in, x_names = NULL, y_names = NULL, ...){ 369 | 370 | #get variable names from mod_in object 371 | if(is.null(x_names)) 372 | x_names <- mod_in$model.list$variables 373 | if(is.null(y_names)) 374 | y_names <- mod_in$model.list$respons 375 | 376 | plotnet.default(mod_in, x_names = x_names, y_names = y_names, skip = FALSE, ...) 377 | 378 | } 379 | 380 | #' @rdname plotnet 381 | #' 382 | #' @export 383 | #' 384 | #' @method plotnet train 385 | plotnet.train <- function(mod_in, x_names = NULL, y_names = NULL, skip = FALSE, ...){ 386 | 387 | if(is.null(y_names)) 388 | y_names <- strsplit(as.character(mod_in$terms[[2]]), ' + ', fixed = TRUE)[[1]] 389 | mod_in <- mod_in$finalModel 390 | if(is.null(x_names)) 391 | x_names <- mod_in$xNames 392 | 393 | # check for skip layers 394 | chk <- grepl('skip-layer', capture.output(mod_in)) 395 | if(!any(chk)) skip <- FALSE 396 | 397 | plotnet.default(mod_in, x_names = x_names, y_names = y_names, skip = skip, ...) 398 | 399 | } -------------------------------------------------------------------------------- /R/NeuralNetTools_utils.R: -------------------------------------------------------------------------------- 1 | #' Get weights for a neural network 2 | #' 3 | #' Get weights for a neural network in an organized list by extracting values from a neural network object. This function is generally not called by itself. 4 | #' 5 | #' @param mod_in input object for which an organized model list is desired. The input can be an object of class \code{numeric}, \code{nnet}, \code{mlp}, or \code{nn} 6 | #' @param ... arguments passed to other methods 7 | #' 8 | #' @export 9 | #' 10 | #' @return Returns a two-element list with the first element being a vector indicating the number of nodes in each layer of the neural network and the second element being a named list of weight values for the input model. 11 | #' 12 | #' @details Each element of the returned list is named using the construct 'layer node', e.g. 'out 1' is the first node of the output layer. Hidden layers are named using three values for instances with more than one hidden layer, e.g., 'hidden 1 1' is the first node in the first hidden layer, 'hidden 1 2' is the second node in the first hidden layer, 'hidden 2 1' is the first node in the second hidden layer, etc. The values in each element of the list represent the weights entering the specific node from the preceding layer in sequential order, starting with the bias layer if applicable. For example, the elements in a list item for 'hidden 1 1' of a neural network with a 3 5 1 structure (3 inputs, 5 hidden nodes, 1 output) would have four values indicating the weights in sequence from the bias layer, first input layer, second input layer, and third input layer going to the first hidden node. 13 | #' 14 | #' The function will remove direct weight connections between input and output layers if the neural network was created with a skip-layer using \code{skip = TRUE} with the \code{\link[nnet]{nnet}} or \code{\link[caret]{train}} functions. This may produce misleading results when evaluating variable performance with the \code{\link{garson}} function. 15 | #' 16 | #' @examples 17 | #' 18 | #' data(neuraldat) 19 | #' set.seed(123) 20 | #' 21 | #' ## using numeric input 22 | #' 23 | #' wts_in <- c(13.12, 1.49, 0.16, -0.11, -0.19, -0.16, 0.56, -0.52, 0.81) 24 | #' struct <- c(2, 2, 1) #two inputs, two hidden, one output 25 | #' 26 | #' neuralweights(wts_in, struct = struct) 27 | #' 28 | #' ## using nnet 29 | #' 30 | #' library(nnet) 31 | #' 32 | #' mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5, linout = TRUE) 33 | #' 34 | #' neuralweights(mod) 35 | #' 36 | #' \dontrun{ 37 | #' ## using RSNNS, no bias layers 38 | #' 39 | #' library(RSNNS) 40 | #' 41 | #' x <- neuraldat[, c('X1', 'X2', 'X3')] 42 | #' y <- neuraldat[, 'Y1'] 43 | #' mod <- mlp(x, y, size = 5, linOut = TRUE) 44 | #' 45 | #' neuralweights(mod) 46 | #' 47 | #' # pruned model using code from RSSNS pruning demo 48 | #' pruneFuncParams <- list(max_pr_error_increase = 10.0, pr_accepted_error = 1.0, 49 | #' no_of_pr_retrain_cycles = 1000, min_error_to_stop = 0.01, init_matrix_value = 1e-6, 50 | #' input_pruning = TRUE, hidden_pruning = TRUE) 51 | #' mod <- mlp(x, y, size = 5, pruneFunc = "OptimalBrainSurgeon", 52 | #' pruneFuncParams = pruneFuncParams) 53 | #' 54 | #' neuralweights(mod) 55 | #' 56 | #' ## using neuralnet 57 | #' 58 | #' library(neuralnet) 59 | #' 60 | #' mod <- neuralnet(Y1 ~ X1 + X2 + X3, data = neuraldat, hidden = 5) 61 | #' 62 | #' neuralweights(mod) 63 | #' } 64 | neuralweights <- function(mod_in, ...) UseMethod('neuralweights') 65 | 66 | #' @rdname neuralweights 67 | #' 68 | #' @param rel_rsc numeric indicating the scaling range for the width of connection weights in a neural interpretation diagram. Default is \code{NULL} for no rescaling. 69 | #' @param struct numeric vector equal in length to the number of layers in the network. Each number indicates the number of nodes in each layer starting with the input and ending with the output. An arbitrary number of hidden layers can be included. 70 | #' 71 | #' @export 72 | #' 73 | #' @method neuralweights numeric 74 | neuralweights.numeric <- function(mod_in, rel_rsc = NULL, struct, ...){ 75 | 76 | wts <- mod_in 77 | 78 | if(!is.null(rel_rsc)) wts <- rescale(abs(wts), rel_rsc) 79 | 80 | #convert wts to list with appropriate names 81 | hid_struct <- struct[ -c(length(struct))] 82 | row_nms <- NULL 83 | for(i in 1:length(hid_struct)){ 84 | if(is.na(hid_struct[i + 1])) break 85 | row_nms <- c(row_nms, rep(paste('hidden', i, seq(1:hid_struct[i + 1])), each = 1 + hid_struct[i])) 86 | } 87 | row_nms <- c( 88 | row_nms, 89 | rep(paste('out', seq(1:struct[length(struct)])), each = 1 + struct[length(struct) - 1]) 90 | ) 91 | out_ls <- data.frame(wts, row_nms) 92 | out_ls$row_nms <- factor(row_nms, levels = unique(row_nms), labels = unique(row_nms)) 93 | out_ls <- split(out_ls$wts, f = out_ls$row_nms) 94 | 95 | return(list(struct = struct, wts = out_ls)) 96 | 97 | } 98 | 99 | #' @rdname neuralweights 100 | #' 101 | #' @export 102 | #' 103 | #' @method neuralweights nnet 104 | neuralweights.nnet <- function(mod_in, rel_rsc = NULL, ...){ 105 | 106 | struct <- mod_in$n 107 | wts <- mod_in$wts 108 | 109 | if(!is.null(rel_rsc)) wts <- rescale(abs(wts), rel_rsc) 110 | 111 | # remove wts from input to output if skip layers present 112 | chk <- grepl('skip-layer', capture.output(mod_in)) 113 | if(any(chk)){ 114 | coefs <- coef(mod_in) 115 | rems <- grepl('^i.*>o', names(coefs)) 116 | wts <- wts[!rems] 117 | } 118 | 119 | #convert wts to list with appropriate names 120 | hid_struct <- struct[ -c(length(struct))] 121 | row_nms <- NULL 122 | if(hid_struct[2] != 0) # only get hidden layer names if hidden layer exists 123 | for(i in 1:length(hid_struct)){ 124 | if(is.na(hid_struct[i + 1])) break 125 | row_nms <- c(row_nms, rep(paste('hidden', i, seq(1:hid_struct[i + 1])), each = 1 + hid_struct[i])) 126 | } 127 | # always get output names 128 | row_nms <- c( 129 | row_nms, 130 | rep(paste('out', seq(1:struct[length(struct)])), each = 1 + struct[length(struct) - 1]) 131 | ) 132 | 133 | out_ls <- data.frame(wts, row_nms) 134 | out_ls$row_nms <- factor(row_nms, levels = unique(row_nms), labels = unique(row_nms)) 135 | out_ls <- split(out_ls$wts, f = out_ls$row_nms) 136 | 137 | return(list(struct = struct, wts = out_ls)) 138 | 139 | } 140 | 141 | #' @rdname neuralweights 142 | #' 143 | #' @import reshape2 tidyr 144 | #' 145 | #' @export 146 | #' 147 | #' @method neuralweights mlp 148 | neuralweights.mlp <- function(mod_in, rel_rsc = NULL, ...){ 149 | 150 | struct <- c(mod_in$nInputs, mod_in$archParams$size, mod_in$nOutputs) 151 | hid.num <- length(struct) - 2 152 | wts <- mod_in$snnsObject$getCompleteWeightMatrix() 153 | 154 | # recreate weight matrix if pruned network 155 | if('pruneFunc' %in% names(mod_in)){ 156 | 157 | # get all node names using naming convention from mlp 158 | inp_nms <- grep('^Input', colnames(wts), value = TRUE) 159 | out_nms <- grep('^Output', colnames(wts), value = TRUE) 160 | uni.hids <- paste0('Hidden_', 1 + seq(1, hid.num)) 161 | hid_nms <- NULL 162 | for(i in 1:length(uni.hids)){ 163 | hid_nms <- c(hid_nms, paste0(uni.hids[i], '_', 1:struct[i + 1])) 164 | } 165 | all_nms <- c(inp_nms, hid_nms, out_nms) 166 | all_nms <- expand.grid(all_nms, all_nms) 167 | all_nms <- data.frame(all_nms) 168 | names(all_nms) <- c('keyrow', 'key') 169 | 170 | # wts in long form, merge with all names, NA to zero, back to matrix 171 | wts <- data.frame(wts, keyrow = row.names(wts)) 172 | wts <- gather(wts, 'key', 'value',-ncol(wts)) 173 | wts <- merge(all_nms, wts, by = c('key', 'keyrow'), all.x = TRUE) 174 | wts[is.na(wts$value), 'value'] <- 0 175 | wts <- spread(wts, 'keyrow', 'value') 176 | wts$key <- NULL 177 | wts <- as.matrix(wts) 178 | rownames(wts) <- colnames(wts) 179 | wts <- t(wts) 180 | } 181 | 182 | #get all input - hidden and hidden - hidden wts 183 | inps <- wts[grep('Input', row.names(wts)), grep('Hidden_2', colnames(wts)), drop = FALSE] 184 | inps <- melt(rbind(rep(NA, ncol(inps)), inps))$value 185 | uni.hids <- paste0('Hidden_', 1 + seq(1, hid.num)) 186 | for(i in 1:length(uni.hids)){ 187 | if(is.na(uni.hids[i + 1])) break 188 | tmp <- wts[grep(uni.hids[i], rownames(wts)), grep(uni.hids[i + 1], colnames(wts)), drop = FALSE] 189 | inps <- c(inps, melt(rbind(rep(NA, ncol(tmp)), tmp))$value) 190 | } 191 | 192 | #get connections from last hidden to output layers 193 | outs <- wts[grep(paste0('Hidden_', hid.num + 1), row.names(wts)), grep('Output', colnames(wts)), drop = FALSE] 194 | outs <- rbind(rep(NA, ncol(outs)), outs) 195 | 196 | #weight vector for all 197 | wts <- c(inps, melt(outs)$value) 198 | assign('bias', FALSE) 199 | 200 | if(!is.null(rel_rsc)) wts <- rescale(abs(wts), rel_rsc) 201 | 202 | #convert wts to list with appropriate names 203 | hid_struct <- struct[ -c(length(struct))] 204 | row_nms <- NULL 205 | for(i in 1:length(hid_struct)){ 206 | if(is.na(hid_struct[i + 1])) break 207 | row_nms <- c(row_nms, rep(paste('hidden', i, seq(1:hid_struct[i + 1])), each = 1 + hid_struct[i])) 208 | } 209 | row_nms <- c( 210 | row_nms, 211 | rep(paste('out', seq(1:struct[length(struct)])), each = 1 + struct[length(struct) - 1]) 212 | ) 213 | out_ls <- data.frame(wts, row_nms) 214 | out_ls$row_nms <- factor(row_nms, levels = unique(row_nms), labels = unique(row_nms)) 215 | out_ls <- split(out_ls$wts, f = out_ls$row_nms) 216 | 217 | return(list(struct = struct, wts = out_ls)) 218 | 219 | } 220 | 221 | #' @rdname neuralweights 222 | #' 223 | #' @export 224 | #' 225 | #' @method neuralweights nn 226 | neuralweights.nn <- function(mod_in, rel_rsc = NULL, ...){ 227 | 228 | struct <- unlist(lapply(mod_in$weights[[1]], ncol)) 229 | struct <- struct[ - length(struct)] 230 | struct <- c( 231 | length(mod_in$model.list$variables), 232 | struct, 233 | length(mod_in$model.list$response) 234 | ) 235 | wts <- unlist(mod_in$weights[[1]]) 236 | 237 | if(!is.null(rel_rsc)) wts <- rescale(abs(wts), rel_rsc) 238 | 239 | #convert wts to list with appropriate names 240 | hid_struct <- struct[ -c(length(struct))] 241 | row_nms <- NULL 242 | for(i in 1:length(hid_struct)){ 243 | if(is.na(hid_struct[i + 1])) break 244 | row_nms <- c(row_nms, rep(paste('hidden', i, seq(1:hid_struct[i + 1])), each = 1 + hid_struct[i])) 245 | } 246 | row_nms <- c( 247 | row_nms, 248 | rep(paste('out', seq(1:struct[length(struct)])), each = 1 + struct[length(struct) - 1]) 249 | ) 250 | out_ls <- data.frame(wts, row_nms) 251 | out_ls$row_nms <- factor(row_nms, levels = unique(row_nms), labels = unique(row_nms)) 252 | out_ls <- split(out_ls$wts, f = out_ls$row_nms) 253 | 254 | return(list(struct = struct, wts = out_ls)) 255 | 256 | } 257 | 258 | #' Predicted values for Lek profile method 259 | #' 260 | #' Get predicted values for Lek Profile method, used iteratively in \code{\link{lekprofile}} 261 | #' 262 | #' @param mat_in \code{data.frame} of only the explanatory variables used to create model 263 | #' @param mod_in any model object with a predict method 264 | #' @param var_sel chr string of explanatory variable to select 265 | #' @param step_val number of values to sequence range of selected explanatory variable 266 | #' @param grps matrix of values for holding explanatory values constant, one column per variable and one row per group 267 | #' @param ysel chr string of response variable names for correct labelling 268 | #' 269 | #'@details 270 | #' Gets predicted output for a model's response variable based on matrix of explanatory variables that are restricted following Lek's profile method. The selected explanatory variable is sequenced across a range of values. All other explanatory variables are held constant at the values in \code{grps}. 271 | #' 272 | #' @seealso lekprofile 273 | #' 274 | #' @return A \code{\link[base]{list}} of predictions where each element is a \code{\link[base]{data.frame}} with the predicted value of the response and the values of the explanatory variable defined by \code{var_sel}. Each element of the list corresponds to a group defined by the rows in \code{grps} at which the other explanatory variables were held constant. 275 | #' 276 | #' @export 277 | #' 278 | #' @examples 279 | #' 280 | #' ## using nnet 281 | #' 282 | #' library(nnet) 283 | #' 284 | #' data(neuraldat) 285 | #' set.seed(123) 286 | #' 287 | #' mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 288 | #' 289 | #' mat_in <- neuraldat[, c('X1', 'X2', 'X3')] 290 | #' grps <- apply(mat_in, 2, quantile, seq(0, 1, by = 0.2)) 291 | #' 292 | #' pred_sens(mat_in, mod, 'X1', 100, grps, 'Y1') 293 | pred_sens <- function(mat_in, mod_in, var_sel, step_val, grps, ysel){ 294 | 295 | # exp variable to evaluate across its range 296 | chngs <- range(mat_in[, var_sel, drop = FALSE], na.rm = TRUE) 297 | chngs <- data.frame(seq(chngs[1], chngs[2], length = step_val)) 298 | names(chngs) <- var_sel 299 | 300 | # constant values exp variables not to evaluate 301 | const <- grps[, !names(mat_in) %in% var_sel] 302 | rownames(const) <- 1:nrow(const) 303 | 304 | # iterate across rows of const, combine with chngs, get preds 305 | out <- apply(const, 1, function(x) { 306 | 307 | topred <- as.data.frame(rbind(x))[rep(1, step_val), ] 308 | topred <- cbind(chngs, topred) 309 | row.names(topred) <- 1:nrow(topred) 310 | topred <- topred[, names(mat_in)] # this has to be in correct order.... 311 | 312 | preds <- data.frame(predict(mod_in, newdata = topred)) 313 | if(ncol(preds) > 1) 314 | preds <- preds[, ysel, drop = FALSE] 315 | else names(preds) <- ysel 316 | 317 | x_vars <- topred[, var_sel] 318 | preds <- data.frame(preds, x_vars) 319 | rownames(preds) <- 1:step_val 320 | 321 | return(preds) 322 | 323 | }) 324 | 325 | return(out) 326 | 327 | } 328 | 329 | #' Get weights for the skip layer in a neural network 330 | #' 331 | #' Get weights for the skip layer in a neural network, only valid for networks created using \code{skip = TRUE} with the \code{\link[nnet]{nnet}} function. 332 | #' 333 | #' @param mod_in input object for which an organized model list is desired. 334 | #' @param ... arguments passed to other methods 335 | #' 336 | #' @export 337 | #' 338 | #' @return Returns a list of connections for each output node, where each element of the list is the connection for each input node in sequential order to the respective output node. The first weight in each element is not the bias connection, unlike the results for \code{\link{neuralweights}}. 339 | #' 340 | #' @details This function is similar to \code{\link{neuralweights}} except only the skip layer weights are returned. 341 | #' 342 | #' @examples 343 | #' 344 | #' data(neuraldat) 345 | #' set.seed(123) 346 | #' 347 | #' ## using nnet 348 | #' 349 | #' library(nnet) 350 | #' 351 | #' mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5, linout = TRUE, 352 | #' skip = TRUE) 353 | #' 354 | #' neuralskips(mod) 355 | #' 356 | neuralskips <- function(mod_in, ...) UseMethod('neuralskips') 357 | 358 | #' @rdname neuralskips 359 | #' 360 | #' @param rel_rsc numeric indicating the scaling range for the width of connection weights in a neural interpretation diagram. Default is \code{NULL} for no rescaling. Scaling is relative to all weights, not just those in the primary network. 361 | #' 362 | #' @export 363 | #' 364 | #' @method neuralskips nnet 365 | neuralskips.nnet <- function(mod_in, rel_rsc = NULL, ...){ 366 | 367 | struct <- mod_in$n 368 | wts <- mod_in$wts 369 | 370 | if(!is.null(rel_rsc)) wts <- rescale(abs(wts), rel_rsc) 371 | 372 | # get skip layer weights if present, otherwise exit 373 | chk <- grepl('skip-layer', capture.output(mod_in)) 374 | if(any(chk)){ 375 | 376 | coefs <- coef(mod_in) 377 | skips <- grepl('^i.*>o', names(coefs)) 378 | skips <- wts[skips] 379 | 380 | } else { 381 | 382 | stop('No skip layer') 383 | 384 | } 385 | 386 | # assign names and as list, otherwise weights not plotted correctly for multiple outputs 387 | row_nms <- rep(paste('out', seq(1:struct[length(struct)])), each = struct[1]) 388 | 389 | out_ls <- data.frame(skips, row_nms) 390 | out_ls$row_nms <- factor(row_nms, levels = unique(row_nms), labels = unique(row_nms)) 391 | out_ls <- split(out_ls$skips, f = out_ls$row_nms) 392 | 393 | return(out_ls) 394 | 395 | } 396 | 397 | #' Get y locations for layers in \code{\link{plotnet}} 398 | #' 399 | #' Get y locations for input, hidden, output layers in \code{\link{plotnet}} 400 | #' 401 | #' @param lyr numeric indicating layer for getting y locations 402 | #' @param max_sp logical indicating if space is maximized in plot 403 | #' @param struct numeric vector for network structure 404 | #' @param y_range numeric vector indicating limits of y axis 405 | #' 406 | get_ys <- function(lyr, max_sp, struct, y_range){ 407 | 408 | if(max_sp){ 409 | spacing <- diff(c(0 * diff(y_range), 0.9 * diff(y_range)))/lyr 410 | } else { 411 | spacing <- diff(c(0 * diff(y_range), 0.9 * diff(y_range)))/max(struct) 412 | } 413 | 414 | out <- seq(0.5 * (diff(y_range) + spacing * (lyr - 1)), 0.5 * (diff(y_range) - spacing * (lyr - 1)), 415 | length = lyr) 416 | 417 | return(out) 418 | 419 | } 420 | 421 | #' Plot neural network nodes 422 | #' 423 | #' Plot neural network nodes in \code{\link{plotnet}} 424 | #' 425 | #' @param layer specifies which layer, integer from \code{struct} 426 | #' @param x_loc indicates x location for layer, integer from \code{layer_x} 427 | #' @param x_range numeric for total range of x-axis 428 | #' @param layer_name string indicating text to put in node 429 | #' @param cex_val numeric indicating size of point text 430 | #' @param circle_cex numeric indicating size of circles 431 | #' @param bord_col chr string indicating border color around nodes, default \code{lightblue} 432 | #' @param in_col chr string indicating interior color of nodes 433 | #' @param node_labs logical indicating if node labels are to be plotted 434 | #' @param line_stag numeric indicating distance between of text from nodes 435 | #' @param var_labs chr string for variable labels 436 | #' @param x_names chr string for alternative names of input nodes 437 | #' @param y_names chr string for alternative names of output nodes 438 | #' @param ... values passed to \code{\link{get_ys}} 439 | #' 440 | layer_points <- function(layer, x_loc, x_range, layer_name, cex_val, circle_cex, bord_col, in_col, node_labs, line_stag, var_labs, x_names, y_names, ...){ 441 | 442 | x <- rep(x_loc * diff(x_range), layer) 443 | y <- get_ys(layer, ...) 444 | points(x, y, pch = 21, cex = circle_cex, col = bord_col, bg = in_col) 445 | if(node_labs) text(x, y, paste(layer_name, 1:layer, sep = ''), cex = cex_val) 446 | if(layer_name == 'I' & var_labs) text(x - line_stag * diff(x_range), y, x_names, pos = 2, cex = cex_val) 447 | if(layer_name == 'O' & var_labs) text(x + line_stag * diff(x_range), y, y_names, pos = 4, cex = cex_val) 448 | 449 | } 450 | 451 | #' Plot bias points 452 | #' 453 | #' Plot bias points in \code{\link{plotnet}} 454 | #' 455 | #' @param bias_x numeric vector of values for x locations 456 | #' @param bias_y numeric vector for y location 457 | #' @param layer_name string indicating text to put in node 458 | #' @param node_labs logical indicating of node labels are included 459 | #' @param x_range numeric of x axis range for base plot 460 | #' @param y_range numeric of y axis range for base plot 461 | #' @param circle_cex numeric value indicating size of nodes, default 5 462 | #' @param cex_val numeric value indicating size of text labels, default 1 463 | #' @param bord_col chr string indicating border color around nodes, default \code{'lightblue'} 464 | #' @param circle_col chr string indicating color of nodes 465 | #' 466 | bias_points <- function(bias_x, bias_y, layer_name, node_labs, x_range, y_range, circle_cex, cex_val, bord_col, circle_col){ 467 | for(val in 1:length(bias_x)){ 468 | points( 469 | diff(x_range) * bias_x[val], 470 | bias_y * diff(y_range), 471 | pch = 21, col = bord_col, bg = circle_col, cex = circle_cex 472 | ) 473 | if(node_labs) 474 | text( 475 | diff(x_range) * bias_x[val], 476 | bias_y * diff(y_range), 477 | paste(layer_name, val, sep = ''), 478 | cex = cex_val 479 | ) 480 | } 481 | } 482 | 483 | #' Plot connection weights 484 | #' 485 | #' Plot connection weights in \code{\link{plotnet}} 486 | #' 487 | #' @param mod_in neural network model object 488 | #' @param h_layer numeric indicating which connections to plot for the layer 489 | #' @param layer1 numeric indicating order of first layer (for multiple hiden layers) 490 | #' @param layer2 numeric indicating order of second layer (for multiple hiden layers) 491 | #' @param out_layer logical indicating if the lines are for the output layer 492 | #' @param nid logical value indicating if neural interpretation diagram is plotted, default \code{TRUE} 493 | #' @param rel_rsc numeric indicating the scaling range for the width of connection weights in a neural interpretation diagram. Default is \code{NULL} for no rescaling. 494 | #' @param all_in chr string indicating names of input variables for which connections are plotted, default all 495 | #' @param pos_col chr string indicating color of positive connection weights, default \code{'black'} 496 | #' @param neg_col chr string indicating color of negative connection weights, default \code{'grey'} 497 | #' @param x_range numeric of x axis range for base plot 498 | #' @param y_range numeric of y axis range for base plot 499 | #' @param line_stag numeric value that specifies distance of connection weights from nodes 500 | #' @param x_names chr string for names of input variables 501 | #' @param layer_x numeric indicating locations of layers on x axis 502 | #' @param struct numeric vector for network structure 503 | #' @param max_sp logical indicating if space is maximized in plot 504 | #' @param prune_col chr string indicating color of pruned connections, otherwise not shown 505 | #' @param prune_lty line type for pruned connections, passed to \code{\link[graphics]{segments}} 506 | #' @param skip logical to plot connections for skip layer 507 | #' 508 | layer_lines <- function(mod_in, h_layer, layer1 = 1, layer2 = 2, out_layer = FALSE, nid, rel_rsc, all_in, pos_col, neg_col, x_range, y_range, line_stag, x_names, layer_x, struct, max_sp, prune_col = NULL, prune_lty = 'dashed', skip){ 509 | 510 | x0 <- rep(layer_x[layer1] * diff(x_range) + line_stag * diff(x_range), struct[layer1]) 511 | x1 <- rep(layer_x[layer2] * diff(x_range) - line_stag * diff(x_range), struct[layer1]) 512 | 513 | # see if skip layer is presnet in nnet 514 | chk <- grepl('skip-layer', capture.output(mod_in)) 515 | 516 | if(out_layer == TRUE){ 517 | 518 | y0 <- get_ys(struct[layer1], max_sp, struct, y_range) 519 | y1 <- rep(get_ys(struct[layer2], max_sp, struct, y_range)[h_layer], struct[layer1]) 520 | src_str <- paste('out', h_layer) 521 | 522 | # get weights for numeric, otherwise use different method for neuralweights 523 | if(inherits(mod_in, c('numeric', 'integer'))){ 524 | 525 | wts <- neuralweights(mod_in, struct = struct)$wts 526 | wts_rs <- neuralweights(mod_in, rel_rsc, struct = struct)$wts 527 | wts <- wts[grep(src_str, names(wts))][[1]][-1] 528 | wts_rs <- wts_rs[grep(src_str, names(wts_rs))][[1]][-1] 529 | 530 | } else { 531 | 532 | # get skip weights if both TRUE 533 | if(skip & any(chk)){ 534 | 535 | wts <- neuralskips(mod_in) 536 | wts_rs <- neuralskips(mod_in, rel_rsc) 537 | wts <- wts[grep(src_str, names(wts))][[1]] # these do not include bias 538 | wts_rs <- wts_rs[grep(src_str, names(wts_rs))][[1]] 539 | 540 | # otherwise get normal connects 541 | } else { 542 | 543 | wts <- neuralweights(mod_in)$wts 544 | wts_rs <- neuralweights(mod_in, rel_rsc)$wts 545 | wts <- wts[grep(src_str, names(wts))][[1]][-1] 546 | wts_rs <- wts_rs[grep(src_str, names(wts_rs))][[1]][-1] 547 | 548 | } 549 | 550 | } 551 | 552 | cols <- rep(pos_col, struct[layer1]) 553 | cols[wts<0] <- neg_col 554 | 555 | # remove pruned connections or color of prune_col not null, linetype dashed 556 | ltype <- rep(par('lty'), length(wts)) 557 | if('pruneFunc' %in% names(mod_in)){ 558 | if(is.null(prune_col)) cols[wts == 0] <- NA 559 | else cols[wts == 0] <- prune_col 560 | ltype[wts == 0] <- prune_lty 561 | } 562 | 563 | } 564 | 565 | else{ 566 | 567 | if(is.logical(all_in)) all_in <- h_layer 568 | else all_in <- which(x_names == all_in) 569 | 570 | y0 <- rep(get_ys(struct[layer1], max_sp, struct, y_range)[all_in], struct[2]) 571 | y1 <- get_ys(struct[layer2], max_sp, struct, y_range) 572 | src_str <- paste('hidden', layer1) 573 | 574 | if(inherits(mod_in, c('numeric', 'integer'))){ 575 | wts <- neuralweights(mod_in, struct = struct)$wts 576 | wts <- unlist(lapply(wts[grep(src_str, names(wts))], function(x) x[all_in + 1])) 577 | wts_rs <- neuralweights(mod_in, rel_rsc, struct = struct)$wts 578 | wts_rs <- unlist(lapply(wts_rs[grep(src_str, names(wts_rs))], function(x) x[all_in + 1])) 579 | } else { 580 | wts <- neuralweights(mod_in)$wts 581 | wts <- unlist(lapply(wts[grep(src_str, names(wts))], function(x) x[all_in + 1])) 582 | wts_rs <- neuralweights(mod_in, rel_rsc)$wts 583 | wts_rs <- unlist(lapply(wts_rs[grep(src_str, names(wts_rs))], function(x) x[all_in + 1])) 584 | } 585 | 586 | cols <- rep(pos_col, struct[layer2]) 587 | cols[wts<0] <- neg_col 588 | 589 | # remove pruned connections or color of prune_col not null, linetype dashed 590 | ltype <- rep(par('lty'), length(wts)) 591 | if('pruneFunc' %in% names(mod_in)){ 592 | if(is.null(prune_col)) cols[wts == 0] <- NA 593 | else cols[wts == 0] <- prune_col 594 | ltype[wts == 0] <- prune_lty 595 | } 596 | 597 | } 598 | 599 | if(nid) segments(x0, y0, x1, y1, col = cols, lwd = wts_rs, lty = ltype) 600 | else segments(x0, y0, x1, y1, lty = ltype) 601 | 602 | } 603 | 604 | #' Plot connection weights for bias lines 605 | #' 606 | #' Plot connection weights for bias lines in \code{\link{plotnet}} 607 | #' 608 | #' @param bias_x numeric vector x axis locations for bias lines 609 | #' @param bias_y numeric vector y axis locations for bias lines 610 | #' @param mod_in neural network model object 611 | #' @param nid logical value indicating if neural interpretation diagram is plotted, default \code{TRUE} 612 | #' @param rel_rsc numeric indicating the scaling range for the width of connection weights in a neural interpretation diagram. Default is \code{NULL} for no rescaling. 613 | #' @param all_out chr string indicating names of response variables for which connections are plotted, default all 614 | #' @param pos_col chr string indicating color of positive connection weights, default \code{'black'} 615 | #' @param neg_col chr string indicating color of negative connection weights, default \code{'grey'} 616 | #' @param struct numeric vector for network structure 617 | #' @param y_names chr string for names of output variables 618 | #' @param x_range numeric of x axis range for base plot 619 | #' @param y_range numeric of x axis range for base plot 620 | #' @param layer_x numeric indicating locations of layers on x axis 621 | #' @param line_stag numeric value that specifies distance of connection weights from nodes 622 | #' @param max_sp logical indicating if space is maximized in plot 623 | bias_lines <- function(bias_x, bias_y, mod_in, nid, rel_rsc, all_out, pos_col, neg_col, struct, y_names, x_range, y_range, layer_x, line_stag, max_sp){ 624 | 625 | if(is.logical(all_out)) all_out <- 1:struct[length(struct)] 626 | else all_out <- which(y_names == all_out) 627 | 628 | for(val in 1:length(bias_x)){ 629 | 630 | if(inherits(mod_in, c('numeric', 'integer'))){ 631 | wts <- neuralweights(mod_in, struct = struct)$wts 632 | wts_rs <- neuralweights(mod_in, rel_rsc, struct = struct)$wts 633 | } else { 634 | wts <- neuralweights(mod_in)$wts 635 | wts_rs <- neuralweights(mod_in, rel_rsc)$wts 636 | } 637 | 638 | if(val != length(bias_x)){ 639 | wts <- wts[grep('out', names(wts), invert = TRUE)] 640 | wts_rs <- wts_rs[grep('out', names(wts_rs), invert = TRUE)] 641 | sel_val <- grep(val, substr(names(wts_rs), 8, 8)) 642 | wts <- wts[sel_val] 643 | wts_rs <- wts_rs[sel_val] 644 | } 645 | 646 | else{ 647 | wts <- wts[grep('out', names(wts))] 648 | wts_rs <- wts_rs[grep('out', names(wts_rs))] 649 | } 650 | 651 | cols <- rep(pos_col, length(wts)) 652 | cols[unlist(lapply(wts, function(x) x[1]))<0] <- neg_col 653 | wts_rs <- unlist(lapply(wts_rs, function(x) x[1])) 654 | 655 | if(nid == FALSE){ 656 | wts_rs <- rep(1, struct[val + 1]) 657 | cols <- rep('black', struct[val + 1]) 658 | } 659 | 660 | if(val != length(bias_x)){ 661 | segments( 662 | rep(diff(x_range) * bias_x[val] + diff(x_range) * line_stag, struct[val + 1]), 663 | rep(bias_y * diff(y_range), struct[val + 1]), 664 | rep(diff(x_range) * layer_x[val + 1] - diff(x_range) * line_stag, struct[val + 1]), 665 | get_ys(struct[val + 1], max_sp, struct, y_range), 666 | lwd = wts_rs, 667 | col = cols 668 | ) 669 | } 670 | 671 | else{ 672 | segments( 673 | rep(diff(x_range) * bias_x[val] + diff(x_range) * line_stag, struct[val + 1]), 674 | rep(bias_y * diff(y_range), struct[val + 1]), 675 | rep(diff(x_range) * layer_x[val + 1] - diff(x_range) * line_stag, struct[val + 1]), 676 | get_ys(struct[val + 1], max_sp, struct, y_range)[all_out], 677 | lwd = wts_rs[all_out], 678 | col = cols[all_out] 679 | ) 680 | } 681 | 682 | } 683 | } 684 | 685 | ###### 686 | #' Create optional barplot for \code{\link{lekprofile}} groups 687 | #' 688 | #' Create optional barplot of constant values of each variable for each group used with \code{\link{lekprofile}} 689 | #' 690 | #' @param grps \code{\link[base]{data.frame}} of values for each variable in each group used to create groups in \code{\link{lekprofile}} 691 | #' @param position chr string indicating bar position (e.g., 'dodge', 'fill', 'stack'), passed to \code{\link[ggplot2]{geom_bar}} 692 | #' @param grp_nms optional chr string of alternative names for groups in legend 693 | #' 694 | #' @import ggplot2 695 | #' 696 | #' @return A \code{\link[ggplot2]{ggplot}} object 697 | #' 698 | #' @export 699 | #' 700 | #' @examples 701 | #' ## enters used with kmeans clustering 702 | #' x <- neuraldat[, c('X1', 'X2', 'X3')] 703 | #' grps <- kmeans(x, 6)$center 704 | #' 705 | #' lekgrps(grps) 706 | lekgrps <- function(grps, position = 'dodge', grp_nms = NULL){ 707 | 708 | # add split columns, make long form 709 | grps <- as.data.frame(grps) 710 | 711 | # change group labels if needed 712 | if(is.null(grp_nms)){ 713 | 714 | grps$Groups <- factor(1:nrow(grps)) 715 | 716 | } else { 717 | 718 | uni_grps <- 1:nrow(grps) 719 | if(length(grp_nms) != length(uni_grps)) 720 | stop('grp_nms must have same length as group_vals') 721 | 722 | grps$Groups <- factor(uni_grps, labels = grp_nms) 723 | 724 | } 725 | 726 | # long format 727 | grps <- tidyr::gather(grps, 'variable', 'value', -ncol(grps)) 728 | 729 | p <- ggplot(grps, aes_string(x = 'Groups', y = 'value', fill = 'variable')) + 730 | geom_bar(stat = 'identity', position = position) + 731 | theme_bw() + 732 | theme(legend.title = element_blank()) + 733 | scale_y_continuous('Constant values') 734 | 735 | return(p) 736 | 737 | } 738 | 739 | #' @importFrom graphics par plot points segments text 740 | #' @importFrom scales rescale 741 | #' @importFrom stats coef formula kmeans model.frame predict quantile terms 742 | #' @importFrom utils capture.output 743 | NULL -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # README 2 | 3 | [![R-CMD-check](https://github.com/fawda123/NeuralNetTools/workflows/R-CMD-check/badge.svg)](https://github.com/fawda123/NeuralNetTools/actions) 4 | [![pkgdown](https://github.com/fawda123/NeuralNetTools/workflows/pkgdown/badge.svg)](https://github.com/fawda123/NeuralNetTools/actions) 5 | [![CRAN status](https://www.r-pkg.org/badges/version/NeuralNetTools)](https://CRAN.R-project.org/package=NeuralNetTools) 6 | [![](http://cranlogs.r-pkg.org/badges/grand-total/NeuralNetTools)](https://cran.rstudio.com/web/packages/NeuralNetTools/index.html) 7 | 8 | This is the development repository for the NeuralNetTools package. Functions within this package can be used for the interpretation of neural network models created in R, including functions to plot a neural network interpretation diagram, evaluation of variable importance, and a sensitivity analysis of input variables. 9 | 10 | The current release can be installed from CRAN: 11 | 12 | ```r 13 | # install NeuralNetTools 14 | install.packages('NeuralNetTools') 15 | ``` 16 | 17 | The development version of this package can be installed from [r-universe](https://fawda123.r-universe.dev): 18 | 19 | ```r 20 | # enable repos 21 | options(repos = c( 22 | tbeptech = 'https://fawda123.r-universe.dev', 23 | CRAN = 'https://cloud.r-project.org')) 24 | 25 | # install NeuralNetTools 26 | install.packages('NeuralNetTools') 27 | ``` 28 | 29 | See the [website](http://fawda123.github.io/NeuralNetTools) for additional information. 30 | 31 | ### Citation 32 | 33 | Please cite this package as follows: 34 | 35 | Beck MW (2018). "NeuralNetTools: Visualization and Analysis Tools for Neural Networks." _Journal of Statistical Software_, *85*(11), pp. 1-20. doi: 10.18637/jss.v085.i11 (URL: http://doi.org/10.18637/jss.v085.i11). 36 | 37 | # Issues and suggestions 38 | 39 | Please report any issues and suggestions on the [issues link](https://github.com/fawda123/NeuralNetTools/issues) for the repository. 40 | 41 | A guide to posting issues can be found [here](.github/ISSUE_TEMPLATE.md). 42 | 43 | # Contributing 44 | 45 | Please view our [contributing](.github/CONTRIBUTING.md) guidelines for any changes or pull requests. 46 | 47 | ### License 48 | 49 | This package is released in the public domain under the creative commons license [CC0](https://tldrlegal.com/license/creative-commons-cc0-1.0-universal). 50 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Resubmission 2 | This is an update to v1.5.3 3 | 4 | ## Test environments 5 | * Ubuntu 20.04.3 devel and release (on GitHub Actions), R 4.1.2 6 | * OS X 10.15.7 (on GitHub Actions), R 4.1.2 7 | * local Windows 10 install, R 4.1.2 8 | * win-builder [http://win-builder.r-project.org/](http://win-builder.r-project.org/) (devel and release) 9 | 10 | ## R CMD check results 11 | There were no ERRORs or WARNINGs. 12 | 13 | There was 1 NOTE, for an email change to one that is active: 14 | 15 | * checking DESCRIPTION meta-information ... NOTE 16 | Maintainer field differs from that derived from Authors@R 17 | Maintainer: 'Marcus W. Beck ' 18 | Authors@R: 'Marcus W. Beck ' 19 | 20 | ## Downstream dependencies 21 | We checked 6 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 22 | 23 | * We saw 0 new problems 24 | * We failed to check 0 packages -------------------------------------------------------------------------------- /data-raw/neuraldat.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | 3 | seed.val <- 2 4 | set.seed(seed.val) 5 | 6 | num.vars <- 3 7 | num.obs <- 2000 8 | 9 | #input variables 10 | rand.vars <- matrix(rnorm(num.vars * num.obs), ncol = num.vars) 11 | 12 | #output variables 13 | parms <- runif(num.vars, -1, 1) 14 | y1 <- rand.vars %*% matrix(parms) 15 | parms2 <- runif(num.vars, -1, 1) 16 | y2 <- rand.vars %*% matrix(parms2) 17 | 18 | #final datasets 19 | rand.vars <- data.frame(rand.vars) 20 | resp <- data.frame(y1, y2) 21 | names(resp) <- c('Y1', 'Y2') 22 | neuraldat <- data.frame(resp, rand.vars) 23 | 24 | # normalize all variables 25 | norm.fun <- function(x){ 26 | (x - min(x))/(max(x) - min(x)) 27 | } 28 | 29 | # standardize only response variables 30 | neuraldat <- mutate_each(neuraldat, funs(norm.fun), matches('^Y[0-9]$')) 31 | 32 | save(neuraldat, file = 'data/neuraldat.RData') 33 | 34 | -------------------------------------------------------------------------------- /data/neuraldat.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fawda123/NeuralNetTools/4fd777d0258877bfa4a80d03d10ecda17070d77a/data/neuraldat.RData -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | bibentry(bibtype = "Article", 2 | title = "{NeuralNetTools}: Visualization and Analysis Tools for Neural Networks", 3 | author = person(given = c("Marcus", "W."), 4 | family = "Beck", 5 | email = "marcusb@sccwrp.org"), 6 | journal = "Journal of Statistical Software", 7 | year = "2018", 8 | volume = "85", 9 | number = "11", 10 | pages = "1--20", 11 | doi = "10.18637/jss.v085.i11", 12 | 13 | header = "To cite NeuralNetTools in publications use:" 14 | ) 15 | 16 | -------------------------------------------------------------------------------- /man/bias_lines.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NeuralNetTools_utils.R 3 | \name{bias_lines} 4 | \alias{bias_lines} 5 | \title{Plot connection weights for bias lines} 6 | \usage{ 7 | bias_lines( 8 | bias_x, 9 | bias_y, 10 | mod_in, 11 | nid, 12 | rel_rsc, 13 | all_out, 14 | pos_col, 15 | neg_col, 16 | struct, 17 | y_names, 18 | x_range, 19 | y_range, 20 | layer_x, 21 | line_stag, 22 | max_sp 23 | ) 24 | } 25 | \arguments{ 26 | \item{bias_x}{numeric vector x axis locations for bias lines} 27 | 28 | \item{bias_y}{numeric vector y axis locations for bias lines} 29 | 30 | \item{mod_in}{neural network model object} 31 | 32 | \item{nid}{logical value indicating if neural interpretation diagram is plotted, default \code{TRUE}} 33 | 34 | \item{rel_rsc}{numeric indicating the scaling range for the width of connection weights in a neural interpretation diagram. Default is \code{NULL} for no rescaling.} 35 | 36 | \item{all_out}{chr string indicating names of response variables for which connections are plotted, default all} 37 | 38 | \item{pos_col}{chr string indicating color of positive connection weights, default \code{'black'}} 39 | 40 | \item{neg_col}{chr string indicating color of negative connection weights, default \code{'grey'}} 41 | 42 | \item{struct}{numeric vector for network structure} 43 | 44 | \item{y_names}{chr string for names of output variables} 45 | 46 | \item{x_range}{numeric of x axis range for base plot} 47 | 48 | \item{y_range}{numeric of x axis range for base plot} 49 | 50 | \item{layer_x}{numeric indicating locations of layers on x axis} 51 | 52 | \item{line_stag}{numeric value that specifies distance of connection weights from nodes} 53 | 54 | \item{max_sp}{logical indicating if space is maximized in plot} 55 | } 56 | \description{ 57 | Plot connection weights for bias lines in \code{\link{plotnet}} 58 | } 59 | -------------------------------------------------------------------------------- /man/bias_points.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NeuralNetTools_utils.R 3 | \name{bias_points} 4 | \alias{bias_points} 5 | \title{Plot bias points} 6 | \usage{ 7 | bias_points( 8 | bias_x, 9 | bias_y, 10 | layer_name, 11 | node_labs, 12 | x_range, 13 | y_range, 14 | circle_cex, 15 | cex_val, 16 | bord_col, 17 | circle_col 18 | ) 19 | } 20 | \arguments{ 21 | \item{bias_x}{numeric vector of values for x locations} 22 | 23 | \item{bias_y}{numeric vector for y location} 24 | 25 | \item{layer_name}{string indicating text to put in node} 26 | 27 | \item{node_labs}{logical indicating of node labels are included} 28 | 29 | \item{x_range}{numeric of x axis range for base plot} 30 | 31 | \item{y_range}{numeric of y axis range for base plot} 32 | 33 | \item{circle_cex}{numeric value indicating size of nodes, default 5} 34 | 35 | \item{cex_val}{numeric value indicating size of text labels, default 1} 36 | 37 | \item{bord_col}{chr string indicating border color around nodes, default \code{'lightblue'}} 38 | 39 | \item{circle_col}{chr string indicating color of nodes} 40 | } 41 | \description{ 42 | Plot bias points in \code{\link{plotnet}} 43 | } 44 | -------------------------------------------------------------------------------- /man/garson.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NeuralNetTools_gar.R 3 | \name{garson} 4 | \alias{garson} 5 | \alias{garson.default} 6 | \alias{garson.numeric} 7 | \alias{garson.nnet} 8 | \alias{garson.mlp} 9 | \alias{garson.nn} 10 | \alias{garson.train} 11 | \title{Variable importance using Garson's algorithm} 12 | \usage{ 13 | garson(mod_in, ...) 14 | 15 | \method{garson}{default}( 16 | mod_in, 17 | x_names, 18 | y_names, 19 | bar_plot = TRUE, 20 | x_lab = NULL, 21 | y_lab = NULL, 22 | ... 23 | ) 24 | 25 | \method{garson}{numeric}(mod_in, struct, ...) 26 | 27 | \method{garson}{nnet}(mod_in, ...) 28 | 29 | \method{garson}{mlp}(mod_in, ...) 30 | 31 | \method{garson}{nn}(mod_in, ...) 32 | 33 | \method{garson}{train}(mod_in, ...) 34 | } 35 | \arguments{ 36 | \item{mod_in}{input model object or a list of model weights as returned from \code{\link{neuralweights}} if using the default method} 37 | 38 | \item{...}{arguments passed to other methods} 39 | 40 | \item{x_names}{chr string of input variable names, obtained from the model object} 41 | 42 | \item{y_names}{chr string of response variable names, obtained from the model object} 43 | 44 | \item{bar_plot}{logical indicating if a \code{ggplot} object is returned (default \code{T}), otherwise numeric values are returned} 45 | 46 | \item{x_lab}{chr string of alternative names to be used for explanatory variables in the figure, default is taken from \code{mod_in}} 47 | 48 | \item{y_lab}{chr string of alternative name to be used for the y-axis in the figure} 49 | 50 | \item{struct}{numeric vector equal in length to the number of layers in the network. Each number indicates the number of nodes in each layer starting with the input and ending with the output. An arbitrary number of hidden layers can be included.} 51 | } 52 | \value{ 53 | A \code{\link[ggplot2]{ggplot}} object for plotting if \code{bar_plot = FALSE}, otherwise a \code{data.frame} of relative importance values for each input variable. The default aesthetics for \code{\link[ggplot2]{ggplot}} can be further modified, as shown with the examples. 54 | } 55 | \description{ 56 | Relative importance of input variables in neural networks using Garson's algorithm 57 | } 58 | \details{ 59 | The weights that connect variables in a neural network are partially analogous to parameter coefficients in a standard regression model and can be used to describe relationships between variables. The weights dictate the relative influence of information that is processed in the network such that input variables that are not relevant in their correlation with a response variable are suppressed by the weights. The opposite effect is seen for weights assigned to explanatory variables that have strong positive or negative associations with a response variable. An obvious difference between a neural network and a regression model is that the number of weights is excessive in the former case. This characteristic is advantageous in that it makes neural networks very flexible for modeling non-linear functions with multiple interactions, although interpretation of the effects of specific variables is of course challenging. 60 | 61 | A method described in Garson 1991 (also see Goh 1995) identifies the relative importance of explanatory variables for a single response variables in a supervised neural network by deconstructing the model weights. The relative importance (or strength of association) of a specific explanatory variable for the response variable can be determined by identifying all weighted connections between the nodes of interest. That is, all weights connecting the specific input node that pass through the hidden layer to the response variable are identified. This is repeated for all other explanatory variables until a list of all weights that are specific to each input variable is obtained. The connections are tallied for each input node and scaled relative to all other inputs. A single value is obtained for each explanatory variable that describes the relationship with the response variable in the model (see the appendix in Goh 1995 for a more detailed description). The original algorithm indicates relative importance as the absolute magnitude from zero to one such the direction of the response cannot be determined. 62 | 63 | Misleading results may be produced if the neural network was created with a skip-layer using \code{skip = TRUE} with the \code{\link[nnet]{nnet}} or \code{\link[caret]{train}} functions. Garson's algorithm does not describe the effects of skip layer connections on estimates of variable importance. As such, these values are removed prior to estimating variable importance. 64 | 65 | The algorithm currently only works for neural networks with one hidden layer and one response variable. 66 | } 67 | \examples{ 68 | 69 | ## using numeric input 70 | 71 | wts_in <- c(13.12, 1.49, 0.16, -0.11, -0.19, -0.16, 0.56, -0.52, 0.81) 72 | struct <- c(2, 2, 1) #two inputs, two hidden, one output 73 | 74 | garson(wts_in, struct) 75 | 76 | ## using nnet 77 | 78 | library(nnet) 79 | 80 | data(neuraldat) 81 | set.seed(123) 82 | 83 | mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 84 | 85 | garson(mod) 86 | 87 | \dontrun{ 88 | ## using RSNNS, no bias layers 89 | 90 | library(RSNNS) 91 | 92 | x <- neuraldat[, c('X1', 'X2', 'X3')] 93 | y <- neuraldat[, 'Y1'] 94 | mod <- mlp(x, y, size = 5) 95 | 96 | garson(mod) 97 | 98 | ## using neuralnet 99 | 100 | library(neuralnet) 101 | 102 | mod <- neuralnet(Y1 ~ X1 + X2 + X3, data = neuraldat, hidden = 5) 103 | 104 | garson(mod) 105 | 106 | ## using caret 107 | 108 | library(caret) 109 | 110 | mod <- train(Y1 ~ X1 + X2 + X3, method = 'nnet', data = neuraldat, linout = TRUE) 111 | 112 | garson(mod) 113 | 114 | ## modify the plot using ggplot2 syntax 115 | library(ggplot2) 116 | 117 | mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 118 | 119 | cols <- heat.colors(10) 120 | garson(mod) + 121 | scale_y_continuous('Rel. Importance', limits = c(-1, 1)) + 122 | scale_fill_gradientn(colours = cols) + 123 | scale_colour_gradientn(colours = cols) 124 | } 125 | } 126 | \references{ 127 | Beck, M.W. 2018. NeuralNetTools: Visualization and Analysis Tools for Neural Networks. Journal of Statistical Software. 85(11):1-20. 128 | 129 | Garson, G.D. 1991. Interpreting neural network connection weights. Artificial Intelligence Expert. 6(4):46-51. 130 | 131 | Goh, A.T.C. 1995. Back-propagation neural networks for modeling complex systems. Artificial Intelligence in Engineering. 9(3):143-151. 132 | 133 | Olden, J.D., Jackson, D.A. 2002. Illuminating the 'black-box': a randomization approach for understanding variable contributions in artificial neural networks. Ecological Modelling. 154:135-150. 134 | 135 | Olden, J.D., Joy, M.K., Death, R.G. 2004. An accurate comparison of methods for quantifying variable importance in artificial neural networks using simulated data. Ecological Modelling. 178:389-397. 136 | } 137 | \seealso{ 138 | \code{\link{olden}} for a more flexible approach for variable importance 139 | } 140 | -------------------------------------------------------------------------------- /man/get_ys.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NeuralNetTools_utils.R 3 | \name{get_ys} 4 | \alias{get_ys} 5 | \title{Get y locations for layers in \code{\link{plotnet}}} 6 | \usage{ 7 | get_ys(lyr, max_sp, struct, y_range) 8 | } 9 | \arguments{ 10 | \item{lyr}{numeric indicating layer for getting y locations} 11 | 12 | \item{max_sp}{logical indicating if space is maximized in plot} 13 | 14 | \item{struct}{numeric vector for network structure} 15 | 16 | \item{y_range}{numeric vector indicating limits of y axis} 17 | } 18 | \description{ 19 | Get y locations for input, hidden, output layers in \code{\link{plotnet}} 20 | } 21 | -------------------------------------------------------------------------------- /man/layer_lines.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NeuralNetTools_utils.R 3 | \name{layer_lines} 4 | \alias{layer_lines} 5 | \title{Plot connection weights} 6 | \usage{ 7 | layer_lines( 8 | mod_in, 9 | h_layer, 10 | layer1 = 1, 11 | layer2 = 2, 12 | out_layer = FALSE, 13 | nid, 14 | rel_rsc, 15 | all_in, 16 | pos_col, 17 | neg_col, 18 | x_range, 19 | y_range, 20 | line_stag, 21 | x_names, 22 | layer_x, 23 | struct, 24 | max_sp, 25 | prune_col = NULL, 26 | prune_lty = "dashed", 27 | skip 28 | ) 29 | } 30 | \arguments{ 31 | \item{mod_in}{neural network model object} 32 | 33 | \item{h_layer}{numeric indicating which connections to plot for the layer} 34 | 35 | \item{layer1}{numeric indicating order of first layer (for multiple hiden layers)} 36 | 37 | \item{layer2}{numeric indicating order of second layer (for multiple hiden layers)} 38 | 39 | \item{out_layer}{logical indicating if the lines are for the output layer} 40 | 41 | \item{nid}{logical value indicating if neural interpretation diagram is plotted, default \code{TRUE}} 42 | 43 | \item{rel_rsc}{numeric indicating the scaling range for the width of connection weights in a neural interpretation diagram. Default is \code{NULL} for no rescaling.} 44 | 45 | \item{all_in}{chr string indicating names of input variables for which connections are plotted, default all} 46 | 47 | \item{pos_col}{chr string indicating color of positive connection weights, default \code{'black'}} 48 | 49 | \item{neg_col}{chr string indicating color of negative connection weights, default \code{'grey'}} 50 | 51 | \item{x_range}{numeric of x axis range for base plot} 52 | 53 | \item{y_range}{numeric of y axis range for base plot} 54 | 55 | \item{line_stag}{numeric value that specifies distance of connection weights from nodes} 56 | 57 | \item{x_names}{chr string for names of input variables} 58 | 59 | \item{layer_x}{numeric indicating locations of layers on x axis} 60 | 61 | \item{struct}{numeric vector for network structure} 62 | 63 | \item{max_sp}{logical indicating if space is maximized in plot} 64 | 65 | \item{prune_col}{chr string indicating color of pruned connections, otherwise not shown} 66 | 67 | \item{prune_lty}{line type for pruned connections, passed to \code{\link[graphics]{segments}}} 68 | 69 | \item{skip}{logical to plot connections for skip layer} 70 | } 71 | \description{ 72 | Plot connection weights in \code{\link{plotnet}} 73 | } 74 | -------------------------------------------------------------------------------- /man/layer_points.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NeuralNetTools_utils.R 3 | \name{layer_points} 4 | \alias{layer_points} 5 | \title{Plot neural network nodes} 6 | \usage{ 7 | layer_points( 8 | layer, 9 | x_loc, 10 | x_range, 11 | layer_name, 12 | cex_val, 13 | circle_cex, 14 | bord_col, 15 | in_col, 16 | node_labs, 17 | line_stag, 18 | var_labs, 19 | x_names, 20 | y_names, 21 | ... 22 | ) 23 | } 24 | \arguments{ 25 | \item{layer}{specifies which layer, integer from \code{struct}} 26 | 27 | \item{x_loc}{indicates x location for layer, integer from \code{layer_x}} 28 | 29 | \item{x_range}{numeric for total range of x-axis} 30 | 31 | \item{layer_name}{string indicating text to put in node} 32 | 33 | \item{cex_val}{numeric indicating size of point text} 34 | 35 | \item{circle_cex}{numeric indicating size of circles} 36 | 37 | \item{bord_col}{chr string indicating border color around nodes, default \code{lightblue}} 38 | 39 | \item{in_col}{chr string indicating interior color of nodes} 40 | 41 | \item{node_labs}{logical indicating if node labels are to be plotted} 42 | 43 | \item{line_stag}{numeric indicating distance between of text from nodes} 44 | 45 | \item{var_labs}{chr string for variable labels} 46 | 47 | \item{x_names}{chr string for alternative names of input nodes} 48 | 49 | \item{y_names}{chr string for alternative names of output nodes} 50 | 51 | \item{...}{values passed to \code{\link{get_ys}}} 52 | } 53 | \description{ 54 | Plot neural network nodes in \code{\link{plotnet}} 55 | } 56 | -------------------------------------------------------------------------------- /man/lekgrps.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NeuralNetTools_utils.R 3 | \name{lekgrps} 4 | \alias{lekgrps} 5 | \title{Create optional barplot for \code{\link{lekprofile}} groups} 6 | \usage{ 7 | lekgrps(grps, position = "dodge", grp_nms = NULL) 8 | } 9 | \arguments{ 10 | \item{grps}{\code{\link[base]{data.frame}} of values for each variable in each group used to create groups in \code{\link{lekprofile}}} 11 | 12 | \item{position}{chr string indicating bar position (e.g., 'dodge', 'fill', 'stack'), passed to \code{\link[ggplot2]{geom_bar}}} 13 | 14 | \item{grp_nms}{optional chr string of alternative names for groups in legend} 15 | } 16 | \value{ 17 | A \code{\link[ggplot2]{ggplot}} object 18 | } 19 | \description{ 20 | Create optional barplot of constant values of each variable for each group used with \code{\link{lekprofile}} 21 | } 22 | \examples{ 23 | ## enters used with kmeans clustering 24 | x <- neuraldat[, c('X1', 'X2', 'X3')] 25 | grps <- kmeans(x, 6)$center 26 | 27 | lekgrps(grps) 28 | } 29 | -------------------------------------------------------------------------------- /man/lekprofile.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NeuralNetTools_lek.R 3 | \name{lekprofile} 4 | \alias{lekprofile} 5 | \alias{lekprofile.default} 6 | \alias{lekprofile.nnet} 7 | \alias{lekprofile.mlp} 8 | \alias{lekprofile.train} 9 | \alias{lekprofile.nn} 10 | \title{Sensitivity analysis using Lek's profile method} 11 | \usage{ 12 | lekprofile(mod_in, ...) 13 | 14 | \method{lekprofile}{default}( 15 | mod_in, 16 | xvars, 17 | ysel = NULL, 18 | xsel = NULL, 19 | steps = 100, 20 | group_vals = seq(0, 1, by = 0.2), 21 | val_out = FALSE, 22 | group_show = FALSE, 23 | grp_nms = NULL, 24 | position = "dodge", 25 | ... 26 | ) 27 | 28 | \method{lekprofile}{nnet}(mod_in, xsel = NULL, ysel = NULL, ...) 29 | 30 | \method{lekprofile}{mlp}(mod_in, xvars, yvars, xsel = NULL, ysel = NULL, ...) 31 | 32 | \method{lekprofile}{train}(mod_in, xsel = NULL, ysel = NULL, ...) 33 | 34 | \method{lekprofile}{nn}(mod_in, xsel = NULL, ysel = NULL, ...) 35 | } 36 | \arguments{ 37 | \item{mod_in}{input object for which an organized model list is desired. The input can be an object of class \code{nnet} or \code{mlp}} 38 | 39 | \item{...}{arguments passed to other methods} 40 | 41 | \item{xvars}{\code{\link[base]{data.frame}} of explanatory variables used to create the input model, only needed for \code{mlp} objects} 42 | 43 | \item{ysel}{chr string indicating which response variables to plot if more than one, defaults to all} 44 | 45 | \item{xsel}{chr string of names of explanatory variables to plot, defaults to all} 46 | 47 | \item{steps}{numeric value indicating number of observations to evaluate for each explanatory variable from minimum to maximum value, default 100} 48 | 49 | \item{group_vals}{numeric vector with values from 0-1 indicating quantile values at which to hold other explanatory variables constant or a single value indicating number of clusters to define grouping scheme, see details} 50 | 51 | \item{val_out}{logical value indicating if actual sensitivity values are returned rather than a plot, default \code{FALSE}} 52 | 53 | \item{group_show}{logical if a barplot is returned that shows the values at which explanatory variables were held constant while not being evaluated} 54 | 55 | \item{grp_nms}{optional chr string of alternative names for groups in legend} 56 | 57 | \item{position}{chr string indicating bar position (e.g., 'dodge', 'fill', 'stack'), passed to \code{\link[ggplot2]{geom_bar}}, used if \code{group_show = TRUE}} 58 | 59 | \item{yvars}{\code{\link[base]{data.frame}} of explanatory variables used to create the input model, only needed for \code{mlp} objects} 60 | } 61 | \value{ 62 | A \code{\link[ggplot2]{ggplot}} object for plotting if \code{val_out = FALSE}, otherwise a two-element \code{list} is returned with a \code{data.frame} in long form showing the predicted responses at different values of the explanatory variables and the grouping scheme that was used to hold unevaluated variables constant. 63 | } 64 | \description{ 65 | Conduct a sensitivity analysis of model responses in a neural network to input variables using Lek's profile method 66 | } 67 | \details{ 68 | The Lek profile method is described briefly in Lek et al. 1996 and in more detail in Gevrey et al. 2003. The profile method is fairly generic and can be extended to any statistical model in R with a predict method. However, it is one of few methods used to evaluate sensitivity in neural networks. 69 | 70 | The profile method can be used to evaluate the effect of explanatory variables by returning a plot of the predicted response across the range of values for each separate variable. The original profile method evaluated the effects of each variable while holding the remaining explanatory variables at different quantiles (e.g., minimum, 20th percentile, maximum). This is implemented in in the function by creating a matrix of values for explanatory variables where the number of rows is the number of observations and the number of columns is the number of explanatory variables. All explanatory variables are held at their mean (or other constant value) while the variable of interest is sequenced from its minimum to maximum value across the range of observations. This matrix (or data frame) is then used to predict values of the response variable from a fitted model object. This is repeated for each explanatory variable to obtain all response curves. Values passed to \code{group_vals} must range from zero to one to define the quantiles for holding unevaluated explanatory variables. 71 | 72 | An alternative implementation of the profile method is to group the unevaluated explanatory variables using groupings defined by the statistical properties of the data. Covariance among predictors may present unlikely scenarios if holding all unevaluated variables at the same level. To address this issue, the function provides an option to hold unevaluated variable at mean values defined by natural clusters in the data. \code{\link[stats]{kmeans}} clustering is used on the input \code{data.frame} of explanatory variables if the argument passed to \code{group_vals} is an integer value greater than one. The centers of the clusters are then used as constant values for the unevaluated variables. An arbitrary grouping scheme can also be passed to \code{group_vals} as a \code{data.frame} where the user can specify exact values for holding each value constant (see the examples). 73 | 74 | For all plots, the legend with the 'Groups' label indicates the colors that correspond to each group. The groups describe the values at which unevaluated explanatory variables were held constant, either as specific quantiles, group assignments based on clustering, or in the arbitrary grouping defined by the user. The constant values of each explanatory variable for each group can be viewed as a barplot by using \code{group_show = TRUE}. 75 | 76 | Note that there is no predict method for neuralnet objects from the nn package. The lekprofile method for nn objects uses the nnet package to recreate the input model, which is then used for the sensitivity predictions. This approach only works for networks with one hidden layer. 77 | } 78 | \examples{ 79 | 80 | ## using nnet 81 | 82 | library(nnet) 83 | 84 | set.seed(123) 85 | 86 | mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 87 | 88 | lekprofile(mod) 89 | 90 | \dontrun{ 91 | ## using RSNNS, no bias layers 92 | 93 | library(RSNNS) 94 | 95 | x <- neuraldat[, c('X1', 'X2', 'X3')] 96 | y <- neuraldat[, 'Y1', drop = FALSE] 97 | 98 | mod <- mlp(x, y, size = 5) 99 | 100 | lekprofile(mod, xvars = x) 101 | 102 | ## using neuralnet 103 | 104 | library(neuralnet) 105 | 106 | mod <- neuralnet(Y1 ~ X1 + X2 + X3, data = neuraldat, hidden = 5) 107 | 108 | lekprofile(mod) 109 | 110 | ## back to nnet, not using formula to create model 111 | ## y variable must have a name attribute 112 | 113 | mod <- nnet(x, y, size = 5) 114 | 115 | lekprofile(mod) 116 | 117 | ## using caret 118 | 119 | library(caret) 120 | 121 | mod <- train(Y1 ~ X1 + X2 + X3, method = 'nnet', data = neuraldat, linout = TRUE) 122 | 123 | lekprofile(mod) 124 | 125 | ## group by clusters instead of sequencing by quantiles 126 | 127 | mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 128 | 129 | lekprofile(mod, group_vals = 6) # six clusters 130 | 131 | ## enter an arbitrary grouping scheme for the group values 132 | ## i.e. hold all values at 0.5 133 | group_vals <- rbind(rep(0.5, length = ncol(x))) 134 | group_vals <- data.frame(group_vals) 135 | names(group_vals) <- names(group_vals) 136 | 137 | lekprofile(mod, group_vals = group_vals, xsel = 'X3') 138 | } 139 | } 140 | \references{ 141 | Beck, M.W. 2018. NeuralNetTools: Visualization and Analysis Tools for Neural Networks. Journal of Statistical Software. 85(11):1-20. 142 | 143 | Lek, S., Delacoste, M., Baran, P., Dimopoulos, I., Lauga, J., Aulagnier, S. 1996. Application of neural networks to modelling nonlinear relationships in Ecology. Ecological Modelling. 90:39-52. 144 | 145 | Gevrey, M., Dimopoulos, I., Lek, S. 2003. Review and comparison of methods to study the contribution of variables in artificial neural network models. Ecological Modelling. 160:249-264. 146 | 147 | Olden, J.D., Joy, M.K., Death, R.G. 2004. An accurate comparison of methods for quantifying variable importance in artificial neural networks using simulated data. Ecological Modelling. 178:389-397. 148 | } 149 | -------------------------------------------------------------------------------- /man/neuraldat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NeuralNetTools_neuraldat.R 3 | \docType{data} 4 | \name{neuraldat} 5 | \alias{neuraldat} 6 | \title{Simulated dataset for function examples} 7 | \format{ 8 | A data frame with 2000 rows and 5 variables: 9 | \describe{ 10 | \item{Y1}{numeric} 11 | \item{Y2}{numeric} 12 | \item{X1}{numeric} 13 | \item{X2}{numeric} 14 | \item{X3}{numeric} 15 | ... 16 | } 17 | } 18 | \usage{ 19 | neuraldat 20 | } 21 | \description{ 22 | A simulated dataset of 2000 observations containing two response variables and three explanatory variables. Explanatory variables were sampled from a standard normal distribution. Response variables were linear combinations of the explanatory variables. The response variables Y1 and Y2 are standardized from 0 to 1. 23 | } 24 | \keyword{datasets} 25 | -------------------------------------------------------------------------------- /man/neuralskips.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NeuralNetTools_utils.R 3 | \name{neuralskips} 4 | \alias{neuralskips} 5 | \alias{neuralskips.nnet} 6 | \title{Get weights for the skip layer in a neural network} 7 | \usage{ 8 | neuralskips(mod_in, ...) 9 | 10 | \method{neuralskips}{nnet}(mod_in, rel_rsc = NULL, ...) 11 | } 12 | \arguments{ 13 | \item{mod_in}{input object for which an organized model list is desired.} 14 | 15 | \item{...}{arguments passed to other methods} 16 | 17 | \item{rel_rsc}{numeric indicating the scaling range for the width of connection weights in a neural interpretation diagram. Default is \code{NULL} for no rescaling. Scaling is relative to all weights, not just those in the primary network.} 18 | } 19 | \value{ 20 | Returns a list of connections for each output node, where each element of the list is the connection for each input node in sequential order to the respective output node. The first weight in each element is not the bias connection, unlike the results for \code{\link{neuralweights}}. 21 | } 22 | \description{ 23 | Get weights for the skip layer in a neural network, only valid for networks created using \code{skip = TRUE} with the \code{\link[nnet]{nnet}} function. 24 | } 25 | \details{ 26 | This function is similar to \code{\link{neuralweights}} except only the skip layer weights are returned. 27 | } 28 | \examples{ 29 | 30 | data(neuraldat) 31 | set.seed(123) 32 | 33 | ## using nnet 34 | 35 | library(nnet) 36 | 37 | mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5, linout = TRUE, 38 | skip = TRUE) 39 | 40 | neuralskips(mod) 41 | 42 | } 43 | -------------------------------------------------------------------------------- /man/neuralweights.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NeuralNetTools_utils.R 3 | \name{neuralweights} 4 | \alias{neuralweights} 5 | \alias{neuralweights.numeric} 6 | \alias{neuralweights.nnet} 7 | \alias{neuralweights.mlp} 8 | \alias{neuralweights.nn} 9 | \title{Get weights for a neural network} 10 | \usage{ 11 | neuralweights(mod_in, ...) 12 | 13 | \method{neuralweights}{numeric}(mod_in, rel_rsc = NULL, struct, ...) 14 | 15 | \method{neuralweights}{nnet}(mod_in, rel_rsc = NULL, ...) 16 | 17 | \method{neuralweights}{mlp}(mod_in, rel_rsc = NULL, ...) 18 | 19 | \method{neuralweights}{nn}(mod_in, rel_rsc = NULL, ...) 20 | } 21 | \arguments{ 22 | \item{mod_in}{input object for which an organized model list is desired. The input can be an object of class \code{numeric}, \code{nnet}, \code{mlp}, or \code{nn}} 23 | 24 | \item{...}{arguments passed to other methods} 25 | 26 | \item{rel_rsc}{numeric indicating the scaling range for the width of connection weights in a neural interpretation diagram. Default is \code{NULL} for no rescaling.} 27 | 28 | \item{struct}{numeric vector equal in length to the number of layers in the network. Each number indicates the number of nodes in each layer starting with the input and ending with the output. An arbitrary number of hidden layers can be included.} 29 | } 30 | \value{ 31 | Returns a two-element list with the first element being a vector indicating the number of nodes in each layer of the neural network and the second element being a named list of weight values for the input model. 32 | } 33 | \description{ 34 | Get weights for a neural network in an organized list by extracting values from a neural network object. This function is generally not called by itself. 35 | } 36 | \details{ 37 | Each element of the returned list is named using the construct 'layer node', e.g. 'out 1' is the first node of the output layer. Hidden layers are named using three values for instances with more than one hidden layer, e.g., 'hidden 1 1' is the first node in the first hidden layer, 'hidden 1 2' is the second node in the first hidden layer, 'hidden 2 1' is the first node in the second hidden layer, etc. The values in each element of the list represent the weights entering the specific node from the preceding layer in sequential order, starting with the bias layer if applicable. For example, the elements in a list item for 'hidden 1 1' of a neural network with a 3 5 1 structure (3 inputs, 5 hidden nodes, 1 output) would have four values indicating the weights in sequence from the bias layer, first input layer, second input layer, and third input layer going to the first hidden node. 38 | 39 | The function will remove direct weight connections between input and output layers if the neural network was created with a skip-layer using \code{skip = TRUE} with the \code{\link[nnet]{nnet}} or \code{\link[caret]{train}} functions. This may produce misleading results when evaluating variable performance with the \code{\link{garson}} function. 40 | } 41 | \examples{ 42 | 43 | data(neuraldat) 44 | set.seed(123) 45 | 46 | ## using numeric input 47 | 48 | wts_in <- c(13.12, 1.49, 0.16, -0.11, -0.19, -0.16, 0.56, -0.52, 0.81) 49 | struct <- c(2, 2, 1) #two inputs, two hidden, one output 50 | 51 | neuralweights(wts_in, struct = struct) 52 | 53 | ## using nnet 54 | 55 | library(nnet) 56 | 57 | mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5, linout = TRUE) 58 | 59 | neuralweights(mod) 60 | 61 | \dontrun{ 62 | ## using RSNNS, no bias layers 63 | 64 | library(RSNNS) 65 | 66 | x <- neuraldat[, c('X1', 'X2', 'X3')] 67 | y <- neuraldat[, 'Y1'] 68 | mod <- mlp(x, y, size = 5, linOut = TRUE) 69 | 70 | neuralweights(mod) 71 | 72 | # pruned model using code from RSSNS pruning demo 73 | pruneFuncParams <- list(max_pr_error_increase = 10.0, pr_accepted_error = 1.0, 74 | no_of_pr_retrain_cycles = 1000, min_error_to_stop = 0.01, init_matrix_value = 1e-6, 75 | input_pruning = TRUE, hidden_pruning = TRUE) 76 | mod <- mlp(x, y, size = 5, pruneFunc = "OptimalBrainSurgeon", 77 | pruneFuncParams = pruneFuncParams) 78 | 79 | neuralweights(mod) 80 | 81 | ## using neuralnet 82 | 83 | library(neuralnet) 84 | 85 | mod <- neuralnet(Y1 ~ X1 + X2 + X3, data = neuraldat, hidden = 5) 86 | 87 | neuralweights(mod) 88 | } 89 | } 90 | -------------------------------------------------------------------------------- /man/olden.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NeuralNetTools_old.R 3 | \name{olden} 4 | \alias{olden} 5 | \alias{olden.default} 6 | \alias{olden.numeric} 7 | \alias{olden.nnet} 8 | \alias{olden.mlp} 9 | \alias{olden.nn} 10 | \alias{olden.train} 11 | \title{Variable importance using connection weights} 12 | \usage{ 13 | olden(mod_in, ...) 14 | 15 | \method{olden}{default}( 16 | mod_in, 17 | x_names, 18 | y_names, 19 | out_var = NULL, 20 | bar_plot = TRUE, 21 | x_lab = NULL, 22 | y_lab = NULL, 23 | skip_wts = NULL, 24 | ... 25 | ) 26 | 27 | \method{olden}{numeric}(mod_in, struct, ...) 28 | 29 | \method{olden}{nnet}(mod_in, ...) 30 | 31 | \method{olden}{mlp}(mod_in, ...) 32 | 33 | \method{olden}{nn}(mod_in, ...) 34 | 35 | \method{olden}{train}(mod_in, ...) 36 | } 37 | \arguments{ 38 | \item{mod_in}{input model object or a list of model weights as returned from \code{\link{neuralweights}} if using the default method} 39 | 40 | \item{...}{arguments passed to or from other methods} 41 | 42 | \item{x_names}{chr string of input variable names, obtained from the model object} 43 | 44 | \item{y_names}{chr string of response variable names, obtained from the model object} 45 | 46 | \item{out_var}{chr string indicating the response variable in the neural network object to be evaluated. Only one input is allowed for models with more than one response. Names must be of the form \code{'Y1'}, \code{'Y2'}, etc. if using numeric values as weight inputs for \code{mod_in}.} 47 | 48 | \item{bar_plot}{logical indicating if a \code{ggplot} object is returned (default \code{T}), otherwise numeric values are returned} 49 | 50 | \item{x_lab}{chr string of alternative names to be used for explanatory variables in the figure, default is taken from \code{mod_in}} 51 | 52 | \item{y_lab}{chr string of alternative names to be used for response variable in the figure, default is taken from \code{out_var}} 53 | 54 | \item{skip_wts}{vector from \code{\link{neuralskips}} for \code{\link[nnet]{nnet}} models with skip-layer connections} 55 | 56 | \item{struct}{numeric vector equal in length to the number of layers in the network. Each number indicates the number of nodes in each layer starting with the input and ending with the output. An arbitrary number of hidden layers can be included.} 57 | } 58 | \value{ 59 | A \code{\link[ggplot2]{ggplot}} object for plotting if \code{bar_plot = FALSE}, otherwise a \code{data.frame} of relative importance values for each input variable. 60 | } 61 | \description{ 62 | Relative importance of input variables in neural networks as the sum of the product of raw input-hidden, hidden-output connection weights, proposed by Olden et al. 2004. 63 | } 64 | \details{ 65 | This method is similar to Garson's algorithm (Garson 1991, modified by Goh 1995) in that the connection weights between layers of a neural network form the basis for determining variable importance. However, Olden et al. 2004 describe a connection weights algorithm that consistently out-performed Garson's algorithm in representing the true variable importance in simulated datasets. This `Olden' method calculates variable importance as the product of the raw input-hidden and hidden-output connection weights between each input and output neuron and sums the product across all hidden neurons. An advantage of this approach is the relative contributions of each connection weight are maintained in terms of both magnitude and sign as compared to Garson's algorithm which only considers the absolute magnitude. For example, connection weights that change sign (e.g., positive to negative) between the input-hidden to hidden-output layers would have a cancelling effect whereas Garson's algorithm may provide misleading results based on the absolute magnitude. An additional advantage is that Olden's algorithm is capable of evaluating neural networks with multiple hidden layers wheras Garson's was developed for networks with a single hidden layer. 66 | 67 | The importance values assigned to each variable are in units that are based directly on the summed product of the connection weights. The actual values should only be interpreted based on relative sign and magnitude between explanatory variables. Comparisons between different models should not be made. 68 | 69 | The Olden function also works with networks that have skip layers by adding the input-output connection weights to the final summed product of all input-hidden and hidden-output connections. This was not described in the original method so interpret with caution. 70 | 71 | By default, the results are shown only for the first response variable for networks with multiple output nodes. The plotted response variable can be changed with \code{out_var}. 72 | } 73 | \examples{ 74 | 75 | ## using numeric input 76 | 77 | wts_in <- c(13.12, 1.49, 0.16, -0.11, -0.19, -0.16, 0.56, -0.52, 0.81) 78 | struct <- c(2, 2, 1) #two inputs, two hidden, one output 79 | 80 | olden(wts_in, struct) 81 | 82 | ## using nnet 83 | 84 | library(nnet) 85 | 86 | data(neuraldat) 87 | set.seed(123) 88 | 89 | mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 90 | 91 | olden(mod) 92 | 93 | \dontrun{ 94 | ## View the difference for a model w/ skip layers 95 | 96 | set.seed(123) 97 | 98 | mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5, skip = TRUE) 99 | 100 | olden(mod) 101 | 102 | ## using RSNNS, no bias layers 103 | 104 | library(RSNNS) 105 | 106 | x <- neuraldat[, c('X1', 'X2', 'X3')] 107 | y <- neuraldat[, 'Y1'] 108 | mod <- mlp(x, y, size = 5) 109 | 110 | olden(mod) 111 | 112 | ## using neuralnet 113 | 114 | library(neuralnet) 115 | 116 | mod <- neuralnet(Y1 ~ X1 + X2 + X3, data = neuraldat, hidden = 5) 117 | 118 | olden(mod) 119 | 120 | ## using caret 121 | 122 | library(caret) 123 | 124 | mod <- train(Y1 ~ X1 + X2 + X3, method = 'nnet', data = neuraldat, linout = TRUE) 125 | 126 | olden(mod) 127 | 128 | ## multiple hidden layers 129 | 130 | x <- neuraldat[, c('X1', 'X2', 'X3')] 131 | y <- neuraldat[, 'Y1'] 132 | mod <- mlp(x, y, size = c(5, 7, 6), linOut = TRUE) 133 | 134 | olden(mod) 135 | } 136 | } 137 | \references{ 138 | Beck, M.W. 2018. NeuralNetTools: Visualization and Analysis Tools for Neural Networks. Journal of Statistical Software. 85(11):1-20. 139 | 140 | Garson, G.D. 1991. Interpreting neural network connection weights. Artificial Intelligence Expert. 6(4):46-51. 141 | 142 | Goh, A.T.C. 1995. Back-propagation neural networks for modeling complex systems. Artificial Intelligence in Engineering. 9(3):143-151. 143 | 144 | Olden, J.D., Jackson, D.A. 2002. Illuminating the 'black-box': a randomization approach for understanding variable contributions in artificial neural networks. Ecological Modelling. 154:135-150. 145 | 146 | Olden, J.D., Joy, M.K., Death, R.G. 2004. An accurate comparison of methods for quantifying variable importance in artificial neural networks using simulated data. Ecological Modelling. 178:389-397. 147 | } 148 | -------------------------------------------------------------------------------- /man/plotnet.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NeuralNetTools_plot.R 3 | \name{plotnet} 4 | \alias{plotnet} 5 | \alias{plotnet.default} 6 | \alias{plotnet.nnet} 7 | \alias{plotnet.numeric} 8 | \alias{plotnet.mlp} 9 | \alias{plotnet.nn} 10 | \alias{plotnet.train} 11 | \title{Plot a neural network model} 12 | \usage{ 13 | plotnet(mod_in, ...) 14 | 15 | \method{plotnet}{default}( 16 | mod_in, 17 | x_names, 18 | y_names, 19 | struct = NULL, 20 | nid = TRUE, 21 | all_out = TRUE, 22 | all_in = TRUE, 23 | bias = TRUE, 24 | bias_y = 0.95, 25 | rel_rsc = c(1, 7), 26 | circle_cex = 5, 27 | node_labs = TRUE, 28 | var_labs = TRUE, 29 | line_stag = NULL, 30 | cex_val = 1, 31 | alpha_val = 1, 32 | circle_col = "lightblue", 33 | pos_col = "black", 34 | neg_col = "grey", 35 | bord_col = "lightblue", 36 | max_sp = FALSE, 37 | pad_x = 1, 38 | prune_col = NULL, 39 | prune_lty = "dashed", 40 | skip = NULL, 41 | ... 42 | ) 43 | 44 | \method{plotnet}{nnet}(mod_in, x_names = NULL, y_names = NULL, skip = FALSE, ...) 45 | 46 | \method{plotnet}{numeric}(mod_in, struct, x_names = NULL, y_names = NULL, ...) 47 | 48 | \method{plotnet}{mlp}( 49 | mod_in, 50 | x_names = NULL, 51 | y_names = NULL, 52 | prune_col = NULL, 53 | prune_lty = "dashed", 54 | ... 55 | ) 56 | 57 | \method{plotnet}{nn}(mod_in, x_names = NULL, y_names = NULL, ...) 58 | 59 | \method{plotnet}{train}(mod_in, x_names = NULL, y_names = NULL, skip = FALSE, ...) 60 | } 61 | \arguments{ 62 | \item{mod_in}{neural network object or numeric vector of weights} 63 | 64 | \item{...}{additional arguments passed to or from other methods} 65 | 66 | \item{x_names}{chr string indicating names for input variables, default from model object} 67 | 68 | \item{y_names}{chr string indicating names for output variables, default from model object} 69 | 70 | \item{struct}{numeric vector equal in length to the number of layers in the network. Each number indicates the number of nodes in each layer starting with the input and ending with the output. An arbitrary number of hidden layers can be included.} 71 | 72 | \item{nid}{logical value indicating if neural interpretation diagram is plotted, default \code{TRUE}} 73 | 74 | \item{all_out}{chr string indicating names of response variables for which connections are plotted, default all} 75 | 76 | \item{all_in}{chr string indicating names of input variables for which connections are plotted, default all} 77 | 78 | \item{bias}{logical value indicating if bias nodes and connections are plotted, default \code{TRUE}} 79 | 80 | \item{bias_y}{value from 0 to 1 for locattion of bias nodes on y-axis} 81 | 82 | \item{rel_rsc}{numeric indicating the scaling range for the width of connection weights} 83 | 84 | \item{circle_cex}{numeric value indicating size of nodes, default 5} 85 | 86 | \item{node_labs}{logical value indicating if labels are plotted directly on nodes, default \code{TRUE}} 87 | 88 | \item{var_labs}{logical value indicating if variable names are plotted next to nodes, default \code{TRUE}} 89 | 90 | \item{line_stag}{numeric value that specifies distance of connection weights from nodes} 91 | 92 | \item{cex_val}{numeric value indicating size of text labels, default 1} 93 | 94 | \item{alpha_val}{numeric value (0-1) indicating transparency of connections, default 1} 95 | 96 | \item{circle_col}{chr string indicating color of nodes, default \code{'lightblue'}, or two element list with first element indicating color of input nodes and second indicating color of remaining nodes} 97 | 98 | \item{pos_col}{chr string indicating color of positive connection weights, default \code{'black'}} 99 | 100 | \item{neg_col}{chr string indicating color of negative connection weights, default \code{'grey'}} 101 | 102 | \item{bord_col}{chr string indicating border color around nodes, default \code{'lightblue'}} 103 | 104 | \item{max_sp}{logical value indicating if space between nodes in each layer is maximized, default \code{FALSE}} 105 | 106 | \item{pad_x}{numeric for increasing or decreasing padding on the x-axis, values less than one will increase padding and values greater than one will decrease padding} 107 | 108 | \item{prune_col}{chr string indicating color of pruned connections, otherwise not shown} 109 | 110 | \item{prune_lty}{line type for pruned connections, passed to \code{\link[graphics]{segments}}} 111 | 112 | \item{skip}{logical if skip layer connections are plotted instead of the primary network} 113 | } 114 | \value{ 115 | A graphics object unless \code{wts_only = TRUE}, then neural network weights from \code{\link{neuralweights}}. 116 | } 117 | \description{ 118 | Plot a neural interpretation diagram for a neural network object 119 | } 120 | \details{ 121 | This function plots a neural network as a neural interpretation diagram as in Ozesmi and Ozesmi (1999). Options to plot without color-coding or shading of weights are also provided. The default settings plot positive weights between layers as black lines and negative weights as grey lines. Line thickness is in proportion to relative magnitude of each weight. The first layer includes only input variables with nodes labelled arbitrarily as I1 through In for n input variables. One through many hidden layers are plotted with each node in each layer labelled as H1 through Hn. The output layer is plotted last with nodes labeled as O1 through On. Bias nodes connected to the hidden and output layers are also shown. Neural networks created using \code{\link[RSNNS]{mlp}} do not show bias layers. 122 | 123 | A primary network and a skip layer network can be plotted for \code{\link[nnet]{nnet}} models with a skip layer connection. The default is to plot the primary network, whereas the skip layer network can be viewed with \code{skip = TRUE}. If \code{nid = TRUE}, the line widths for both the primary and skip layer plots are relative to all weights. Viewing both plots is recommended to see which network has larger relative weights. Plotting a network with only a skip layer (i.e., no hidden layer, \code{size = 0}) will include bias connections to the output layer, whereas these are not included in the plot of the skip layer if \code{size} is greater than zero. 124 | 125 | The numeric method for plotting requires the input weights to be in a specific order given the structure of the network. An additional argument \code{struct} (from \code{\link{neuralweights}} is also required that lists the number of nodes in the input, hidden, and output layers. The example below for the numeric input shows the correct weight vector for a simple neural network model with two input variables, one output variable, and one hidden layer with two nodes. Bias nodes are also connected to the hidden and output layer. Using the plot syntax of I, H, O, and B for input, hidden, output, and bias to indicate weighted connections between layers, the correct weight order for the \code{mod_in} vector is B1-H1, I1-H1, I2-H1, B1-H2, I1-H2, I2-H2, B2-O1, H1-O1, H2-O1. For a generic network (three layers) with n input nodes, j hidden nodes, and k output nodes, the weights are ordered as the connections from B1, I1,...,In to H1,...,Hj, then B2, H1,..,Hj to O1,...,Ok. 126 | } 127 | \examples{ 128 | ## using numeric input 129 | 130 | # B1-H1, I1-H1, I2-H1, B1-H2, I1-H2, I2-H2, B2-O1, H1-O1, H2-O1. 131 | wts_in <- c(13.12, 1.49, 0.16, -0.11, -0.19, -0.16, 0.56, -0.52, 0.81) 132 | struct <- c(2, 2, 1) #two inputs, two hidden, one output 133 | 134 | plotnet(wts_in, struct = struct) 135 | 136 | # numeric input, two hidden layers 137 | 138 | # B1-H11, I1-H11, I2-H11, B1-H12, I1-H12, I2-H12, B2-H21, H11-H21, H12-H21, 139 | # B2-H22, H11-H22, H12-H22, B3-O1, H21-O1, H22-O1 140 | wts_in <- c(1.12, 1.49, 0.16, -0.11, -0.19, -0.16, 0.5, 0.2, -0.12, -0.1, 141 | 0.89, 0.9, 0.56, -0.52, 0.81) 142 | struct <- c(2, 2, 2, 1) # two inputs, two (two nodes each), one output 143 | 144 | plotnet(wts_in, struct = struct) 145 | 146 | ## using nnet 147 | 148 | library(nnet) 149 | 150 | data(neuraldat) 151 | set.seed(123) 152 | 153 | mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 154 | 155 | plotnet(mod) 156 | 157 | ## plot the skip layer from nnet model 158 | 159 | mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5, skip = TRUE) 160 | 161 | plotnet(mod, skip = TRUE) 162 | 163 | \dontrun{ 164 | ## using RSNNS, no bias layers 165 | 166 | library(RSNNS) 167 | 168 | x <- neuraldat[, c('X1', 'X2', 'X3')] 169 | y <- neuraldat[, 'Y1'] 170 | mod <- mlp(x, y, size = 5) 171 | 172 | plotnet(mod) 173 | 174 | # pruned model using code from RSSNS pruning demo 175 | pruneFuncParams <- list(max_pr_error_increase = 10.0, pr_accepted_error = 1.0, 176 | no_of_pr_retrain_cycles = 1000, min_error_to_stop = 0.01, init_matrix_value = 1e-6, 177 | input_pruning = TRUE, hidden_pruning = TRUE) 178 | mod <- mlp(x, y, size = 5, pruneFunc = "OptimalBrainSurgeon", 179 | pruneFuncParams = pruneFuncParams) 180 | 181 | plotnet(mod) 182 | plotnet(mod, prune_col = 'lightblue') 183 | 184 | ## using neuralnet 185 | 186 | library(neuralnet) 187 | 188 | mod <- neuralnet(Y1 ~ X1 + X2 + X3, data = neuraldat, hidden = 5) 189 | 190 | plotnet(mod) 191 | 192 | ## using caret 193 | 194 | library(caret) 195 | 196 | mod <- train(Y1 ~ X1 + X2 + X3, method = 'nnet', data = neuraldat, linout = TRUE) 197 | 198 | plotnet(mod) 199 | 200 | ## a more complicated network with categorical response 201 | AND <- c(rep(0, 7), 1) 202 | OR <- c(0, rep(1, 7)) 203 | 204 | binary_data <- data.frame(expand.grid(c(0, 1), c(0, 1), c(0, 1)), AND, OR) 205 | 206 | mod <- neuralnet(AND + OR ~ Var1 + Var2 + Var3, binary_data, 207 | hidden = c(6, 12, 8), rep = 10, err.fct = 'ce', linear.output = FALSE) 208 | 209 | plotnet(mod) 210 | 211 | ## recreate the previous example with numeric inputs 212 | 213 | # get the weights and structure in the right format 214 | wts <- neuralweights(mod) 215 | struct <- wts$struct 216 | wts <- unlist(wts$wts) 217 | 218 | # plot 219 | plotnet(wts, struct = struct) 220 | 221 | ## color input nodes by relative importance 222 | mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 223 | 224 | rel_imp <- garson(mod, bar_plot = FALSE)$rel_imp 225 | cols <- colorRampPalette(c('lightgreen', 'darkgreen'))(3)[rank(rel_imp)] 226 | 227 | plotnet(mod, circle_col = list(cols, 'lightblue')) 228 | } 229 | } 230 | \references{ 231 | Beck, M.W. 2018. NeuralNetTools: Visualization and Analysis Tools for Neural Networks. Journal of Statistical Software. 85(11):1-20. 232 | 233 | Ozesmi, S.L., Ozesmi, U. 1999. An artificial neural network approach to spatial habitat modeling with interspecific interaction. Ecological Modelling. 116:15-31. 234 | } 235 | -------------------------------------------------------------------------------- /man/pred_sens.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NeuralNetTools_utils.R 3 | \name{pred_sens} 4 | \alias{pred_sens} 5 | \title{Predicted values for Lek profile method} 6 | \usage{ 7 | pred_sens(mat_in, mod_in, var_sel, step_val, grps, ysel) 8 | } 9 | \arguments{ 10 | \item{mat_in}{\code{data.frame} of only the explanatory variables used to create model} 11 | 12 | \item{mod_in}{any model object with a predict method} 13 | 14 | \item{var_sel}{chr string of explanatory variable to select} 15 | 16 | \item{step_val}{number of values to sequence range of selected explanatory variable} 17 | 18 | \item{grps}{matrix of values for holding explanatory values constant, one column per variable and one row per group} 19 | 20 | \item{ysel}{chr string of response variable names for correct labelling} 21 | } 22 | \value{ 23 | A \code{\link[base]{list}} of predictions where each element is a \code{\link[base]{data.frame}} with the predicted value of the response and the values of the explanatory variable defined by \code{var_sel}. Each element of the list corresponds to a group defined by the rows in \code{grps} at which the other explanatory variables were held constant. 24 | } 25 | \description{ 26 | Get predicted values for Lek Profile method, used iteratively in \code{\link{lekprofile}} 27 | } 28 | \details{ 29 | Gets predicted output for a model's response variable based on matrix of explanatory variables that are restricted following Lek's profile method. The selected explanatory variable is sequenced across a range of values. All other explanatory variables are held constant at the values in \code{grps}. 30 | } 31 | \examples{ 32 | 33 | ## using nnet 34 | 35 | library(nnet) 36 | 37 | data(neuraldat) 38 | set.seed(123) 39 | 40 | mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 5) 41 | 42 | mat_in <- neuraldat[, c('X1', 'X2', 'X3')] 43 | grps <- apply(mat_in, 2, quantile, seq(0, 1, by = 0.2)) 44 | 45 | pred_sens(mat_in, mod, 'X1', 100, grps, 'Y1') 46 | } 47 | \seealso{ 48 | lekprofile 49 | } 50 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /vignettes/Overview.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Overview" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Overview} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | message = FALSE, 14 | warning = FALSE, 15 | comment = "#>" 16 | ) 17 | ``` 18 | 19 | Four core functions are available to plot (`plotnet`), evaluate variable importance (`garson`, `olden`), and conduct a simple sensitivity analysis (`lekprofile`). A sample dataset is also provided for use with the examples. The functions have S3 methods developed for neural networks from the following packages: [nnet](https://cran.r-project.org/package=nnet), [neuralnet](https://cran.r-project.org/package=neuralnet), [RSNNS](https://cran.r-project.org/package=RSNNS), and [caret](https://cran.r-project.org/package=caret). Numeric inputs that describe model weights are also acceptable for most of the functions. A full package descriptions is available in the online [manual](https://cran.r-project.org/package=NeuralNetTools/NeuralNetTools.pdf). 20 | 21 | Start by loading the package and the sample dataset. 22 | 23 | ```{r} 24 | library(NeuralNetTools) 25 | data(neuraldat) 26 | ``` 27 | 28 | The `plotnet` function plots a neural network as a simple network or as a neural interpretation diagram (NID). The default settings are to plot as NID with positive weights between layers as black lines and negative weights as grey lines. Line thickness is in proportion to relative magnitude of each weight. The first layer includes only input variables with nodes labelled as I1 through In for n input variables. One through many hidden layers are plotted with each node in each layer labelled as H1 through Hn. The output layer is plotted last with nodes labeled as O1 through On. Bias nodes connected to the hidden and output layers are also shown. 29 | 30 | ```{r, results = 'hide', fig.height = 6, fig.width = 7} 31 | # create neural network 32 | library(nnet) 33 | mod <- nnet(Y1 ~ X1 + X2 + X3, data = neuraldat, size = 10) 34 | 35 | # plot 36 | par(mar = numeric(4)) 37 | plotnet(mod) 38 | ``` 39 | 40 | The `garson` function uses Garson's algorithm to evaluate relative variable importance. This function identifies the relative importance of explanatory variables for a single response variable by deconstructing the model weights. The importance of each variable can be determined by identifying all weighted connections between the layers in the network. That is, all weights connecting the specific input node that pass through the hidden layer to the response variable are identified. This is repeated for all other explanatory variables until a list of all weights that are specific to each input variable is obtained. The connections are tallied for each input node and scaled relative to all other inputs. A single value is obtained for each explanatory variable that describes the relationship with the response variable in the model. The results indicate relative importance as the absolute magnitude from zero to one. The function cannot be used to evaluate the direction of the response. Only neural networks with one hidden layer and one output node can be evaluated. 41 | 42 | ```{r, results = 'hide', fig.height = 3, fig.width = 9} 43 | # importance of each variable 44 | garson(mod) 45 | ``` 46 | 47 | The `olden` function is an alternative and more flexible approach to evaluate variable importance. The function calculates iportance as the product of the raw input-hidden and hidden-output connection weights between each input and output neuron and sums the product across all hidden neurons. An advantage of this approach is the relative contributions of each connection weight are maintained in terms of both magnitude and sign as compared to Garson's algorithm which only considers the absolute magnitude. For example, connection weights that change sign (e.g., positive to negative) between the input-hidden to hidden-output layers would have a cancelling effect whereas Garson's algorithm may provide misleading results based on the absolute magnitude. An additional advantage is that Olden's algorithm is capable of evaluating neural networks with multiple hidden layers and response variables. The importance values assigned to each variable are in units that are based directly on the summed product of the connection weights. The actual values should only be interpreted based on relative sign and magnitude between explanatory variables. Comparisons between different models should not be made. 48 | 49 | ```{r, results = 'hide', fig.height = 3, warning = FALSE, fig.width = 9} 50 | # importance of each variable 51 | olden(mod) 52 | ``` 53 | 54 | The `lekprofile` function performs a simple sensitivity analysis for neural networks. The Lek profile method is fairly generic and can be extended to any statistical model in R with a predict method. However, it is one of few methods to evaluate sensitivity in neural networks. The function begins by predicting the response variable across the range of values for a given explanatory variable. All other explanatory variables are held constant at set values (e.g., minimum, 20th percentile, maximum) that are indicated in the plot legend. The final result is a set of predictions for the response that are evaluated across the range of values for one explanatory variable, while holding all other explanatory variables constant. This is repeated for each explanatory variable to describe the fitted response values returned by the model. 55 | 56 | ```{r, results = 'hide', fig.height = 3, warning = FALSE, fig.width = 9} 57 | # sensitivity analysis 58 | lekprofile(mod) 59 | ``` 60 | --------------------------------------------------------------------------------