├── .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 | [](https://github.com/fawda123/NeuralNetTools/actions)
4 | [](https://github.com/fawda123/NeuralNetTools/actions)
5 | [](https://CRAN.R-project.org/package=NeuralNetTools)
6 | [](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 |
--------------------------------------------------------------------------------